Nothing
R/oncomatrix.R
In maftools: Summarize, Analyze and Visualize MAF Files
Defines functions
createOncoMatrix
createOncoMatrix = function(m, g = NULL, chatty = TRUE, add_missing = FALSE){
if(is.null(g)){
stop("Please provde atleast two genes!")
}
subMaf = subsetMaf(maf = m, genes = g, includeSyn = FALSE, mafObj = FALSE)
if(nrow(subMaf) == 0){
if(add_missing){
numericMatrix = matrix(data = 0, nrow = length(g), ncol = length(levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])))
rownames(numericMatrix) = g
colnames(numericMatrix) = levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])
oncoMatrix = matrix(data = "", nrow = length(g), ncol = length(levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])))
rownames(oncoMatrix) = g
colnames(oncoMatrix) = levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])
vc = c("")
names(vc) = 0
return(list(oncoMatrix = oncoMatrix, numericMatrix = numericMatrix, vc = vc))
}else{
return(NULL)
}
}
if(add_missing){
subMaf[, Hugo_Symbol := factor(x = Hugo_Symbol, levels = g)]
}
cnv_events = c(c("Amp", "Del"), as.character(subMaf[Variant_Type == "CNV"][, .N, Variant_Classification][, Variant_Classification]))
cnv_events = unique(cnv_events)
oncomat = data.table::dcast(data = subMaf[,.(Hugo_Symbol, Variant_Classification, Tumor_Sample_Barcode)], formula = Hugo_Symbol ~ Tumor_Sample_Barcode,
fun.aggregate = function(x, cnv = cnv_events){
#x = unique(as.character(x)) #>=2 distinct variant classification = Multi_Hit
x = as.character(x) # >= 2 same/distinct variant classification = Multi_Hit See #347
xad = x[x %in% cnv]
xvc = x[!x %in% cnv]
if(length(xvc)>0){
xvc = ifelse(test = length(xvc) > 1, yes = 'Multi_Hit', no = xvc)
}
x = ifelse(test = length(xad) > 0, yes = paste(xad, xvc, sep = ';'), no = xvc)
x = gsub(pattern = ';$', replacement = '', x = x)
x = gsub(pattern = '^;', replacement = '', x = x)
return(x)
} , value.var = 'Variant_Classification', fill = '', drop = FALSE)
#convert to matrix
data.table::setDF(oncomat)
rownames(oncomat) = oncomat$Hugo_Symbol
oncomat = as.matrix(oncomat[,-1, drop = FALSE])
variant.classes = as.character(unique(subMaf[,Variant_Classification]))
variant.classes = c('',variant.classes, 'Multi_Hit')
names(variant.classes) = 0:(length(variant.classes)-1)
#Complex variant classes will be assigned a single integer.
vc.onc = unique(unlist(apply(oncomat, 2, unique)))
vc.onc = vc.onc[!vc.onc %in% names(variant.classes)]
names(vc.onc) = rep(as.character(as.numeric(names(variant.classes)[length(variant.classes)])+1), length(vc.onc))
variant.classes2 = c(variant.classes, vc.onc)
oncomat.copy <- oncomat
#Make a numeric coded matrix
for(i in 1:length(variant.classes2)){
oncomat[oncomat == variant.classes2[i]] = names(variant.classes2)[i]
}
#If maf has only one gene
if(nrow(oncomat) == 1){
mdf = t(matrix(as.numeric(oncomat)))
rownames(mdf) = rownames(oncomat)
colnames(mdf) = colnames(oncomat)
return(list(oncoMatrix = oncomat.copy, numericMatrix = mdf, vc = variant.classes))
}
#convert from character to numeric
mdf = as.matrix(apply(oncomat, 2, function(x) as.numeric(as.character(x))))
rownames(mdf) = rownames(oncomat.copy)
#If MAF file contains a single sample, simple sorting is enuf.
if(ncol(mdf) == 1){
sampleId = colnames(mdf)
mdf = as.matrix(mdf[order(mdf, decreasing = TRUE),])
colnames(mdf) = sampleId
oncomat.copy = as.matrix(oncomat.copy[rownames(mdf),])
colnames(oncomat.copy) = sampleId
return(list(oncoMatrix = oncomat.copy, numericMatrix = mdf, vc = variant.classes))
} else{
#Sort by rows as well columns if >1 samples present in MAF
#Add total variants per gene
mdf = cbind(mdf, variants = apply(mdf, 1, function(x) {
length(x[x != "0"])
}))
#Sort by total variants
mdf = mdf[order(mdf[, ncol(mdf)], decreasing = TRUE), ]
#colnames(mdf) = gsub(pattern = "^X", replacement = "", colnames(mdf))
nMut = mdf[, ncol(mdf)]
mdf = mdf[, -ncol(mdf)]
mdf.temp.copy = mdf #temp copy of original unsorted numeric coded matrix
mdf[mdf != 0] = 1 #replacing all non-zero integers with 1 improves sorting (& grouping)
tmdf = t(mdf) #transposematrix
mdf = t(tmdf[do.call(order, c(as.list(as.data.frame(tmdf)), decreasing = TRUE)), ]) #sort
mdf.temp.copy = mdf.temp.copy[rownames(mdf),] #organise original matrix into sorted matrix
mdf.temp.copy = mdf.temp.copy[,colnames(mdf)]
mdf = mdf.temp.copy
#organise original character matrix into sorted matrix
oncomat.copy <- oncomat.copy[,colnames(mdf)]
oncomat.copy <- oncomat.copy[rownames(mdf),]
return(list(oncoMatrix = oncomat.copy, numericMatrix = mdf, vc = variant.classes, cnvc = cnv_events))
}
}
update_vc_codes = function(om_op){
uniq_vc = as.character(unique(unlist(as.numeric(unlist(apply(om_op$numericMatrix, 2, unique))))))
missing_vc = uniq_vc[!uniq_vc %in% names(om_op$vc)]
temp_names = names(om_op$vc)
om_op$vc = c(om_op$vc, rep("Complex_Event", length(missing_vc)))
names(om_op$vc) = c(temp_names, rep(missing_vc, length(missing_vc)))
om_op$vc
}
#---- This is small function to sort genes according to total samples in which it is mutated.
sortByMutation = function(numMat, maf){
geneOrder = getGeneSummary(x = maf)[order(MutatedSamples, decreasing = TRUE), Hugo_Symbol]
numMat = numMat[as.character(geneOrder[geneOrder %in% rownames(numMat)]),, drop = FALSE]
numMat[numMat != 0] = 1 #replacing all non-zero integers with 1 improves sorting (& grouping)
tnumMat = t(numMat) #transposematrix
numMat = t(tnumMat[do.call(order, c(as.list(as.data.frame(tnumMat)), decreasing = TRUE)), ]) #sort
return(numMat)
}
#Thanks to Ryan Morin for the suggestion (https://github.com/rdmorin)
#original code has been changed with vectorized code, in-addition performs class-wise sorting.
sortByAnnotation <-function(numMat,maf, anno, annoOrder = NULL, group = TRUE, isNumeric = FALSE){
if(is.numeric(anno[,1])){
#anno.spl = split(anno, as.numeric(as.character(anno[,1]))) #sorting only first annotation
mat_samps = colnames(numMat)[colnames(numMat) %in% rownames(anno)]
anno = anno[mat_samps,, drop = FALSE]
anno = anno[order(anno[,1], na.last = TRUE),, drop = FALSE]
numMat.sorted = numMat[,rownames(anno)]
}else{
anno[,1] = ifelse(test = is.na(as.character(anno[,1])), yes = "NA", no = as.character(anno[,1])) #NAs are notorious; converting them to characters
anno.spl = split(anno, as.factor(as.character(anno[,1]))) #sorting only first annotation
anno.spl.sort = lapply(X = anno.spl, function(x){
numMat[,colnames(numMat)[colnames(numMat) %in% rownames(x)], drop = FALSE]
})
if(group){
#sort list according to number of elemnts in each classification
anno.spl.sort = anno.spl.sort[names(sort(unlist(lapply(anno.spl.sort, ncol)), decreasing = TRUE, na.last = TRUE))]
}
if(!is.null(annoOrder)){
annoSplOrder = names(anno.spl.sort)
if(length(annoOrder[annoOrder %in% annoSplOrder]) == 0){
message("Values in provided annotation order ", paste(annoOrder, collapse = ", ")," does not match values in clinical features. Here are the available features..")
print(annoSplOrder)
stop()
}
annoOrder = annoOrder[annoOrder %in% annoSplOrder]
anno.spl.sort = anno.spl.sort[annoOrder]
if(length(annoSplOrder[!annoSplOrder %in% annoOrder]) > 0){
warning("Following levels are missing from the provided annotation order: ", paste(annoSplOrder[!annoSplOrder %in% annoOrder], collapse = ", "), immediate. = TRUE)
}
}
numMat.sorted = c()
for(i in 1:length(anno.spl.sort)){
numMat.sorted = cbind(numMat.sorted, anno.spl.sort[[i]])
}
}
return(numMat.sorted)
}
#Sort columns while keeping gene order
sortByGeneOrder = function(m, g){
m = m[g,, drop = FALSE]
tsbs= colnames(m)
tsb.anno = data.table::data.table()
for(i in 1:nrow(m)){
x = m[i,]
tsb.anno = rbind(tsb.anno, data.table::data.table(tsbs = names(x[x!=0]), gene = g[i]))
}
tsb.anno = tsb.anno[!duplicated(tsbs)]
if(length(tsbs[!tsbs %in% tsb.anno[,tsbs]]) > 0){
tsb.anno = rbind(tsb.anno, data.table::data.table(tsbs = tsbs[!tsbs %in% tsb.anno[,tsbs]], gene = NA))
}
data.table::setDF(tsb.anno)
#m.sorted = sortByAnnotation(numMat = m, anno = tsb.anno)
anno.spl = split(tsb.anno, as.factor(as.character(tsb.anno$gene)))
anno.spl.sort = sapply(X = anno.spl, function(x){
m[,colnames(m)[colnames(m) %in% x$tsbs], drop = FALSE]
})
numMat.sorted = c()
for(i in 1:length(anno.spl.sort)){
numMat.sorted = cbind(numMat.sorted, anno.spl.sort[[i]])
}
return(numMat.sorted)
}
#plot_dat = plotting data
#lab_dat = data to be labelled
#x_var = x
#y_var = y
#bubble_var = z (variable name for bubble size)
#bubble_size (exclusive with bubble_var)
#text_size = font size for labels
#col_var = a vector color
bubble_plot = function(plot_dat, lab_dat = NULL, x_var = NULL, y_var = NULL,
bubble_var = NULL, bubble_size = 1, text_var = NULL,
text_size = 1, col_var = NULL, return_dat = FALSE, showscale = FALSE, xlab = NULL, ylab = NULL){
if(showscale){
lo = layout(mat = matrix(data = c(1, 2), nrow = 1, ncol = 2), widths = c(5, 1))
}
x_col_idx = which(colnames(plot_dat) == x_var)
y_col_idx = which(colnames(plot_dat) == y_var)
colnames(plot_dat)[c(x_col_idx, y_col_idx)] = c("x", "y")
if(!is.null(col_var)){
col_idx = which(colnames(plot_dat) == col_var)
colnames(plot_dat)[col_idx] = c("color_var")
}else{
plot_dat$color_var = grDevices::adjustcolor("black", alpha.f = "0.75")
}
if(!is.null(lab_dat)){
x_col_idx = which(colnames(lab_dat) == x_var)
y_col_idx = which(colnames(lab_dat) == y_var)
colnames(lab_dat)[c(x_col_idx, y_col_idx)] = c("x", "y")
if(is.null(text_var)){
stop("Missing text variable")
}else{
colnames(lab_dat)[which(colnames(lab_dat) == text_var)] = "z_text"
}
if(!is.null(col_var)){
col_idx = which(colnames(lab_dat) == col_var)
colnames(lab_dat)[col_idx] = c("color_var")
}else{
lab_dat$color_var = "black"
}
}
if(!is.null(bubble_var)){
if(bubble_var %in% c(x_var, y_var)){
if(which(bubble_var == c(x_var, y_var)) == 2){
plot_dat$size_z = sqrt(as.numeric(plot_dat$y)/pi)
}else if(which(bubble_var == c(x_var, y_var)) == 1){
plot_dat$size_z = sqrt(as.numeric(plot_dat$x)/pi)
}
}else{
if(length(which(colnames(plot_dat) == bubble_var)) > 0){
colnames(plot_dat)[which(colnames(plot_dat) == bubble_var)] = "z"
plot_dat$size_z = sqrt(as.numeric(plot_dat$z)/pi)
}else{
plot_dat$size_z = bubble_size
}
}
if(!is.null(lab_dat)){
if(bubble_var %in% c(x_var, y_var)){
if(which(bubble_var == c(x_var, y_var)) == 2){
lab_dat$size_z = sqrt(as.numeric(lab_dat$y)/pi) * bubble_size
}else if(which(bubble_var == c(x_var, y_var)) == 1){
lab_dat$size_z = sqrt(as.numeric(lab_dat$x)/pi) * bubble_size
}
}else{
colnames(lab_dat)[which(colnames(lab_dat) == bubble_var)] = "z"
lab_dat$size_z = sqrt(as.numeric(lab_dat$z)/pi) * bubble_size
}
}
}else{
plot_dat$size_z = bubble_size
if(!is.null(lab_dat)){
lab_dat$size_z = bubble_size
}
}
x_lims = as.integer(seq(min(as.numeric(plot_dat$x), na.rm = TRUE),
max(as.numeric(plot_dat$x), na.rm = TRUE), length.out = 4))
x_lims[4] = as.integer(ceiling(max(as.numeric(plot_dat$x), na.rm = TRUE)))
x_lims[1] = as.integer(floor(min(as.numeric(plot_dat$x), na.rm = TRUE)))
x_ticks = pretty(x = x_lims, na.rm = TRUE)
x_ticks[c(1, length(x_ticks))] = x_lims[c(1, 4)]
y_lims = as.integer(seq(min(as.numeric(plot_dat$y), na.rm = TRUE),
max(as.numeric(plot_dat$y), na.rm = TRUE), length.out = 4))
y_lims[4] = as.integer(ceiling(max(as.numeric(plot_dat$y), na.rm = TRUE)))
y_lims[1] = as.integer(floor(min(as.numeric(plot_dat$y), na.rm = TRUE)))
y_ticks = pretty(x = y_lims, na.rm = TRUE)
y_ticks[c(1, length(y_ticks))] = y_lims[c(1, 4)]
if(return_dat){
return(list(plots_data = plot_dat, label_cords = lab_dat,
x_lims = x_lims, y_lims = y_lims))
}
# plot(x = plot_dat$x, y = plot_dat$y, cex = plot_dat$size_z,
# pch = 16, col = plot_dat$color_var, axes = FALSE, xlim = x_lims[c(1, 4)],
# ylim = y_lims[c(1, 4)], xlab = NA, ylab = NA)
suppressWarnings(symbols(x = plot_dat$x, y = plot_dat$y, circles = plot_dat$size_z, inches = 0.1, bg = plot_dat$color_var, xlim = x_lims[c(1, 4)],
ylim = y_lims[c(1, 4)], xlab = NA, ylab = NA, fg = "white", axes = FALSE))
axis(side = 1, at = x_ticks)
axis(side = 2, at = y_ticks, las = 2, labels = abs(y_ticks))
abline(h = y_ticks, v = x_ticks, lty = 2,
col = grDevices::adjustcolor(col = "gray70", alpha.f = 0.5), lwd = 0.75)
mtext(text = xlab, side = 1, line = 2)
mtext(text = ylab, side = 2, line = 3)
if(!is.null(lab_dat)){
text(x = lab_dat$x, y = lab_dat$y, labels = lab_dat$z_text, adj = 1, offset = 0.2, cex = text_size, col = lab_dat$color_var, xpd = TRUE)
}
if(showscale){
par(mar = c(2, 1, 1, 1))
plot(x = NA, ylim = c(0, 4.5), xlim = c(0, 2), axes = FALSE, xlab = NA, ylab = NA)
bs = seq(min(plot_dat$size_z), max(plot_dat$size_z), length.out = 4)
bslabs = round(seq(min(plot_dat$z), max(plot_dat$z), length.out = 4), 2)
symbols(y = seq(3, 4, length.out = length(bs)), x = rep(0, length(bs)), circles = bs, add = TRUE, inches = 0.1, bg = "black", xpd = TRUE)
text(x = rep(1, length(bs)), y = seq(3, 4, length.out = length(bs)), labels = bslabs, xpd = TRUE, adj =0)
text(x = 0, y = 4.4, labels = "-log10(q)", xpd = TRUE, adj = 0)
}
}
#Get plot layout for oncoplot
plot_layout = function(clinicalFeatures = NULL, drawRowBar = TRUE,
drawColBar = TRUE, draw_titv = FALSE, exprsTbl = NULL, legend_height = 4, anno_height = 1){
if(is.null(clinicalFeatures)){
if(draw_titv){
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,rep(0,3)), nrow = 3, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, legend_height), widths = c(4,0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3, 4,rep(0,4)), nrow = 4, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, 4, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, 4, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, 4), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7,7), nrow = 3, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, 4, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,10,10), nrow = 4, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1,4, 1), heights = c(4, 12, 4, legend_height))
}
}
}else{
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,rep(0,2)), nrow = 2, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,3), nrow = 2, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,rep(0,3)), nrow = 3, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,3), nrow = 2, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,4,4), nrow = 2, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7,7), nrow = 3, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1, 4, 1), heights = c(4, 12, legend_height))
}
}
}
}else{
if(draw_titv){
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,rep(0,4)), nrow = 4, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,rep(0,5)), nrow = 5, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, 4, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,9), nrow = 5, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, 4, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,10,10), nrow = 4, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,9), nrow = 5, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, anno_height, 4, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,11,12,13,13,13), nrow = 5, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1, 4, 1), heights = c(4, 12, anno_height, 4, legend_height))
}
}
}else{
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,rep(0,3)), nrow = 3, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,rep(0,4)), nrow = 4, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7,7), nrow = 3, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, anno_height, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,10,10), nrow = 4, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1, 4, 1), heights = c(4, 12, anno_height, legend_height))
}
}
}
}
lo
}
get_domain_cols = function(){
c("#f3a683", "#f7d794", "#778beb", "#e77f67", "#cf6a87", "#f19066",
"#f5cd79", "#546de5", "#e15f41", "#c44569", "#786fa6", "#f8a5c2",
"#63cdda", "#ea8685", "#596275", "#574b90", "#f78fb3", "#3dc1d3",
"#e66767", "#303952")
}
get_vcColors = function(alpha = 1, websafe = FALSE, named = TRUE){
if(websafe){
col = c("#F44336", "#E91E63", "#9C27B0", "#673AB7", "#3F51B5", "#2196F3",
"#03A9F4", "#00BCD4", "#009688", "#4CAF50", "#8BC34A", "#CDDC39",
"#FFEB3B", "#FFC107", "#FF9800", "#FF5722", "#795548", "#9E9E9E",
"#607D8B")
}else{
col = c(RColorBrewer::brewer.pal(11, name = "Paired"), RColorBrewer::brewer.pal(11,name = "Spectral")[1:3],'black', 'violet', 'royalblue', '#7b7060', '#535c68')
col = grDevices::adjustcolor(col = col, alpha.f = alpha)
}
if(named){
names(col) = names = c('Nonstop_Mutation','Frame_Shift_Del','IGR','Missense_Mutation','Silent','Nonsense_Mutation',
'RNA','Splice_Site','Intron','Frame_Shift_Ins','In_Frame_Del','ITD','In_Frame_Ins',
'Translation_Start_Site',"Multi_Hit", 'Amp', 'Del', 'Complex_Event', 'pathway')
}
col
}
get_titvCol = function(alpha = 1){
col = c("#F44336", "#3F51B5", "#2196F3", "#4CAF50", "#FFC107", "#FF9800")
#col = c('coral4', 'lightcyan4', 'cornflowerblue', 'lightsalmon1', 'forestgreen', 'deeppink3')
col = grDevices::adjustcolor(col = col, alpha.f = alpha)
names(col) = c('C>T', 'C>G', 'C>A', 'T>A', 'T>C', 'T>G')
col
}
parse_annotation_dat = function(annotationDat = NULL, clinicalFeatures = NULL){
if(class(annotationDat)[1] == 'MAF'){
annotationDat = data.table::copy(getClinicalData(x = annotationDat))
data.table::setDF(annotationDat)
}else if(class(annotationDat)[1] %in% c('data.frame', 'data.table')){
data.table::setDF(annotationDat)
}else{
return(NULL)
}
if(length(clinicalFeatures[!clinicalFeatures %in% colnames(annotationDat)]) > 0){
message('Following columns are missing from annotation slot of MAF. Ignoring them..')
print(clinicalFeatures[!clinicalFeatures %in% colnames(annotationDat)])
clinicalFeatures = clinicalFeatures[clinicalFeatures %in% colnames(annotationDat)]
if(length(clinicalFeatures) == 0){
message('Make sure at-least one of the values from provided clinicalFeatures are present in annotation slot of MAF. Here are available annotaions..')
print(colnames(annotationDat))
stop('Zero annotaions to add! You can also provide custom annotations via annotationDat argument.')
}
}
annotation = data.frame(row.names = annotationDat$Tumor_Sample_Barcode ,annotationDat[,clinicalFeatures, drop = FALSE], stringsAsFactors = FALSE)
return(annotation)
}
get_anno_cols = function(ann, numericAnnoCol = NULL){
ann_cols = list()
if(is.null(numericAnnoCol)){
numericAnnoCol = RColorBrewer::brewer.pal(n = 9, name = "YlOrBr")
}else{
numericAnnoCol = RColorBrewer::brewer.pal(n = 9, name = numericAnnoCol)
}
for(i in 1:ncol(ann)){
if(is.numeric(ann[,i])){
x = ann[,i]
ann_lvls_cols = colorRampPalette(numericAnnoCol)(length(x))
names(ann_lvls_cols) = x[order(x, na.last = TRUE)]
ann_cols[[i]] = ann_lvls_cols
}else{
ann_lvls = unique(as.character(ann[,i]))
if(length(ann_lvls) <= 9){
ann_lvls_cols = RColorBrewer::brewer.pal(n = 9, name = 'Set1')[1:length(ann_lvls)]
}else{
ann_lvls_cols = colors()[sample(x = 1:100, size = length(ann_lvls), replace = FALSE)]
}
ann_cols[[i]] = ann_lvls_cols
names(ann_cols[[i]]) = ann_lvls
}
}
names(ann_cols) = colnames(ann)
return(ann_cols)
}
pathway_load = function(maf){
pathdb <- system.file("extdata", "BP_SMGs.txt.gz", package = "maftools")
pathdb = data.table::fread(input = pathdb, skip = "Gene")
pathdb = pathdb[!duplicated(Gene)][,.(Gene, Pathway)]
pathdb$Pathway = gsub(pattern = " ", replacement = "_", x = pathdb$Pathway)
pathdb_size = pathdb[,.N,Pathway]
pathdb = split(pathdb, as.factor(pathdb$Pathway))
altered_pws = lapply(pathdb, function(pw){
x = suppressMessages(try(genesToBarcodes(maf = maf, genes = pw$Gene)))
if(class(x) == "try-error"){
pw_genes = NULL
}else{
pw_genes = names(genesToBarcodes(maf = maf, genes = pw$Gene, justNames = TRUE, verbose = FALSE))
}
pw_genes
})
mut_load = lapply(altered_pws, function(x){
if(is.null(x)){
nsamps = 0
}else{
nsamps = length(unique(as.character(unlist(
genesToBarcodes(
maf = maf,
genes = x,
justNames = TRUE
)
))))
}
nsamps
})
altered_pws = as.data.frame(t(data.frame(lapply(altered_pws, length))))
data.table::setDT(x = altered_pws, keep.rownames = TRUE)
colnames(altered_pws) = c("Pathway", "n_affected_genes")
altered_pws$Pathway = gsub(pattern = "\\.", replacement = "-", x = altered_pws$Pathway)
altered_pws = merge(pathdb_size, altered_pws, all.x = TRUE)
altered_pws[, fraction_affected := n_affected_genes/N]
altered_pws$Mutated_samples = unlist(mut_load)
nsamps = as.numeric(maf@summary[ID == "Samples", summary])
altered_pws[,Fraction_mutated_samples := Mutated_samples/nsamps]
altered_pws = altered_pws[order(Fraction_mutated_samples, fraction_affected, decreasing = TRUE)]
altered_pws = altered_pws[!n_affected_genes %in% 0]
altered_pws
}
#Update missing colors
update_colors = function(x, y){
x = as.character(x)
avail_colors = as.character(y[!names(y) %in% x])
missing_entries = as.character(x)[!as.character(x) %in% names(y)]
missing_entries = missing_entries[!missing_entries %in% ""]
if(length(missing_entries) > 0){
if(length(missing_entries) > length(avail_colors)){
avail_colors = sample(x = colors(distinct = TRUE), size = length(missing_entries), replace = FALSE)
names(avail_colors) = missing_entries
y = c(y, avail_colors)
}else{
avail_colors = avail_colors[1:length(missing_entries)]
names(avail_colors) = missing_entries
y = c(y, avail_colors)
}
}
y
}
Try the maftools package in your browser
Any scripts or data that you put into this service are public.
maftools documentation built on Feb. 6, 2021, 2 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions createOncoMatrix
createOncoMatrix = function(m, g = NULL, chatty = TRUE, add_missing = FALSE){
if(is.null(g)){
stop("Please provde atleast two genes!")
}
subMaf = subsetMaf(maf = m, genes = g, includeSyn = FALSE, mafObj = FALSE)
if(nrow(subMaf) == 0){
if(add_missing){
numericMatrix = matrix(data = 0, nrow = length(g), ncol = length(levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])))
rownames(numericMatrix) = g
colnames(numericMatrix) = levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])
oncoMatrix = matrix(data = "", nrow = length(g), ncol = length(levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])))
rownames(oncoMatrix) = g
colnames(oncoMatrix) = levels(getSampleSummary(x = m)[,Tumor_Sample_Barcode])
vc = c("")
names(vc) = 0
return(list(oncoMatrix = oncoMatrix, numericMatrix = numericMatrix, vc = vc))
}else{
return(NULL)
}
}
if(add_missing){
subMaf[, Hugo_Symbol := factor(x = Hugo_Symbol, levels = g)]
}
cnv_events = c(c("Amp", "Del"), as.character(subMaf[Variant_Type == "CNV"][, .N, Variant_Classification][, Variant_Classification]))
cnv_events = unique(cnv_events)
oncomat = data.table::dcast(data = subMaf[,.(Hugo_Symbol, Variant_Classification, Tumor_Sample_Barcode)], formula = Hugo_Symbol ~ Tumor_Sample_Barcode,
fun.aggregate = function(x, cnv = cnv_events){
#x = unique(as.character(x)) #>=2 distinct variant classification = Multi_Hit
x = as.character(x) # >= 2 same/distinct variant classification = Multi_Hit See #347
xad = x[x %in% cnv]
xvc = x[!x %in% cnv]
if(length(xvc)>0){
xvc = ifelse(test = length(xvc) > 1, yes = 'Multi_Hit', no = xvc)
}
x = ifelse(test = length(xad) > 0, yes = paste(xad, xvc, sep = ';'), no = xvc)
x = gsub(pattern = ';$', replacement = '', x = x)
x = gsub(pattern = '^;', replacement = '', x = x)
return(x)
} , value.var = 'Variant_Classification', fill = '', drop = FALSE)
#convert to matrix
data.table::setDF(oncomat)
rownames(oncomat) = oncomat$Hugo_Symbol
oncomat = as.matrix(oncomat[,-1, drop = FALSE])
variant.classes = as.character(unique(subMaf[,Variant_Classification]))
variant.classes = c('',variant.classes, 'Multi_Hit')
names(variant.classes) = 0:(length(variant.classes)-1)
#Complex variant classes will be assigned a single integer.
vc.onc = unique(unlist(apply(oncomat, 2, unique)))
vc.onc = vc.onc[!vc.onc %in% names(variant.classes)]
names(vc.onc) = rep(as.character(as.numeric(names(variant.classes)[length(variant.classes)])+1), length(vc.onc))
variant.classes2 = c(variant.classes, vc.onc)
oncomat.copy <- oncomat
#Make a numeric coded matrix
for(i in 1:length(variant.classes2)){
oncomat[oncomat == variant.classes2[i]] = names(variant.classes2)[i]
}
#If maf has only one gene
if(nrow(oncomat) == 1){
mdf = t(matrix(as.numeric(oncomat)))
rownames(mdf) = rownames(oncomat)
colnames(mdf) = colnames(oncomat)
return(list(oncoMatrix = oncomat.copy, numericMatrix = mdf, vc = variant.classes))
}
#convert from character to numeric
mdf = as.matrix(apply(oncomat, 2, function(x) as.numeric(as.character(x))))
rownames(mdf) = rownames(oncomat.copy)
#If MAF file contains a single sample, simple sorting is enuf.
if(ncol(mdf) == 1){
sampleId = colnames(mdf)
mdf = as.matrix(mdf[order(mdf, decreasing = TRUE),])
colnames(mdf) = sampleId
oncomat.copy = as.matrix(oncomat.copy[rownames(mdf),])
colnames(oncomat.copy) = sampleId
return(list(oncoMatrix = oncomat.copy, numericMatrix = mdf, vc = variant.classes))
} else{
#Sort by rows as well columns if >1 samples present in MAF
#Add total variants per gene
mdf = cbind(mdf, variants = apply(mdf, 1, function(x) {
length(x[x != "0"])
}))
#Sort by total variants
mdf = mdf[order(mdf[, ncol(mdf)], decreasing = TRUE), ]
#colnames(mdf) = gsub(pattern = "^X", replacement = "", colnames(mdf))
nMut = mdf[, ncol(mdf)]
mdf = mdf[, -ncol(mdf)]
mdf.temp.copy = mdf #temp copy of original unsorted numeric coded matrix
mdf[mdf != 0] = 1 #replacing all non-zero integers with 1 improves sorting (& grouping)
tmdf = t(mdf) #transposematrix
mdf = t(tmdf[do.call(order, c(as.list(as.data.frame(tmdf)), decreasing = TRUE)), ]) #sort
mdf.temp.copy = mdf.temp.copy[rownames(mdf),] #organise original matrix into sorted matrix
mdf.temp.copy = mdf.temp.copy[,colnames(mdf)]
mdf = mdf.temp.copy
#organise original character matrix into sorted matrix
oncomat.copy <- oncomat.copy[,colnames(mdf)]
oncomat.copy <- oncomat.copy[rownames(mdf),]
return(list(oncoMatrix = oncomat.copy, numericMatrix = mdf, vc = variant.classes, cnvc = cnv_events))
}
}
update_vc_codes = function(om_op){
uniq_vc = as.character(unique(unlist(as.numeric(unlist(apply(om_op$numericMatrix, 2, unique))))))
missing_vc = uniq_vc[!uniq_vc %in% names(om_op$vc)]
temp_names = names(om_op$vc)
om_op$vc = c(om_op$vc, rep("Complex_Event", length(missing_vc)))
names(om_op$vc) = c(temp_names, rep(missing_vc, length(missing_vc)))
om_op$vc
}
#---- This is small function to sort genes according to total samples in which it is mutated.
sortByMutation = function(numMat, maf){
geneOrder = getGeneSummary(x = maf)[order(MutatedSamples, decreasing = TRUE), Hugo_Symbol]
numMat = numMat[as.character(geneOrder[geneOrder %in% rownames(numMat)]),, drop = FALSE]
numMat[numMat != 0] = 1 #replacing all non-zero integers with 1 improves sorting (& grouping)
tnumMat = t(numMat) #transposematrix
numMat = t(tnumMat[do.call(order, c(as.list(as.data.frame(tnumMat)), decreasing = TRUE)), ]) #sort
return(numMat)
}
#Thanks to Ryan Morin for the suggestion (https://github.com/rdmorin)
#original code has been changed with vectorized code, in-addition performs class-wise sorting.
sortByAnnotation <-function(numMat,maf, anno, annoOrder = NULL, group = TRUE, isNumeric = FALSE){
if(is.numeric(anno[,1])){
#anno.spl = split(anno, as.numeric(as.character(anno[,1]))) #sorting only first annotation
mat_samps = colnames(numMat)[colnames(numMat) %in% rownames(anno)]
anno = anno[mat_samps,, drop = FALSE]
anno = anno[order(anno[,1], na.last = TRUE),, drop = FALSE]
numMat.sorted = numMat[,rownames(anno)]
}else{
anno[,1] = ifelse(test = is.na(as.character(anno[,1])), yes = "NA", no = as.character(anno[,1])) #NAs are notorious; converting them to characters
anno.spl = split(anno, as.factor(as.character(anno[,1]))) #sorting only first annotation
anno.spl.sort = lapply(X = anno.spl, function(x){
numMat[,colnames(numMat)[colnames(numMat) %in% rownames(x)], drop = FALSE]
})
if(group){
#sort list according to number of elemnts in each classification
anno.spl.sort = anno.spl.sort[names(sort(unlist(lapply(anno.spl.sort, ncol)), decreasing = TRUE, na.last = TRUE))]
}
if(!is.null(annoOrder)){
annoSplOrder = names(anno.spl.sort)
if(length(annoOrder[annoOrder %in% annoSplOrder]) == 0){
message("Values in provided annotation order ", paste(annoOrder, collapse = ", ")," does not match values in clinical features. Here are the available features..")
print(annoSplOrder)
stop()
}
annoOrder = annoOrder[annoOrder %in% annoSplOrder]
anno.spl.sort = anno.spl.sort[annoOrder]
if(length(annoSplOrder[!annoSplOrder %in% annoOrder]) > 0){
warning("Following levels are missing from the provided annotation order: ", paste(annoSplOrder[!annoSplOrder %in% annoOrder], collapse = ", "), immediate. = TRUE)
}
}
numMat.sorted = c()
for(i in 1:length(anno.spl.sort)){
numMat.sorted = cbind(numMat.sorted, anno.spl.sort[[i]])
}
}
return(numMat.sorted)
}
#Sort columns while keeping gene order
sortByGeneOrder = function(m, g){
m = m[g,, drop = FALSE]
tsbs= colnames(m)
tsb.anno = data.table::data.table()
for(i in 1:nrow(m)){
x = m[i,]
tsb.anno = rbind(tsb.anno, data.table::data.table(tsbs = names(x[x!=0]), gene = g[i]))
}
tsb.anno = tsb.anno[!duplicated(tsbs)]
if(length(tsbs[!tsbs %in% tsb.anno[,tsbs]]) > 0){
tsb.anno = rbind(tsb.anno, data.table::data.table(tsbs = tsbs[!tsbs %in% tsb.anno[,tsbs]], gene = NA))
}
data.table::setDF(tsb.anno)
#m.sorted = sortByAnnotation(numMat = m, anno = tsb.anno)
anno.spl = split(tsb.anno, as.factor(as.character(tsb.anno$gene)))
anno.spl.sort = sapply(X = anno.spl, function(x){
m[,colnames(m)[colnames(m) %in% x$tsbs], drop = FALSE]
})
numMat.sorted = c()
for(i in 1:length(anno.spl.sort)){
numMat.sorted = cbind(numMat.sorted, anno.spl.sort[[i]])
}
return(numMat.sorted)
}
#plot_dat = plotting data
#lab_dat = data to be labelled
#x_var = x
#y_var = y
#bubble_var = z (variable name for bubble size)
#bubble_size (exclusive with bubble_var)
#text_size = font size for labels
#col_var = a vector color
bubble_plot = function(plot_dat, lab_dat = NULL, x_var = NULL, y_var = NULL,
bubble_var = NULL, bubble_size = 1, text_var = NULL,
text_size = 1, col_var = NULL, return_dat = FALSE, showscale = FALSE, xlab = NULL, ylab = NULL){
if(showscale){
lo = layout(mat = matrix(data = c(1, 2), nrow = 1, ncol = 2), widths = c(5, 1))
}
x_col_idx = which(colnames(plot_dat) == x_var)
y_col_idx = which(colnames(plot_dat) == y_var)
colnames(plot_dat)[c(x_col_idx, y_col_idx)] = c("x", "y")
if(!is.null(col_var)){
col_idx = which(colnames(plot_dat) == col_var)
colnames(plot_dat)[col_idx] = c("color_var")
}else{
plot_dat$color_var = grDevices::adjustcolor("black", alpha.f = "0.75")
}
if(!is.null(lab_dat)){
x_col_idx = which(colnames(lab_dat) == x_var)
y_col_idx = which(colnames(lab_dat) == y_var)
colnames(lab_dat)[c(x_col_idx, y_col_idx)] = c("x", "y")
if(is.null(text_var)){
stop("Missing text variable")
}else{
colnames(lab_dat)[which(colnames(lab_dat) == text_var)] = "z_text"
}
if(!is.null(col_var)){
col_idx = which(colnames(lab_dat) == col_var)
colnames(lab_dat)[col_idx] = c("color_var")
}else{
lab_dat$color_var = "black"
}
}
if(!is.null(bubble_var)){
if(bubble_var %in% c(x_var, y_var)){
if(which(bubble_var == c(x_var, y_var)) == 2){
plot_dat$size_z = sqrt(as.numeric(plot_dat$y)/pi)
}else if(which(bubble_var == c(x_var, y_var)) == 1){
plot_dat$size_z = sqrt(as.numeric(plot_dat$x)/pi)
}
}else{
if(length(which(colnames(plot_dat) == bubble_var)) > 0){
colnames(plot_dat)[which(colnames(plot_dat) == bubble_var)] = "z"
plot_dat$size_z = sqrt(as.numeric(plot_dat$z)/pi)
}else{
plot_dat$size_z = bubble_size
}
}
if(!is.null(lab_dat)){
if(bubble_var %in% c(x_var, y_var)){
if(which(bubble_var == c(x_var, y_var)) == 2){
lab_dat$size_z = sqrt(as.numeric(lab_dat$y)/pi) * bubble_size
}else if(which(bubble_var == c(x_var, y_var)) == 1){
lab_dat$size_z = sqrt(as.numeric(lab_dat$x)/pi) * bubble_size
}
}else{
colnames(lab_dat)[which(colnames(lab_dat) == bubble_var)] = "z"
lab_dat$size_z = sqrt(as.numeric(lab_dat$z)/pi) * bubble_size
}
}
}else{
plot_dat$size_z = bubble_size
if(!is.null(lab_dat)){
lab_dat$size_z = bubble_size
}
}
x_lims = as.integer(seq(min(as.numeric(plot_dat$x), na.rm = TRUE),
max(as.numeric(plot_dat$x), na.rm = TRUE), length.out = 4))
x_lims[4] = as.integer(ceiling(max(as.numeric(plot_dat$x), na.rm = TRUE)))
x_lims[1] = as.integer(floor(min(as.numeric(plot_dat$x), na.rm = TRUE)))
x_ticks = pretty(x = x_lims, na.rm = TRUE)
x_ticks[c(1, length(x_ticks))] = x_lims[c(1, 4)]
y_lims = as.integer(seq(min(as.numeric(plot_dat$y), na.rm = TRUE),
max(as.numeric(plot_dat$y), na.rm = TRUE), length.out = 4))
y_lims[4] = as.integer(ceiling(max(as.numeric(plot_dat$y), na.rm = TRUE)))
y_lims[1] = as.integer(floor(min(as.numeric(plot_dat$y), na.rm = TRUE)))
y_ticks = pretty(x = y_lims, na.rm = TRUE)
y_ticks[c(1, length(y_ticks))] = y_lims[c(1, 4)]
if(return_dat){
return(list(plots_data = plot_dat, label_cords = lab_dat,
x_lims = x_lims, y_lims = y_lims))
}
# plot(x = plot_dat$x, y = plot_dat$y, cex = plot_dat$size_z,
# pch = 16, col = plot_dat$color_var, axes = FALSE, xlim = x_lims[c(1, 4)],
# ylim = y_lims[c(1, 4)], xlab = NA, ylab = NA)
suppressWarnings(symbols(x = plot_dat$x, y = plot_dat$y, circles = plot_dat$size_z, inches = 0.1, bg = plot_dat$color_var, xlim = x_lims[c(1, 4)],
ylim = y_lims[c(1, 4)], xlab = NA, ylab = NA, fg = "white", axes = FALSE))
axis(side = 1, at = x_ticks)
axis(side = 2, at = y_ticks, las = 2, labels = abs(y_ticks))
abline(h = y_ticks, v = x_ticks, lty = 2,
col = grDevices::adjustcolor(col = "gray70", alpha.f = 0.5), lwd = 0.75)
mtext(text = xlab, side = 1, line = 2)
mtext(text = ylab, side = 2, line = 3)
if(!is.null(lab_dat)){
text(x = lab_dat$x, y = lab_dat$y, labels = lab_dat$z_text, adj = 1, offset = 0.2, cex = text_size, col = lab_dat$color_var, xpd = TRUE)
}
if(showscale){
par(mar = c(2, 1, 1, 1))
plot(x = NA, ylim = c(0, 4.5), xlim = c(0, 2), axes = FALSE, xlab = NA, ylab = NA)
bs = seq(min(plot_dat$size_z), max(plot_dat$size_z), length.out = 4)
bslabs = round(seq(min(plot_dat$z), max(plot_dat$z), length.out = 4), 2)
symbols(y = seq(3, 4, length.out = length(bs)), x = rep(0, length(bs)), circles = bs, add = TRUE, inches = 0.1, bg = "black", xpd = TRUE)
text(x = rep(1, length(bs)), y = seq(3, 4, length.out = length(bs)), labels = bslabs, xpd = TRUE, adj =0)
text(x = 0, y = 4.4, labels = "-log10(q)", xpd = TRUE, adj = 0)
}
}
#Get plot layout for oncoplot
plot_layout = function(clinicalFeatures = NULL, drawRowBar = TRUE,
drawColBar = TRUE, draw_titv = FALSE, exprsTbl = NULL, legend_height = 4, anno_height = 1){
if(is.null(clinicalFeatures)){
if(draw_titv){
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,rep(0,3)), nrow = 3, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, legend_height), widths = c(4,0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3, 4,rep(0,4)), nrow = 4, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, 4, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, 4, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, 4), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7,7), nrow = 3, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, 4, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, 4, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,10,10), nrow = 4, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1,4, 1), heights = c(4, 12, 4, legend_height))
}
}
}else{
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,rep(0,2)), nrow = 2, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,3), nrow = 2, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,rep(0,3)), nrow = 3, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,3), nrow = 2, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,4,4), nrow = 2, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7,7), nrow = 3, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1, 4, 1), heights = c(4, 12, legend_height))
}
}
}
}else{
if(draw_titv){
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,rep(0,4)), nrow = 4, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,rep(0,5)), nrow = 5, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, 4, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,9), nrow = 5, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, 4, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,10,10), nrow = 4, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, 4, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,9), nrow = 5, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, anno_height, 4, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,11,12,13,13,13), nrow = 5, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1, 4, 1), heights = c(4, 12, anno_height, 4, legend_height))
}
}
}else{
if(!drawRowBar & !drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,rep(0,3)), nrow = 3, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(1, 4))
}
}else if(!drawRowBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,rep(0,4)), nrow = 4, ncol = 2, byrow = FALSE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, legend_height), widths = c(4, 0.5))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(4, 12, anno_height, legend_height), widths = c(1, 4))
}
}else if(!drawColBar){
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,5), nrow = 3, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(4, 1))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7,7), nrow = 3, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, heights = c(12, anno_height, legend_height), widths = c(1, 4, 1))
}
}else{
if(is.null(exprsTbl)){
mat_lo = matrix(data = c(1,2,3,4,5,6,7,7), nrow = 4, ncol = 2, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(4, 1), heights = c(4, 12, anno_height, legend_height))
}else{
mat_lo = matrix(data = c(1,2,3,4,5,6,7,8,9,10,10,10), nrow = 4, ncol = 3, byrow = TRUE)
lo = graphics::layout(mat = mat_lo, widths = c(1, 4, 1), heights = c(4, 12, anno_height, legend_height))
}
}
}
}
lo
}
get_domain_cols = function(){
c("#f3a683", "#f7d794", "#778beb", "#e77f67", "#cf6a87", "#f19066",
"#f5cd79", "#546de5", "#e15f41", "#c44569", "#786fa6", "#f8a5c2",
"#63cdda", "#ea8685", "#596275", "#574b90", "#f78fb3", "#3dc1d3",
"#e66767", "#303952")
}
get_vcColors = function(alpha = 1, websafe = FALSE, named = TRUE){
if(websafe){
col = c("#F44336", "#E91E63", "#9C27B0", "#673AB7", "#3F51B5", "#2196F3",
"#03A9F4", "#00BCD4", "#009688", "#4CAF50", "#8BC34A", "#CDDC39",
"#FFEB3B", "#FFC107", "#FF9800", "#FF5722", "#795548", "#9E9E9E",
"#607D8B")
}else{
col = c(RColorBrewer::brewer.pal(11, name = "Paired"), RColorBrewer::brewer.pal(11,name = "Spectral")[1:3],'black', 'violet', 'royalblue', '#7b7060', '#535c68')
col = grDevices::adjustcolor(col = col, alpha.f = alpha)
}
if(named){
names(col) = names = c('Nonstop_Mutation','Frame_Shift_Del','IGR','Missense_Mutation','Silent','Nonsense_Mutation',
'RNA','Splice_Site','Intron','Frame_Shift_Ins','In_Frame_Del','ITD','In_Frame_Ins',
'Translation_Start_Site',"Multi_Hit", 'Amp', 'Del', 'Complex_Event', 'pathway')
}
col
}
get_titvCol = function(alpha = 1){
col = c("#F44336", "#3F51B5", "#2196F3", "#4CAF50", "#FFC107", "#FF9800")
#col = c('coral4', 'lightcyan4', 'cornflowerblue', 'lightsalmon1', 'forestgreen', 'deeppink3')
col = grDevices::adjustcolor(col = col, alpha.f = alpha)
names(col) = c('C>T', 'C>G', 'C>A', 'T>A', 'T>C', 'T>G')
col
}
parse_annotation_dat = function(annotationDat = NULL, clinicalFeatures = NULL){
if(class(annotationDat)[1] == 'MAF'){
annotationDat = data.table::copy(getClinicalData(x = annotationDat))
data.table::setDF(annotationDat)
}else if(class(annotationDat)[1] %in% c('data.frame', 'data.table')){
data.table::setDF(annotationDat)
}else{
return(NULL)
}
if(length(clinicalFeatures[!clinicalFeatures %in% colnames(annotationDat)]) > 0){
message('Following columns are missing from annotation slot of MAF. Ignoring them..')
print(clinicalFeatures[!clinicalFeatures %in% colnames(annotationDat)])
clinicalFeatures = clinicalFeatures[clinicalFeatures %in% colnames(annotationDat)]
if(length(clinicalFeatures) == 0){
message('Make sure at-least one of the values from provided clinicalFeatures are present in annotation slot of MAF. Here are available annotaions..')
print(colnames(annotationDat))
stop('Zero annotaions to add! You can also provide custom annotations via annotationDat argument.')
}
}
annotation = data.frame(row.names = annotationDat$Tumor_Sample_Barcode ,annotationDat[,clinicalFeatures, drop = FALSE], stringsAsFactors = FALSE)
return(annotation)
}
get_anno_cols = function(ann, numericAnnoCol = NULL){
ann_cols = list()
if(is.null(numericAnnoCol)){
numericAnnoCol = RColorBrewer::brewer.pal(n = 9, name = "YlOrBr")
}else{
numericAnnoCol = RColorBrewer::brewer.pal(n = 9, name = numericAnnoCol)
}
for(i in 1:ncol(ann)){
if(is.numeric(ann[,i])){
x = ann[,i]
ann_lvls_cols = colorRampPalette(numericAnnoCol)(length(x))
names(ann_lvls_cols) = x[order(x, na.last = TRUE)]
ann_cols[[i]] = ann_lvls_cols
}else{
ann_lvls = unique(as.character(ann[,i]))
if(length(ann_lvls) <= 9){
ann_lvls_cols = RColorBrewer::brewer.pal(n = 9, name = 'Set1')[1:length(ann_lvls)]
}else{
ann_lvls_cols = colors()[sample(x = 1:100, size = length(ann_lvls), replace = FALSE)]
}
ann_cols[[i]] = ann_lvls_cols
names(ann_cols[[i]]) = ann_lvls
}
}
names(ann_cols) = colnames(ann)
return(ann_cols)
}
pathway_load = function(maf){
pathdb <- system.file("extdata", "BP_SMGs.txt.gz", package = "maftools")
pathdb = data.table::fread(input = pathdb, skip = "Gene")
pathdb = pathdb[!duplicated(Gene)][,.(Gene, Pathway)]
pathdb$Pathway = gsub(pattern = " ", replacement = "_", x = pathdb$Pathway)
pathdb_size = pathdb[,.N,Pathway]
pathdb = split(pathdb, as.factor(pathdb$Pathway))
altered_pws = lapply(pathdb, function(pw){
x = suppressMessages(try(genesToBarcodes(maf = maf, genes = pw$Gene)))
if(class(x) == "try-error"){
pw_genes = NULL
}else{
pw_genes = names(genesToBarcodes(maf = maf, genes = pw$Gene, justNames = TRUE, verbose = FALSE))
}
pw_genes
})
mut_load = lapply(altered_pws, function(x){
if(is.null(x)){
nsamps = 0
}else{
nsamps = length(unique(as.character(unlist(
genesToBarcodes(
maf = maf,
genes = x,
justNames = TRUE
)
))))
}
nsamps
})
altered_pws = as.data.frame(t(data.frame(lapply(altered_pws, length))))
data.table::setDT(x = altered_pws, keep.rownames = TRUE)
colnames(altered_pws) = c("Pathway", "n_affected_genes")
altered_pws$Pathway = gsub(pattern = "\\.", replacement = "-", x = altered_pws$Pathway)
altered_pws = merge(pathdb_size, altered_pws, all.x = TRUE)
altered_pws[, fraction_affected := n_affected_genes/N]
altered_pws$Mutated_samples = unlist(mut_load)
nsamps = as.numeric(maf@summary[ID == "Samples", summary])
altered_pws[,Fraction_mutated_samples := Mutated_samples/nsamps]
altered_pws = altered_pws[order(Fraction_mutated_samples, fraction_affected, decreasing = TRUE)]
altered_pws = altered_pws[!n_affected_genes %in% 0]
altered_pws
}
#Update missing colors
update_colors = function(x, y){
x = as.character(x)
avail_colors = as.character(y[!names(y) %in% x])
missing_entries = as.character(x)[!as.character(x) %in% names(y)]
missing_entries = missing_entries[!missing_entries %in% ""]
if(length(missing_entries) > 0){
if(length(missing_entries) > length(avail_colors)){
avail_colors = sample(x = colors(distinct = TRUE), size = length(missing_entries), replace = FALSE)
names(avail_colors) = missing_entries
y = c(y, avail_colors)
}else{
avail_colors = avail_colors[1:length(missing_entries)]
names(avail_colors) = missing_entries
y = c(y, avail_colors)
}
}
y
}
Try the maftools package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.