#' @title plotMutProfile
#'
#' @param maf Maf or MafList object generated by \code{\link{readMaf}} function.
#' @param patient.id Select or reorder the patients. Default NULL, all patients are included.
#' Classify SSNVs/Indels into Shared/P-shared/Private, Clonal/Subclonl
#' or Shared-Clonal/P-shared-Clonal/Private-Clonal/Shared-Subclonal/P-shared-SubClonal/Private-SubClonal
#' @param class The class which would be represented. Default "SP" (Shared pattern: Public/Shared/Private),
#' other options: "CS" (Clonal status: Clonal/Subclonl) and "SPCS".
#' @param classByTumor Logical (Default: FALSE). Define shared pattern of mutations based on tumor types (TRUE) or samples (FALSE)
#' @param topGenesCount The number of genes print, Default 10.
#' @param geneList A list of genes to restrict the analysis. Default NULL.
#' @param sample.text.size Fontsize of sample name. Default 11.
#' @param gene.text.size Fontsize of gene text. Default 11.
#' @param legend.text.size Fontsize of legend text. Default 11.
#' @param legend.title.size Fontsize of legend title. Default 11.
#' @param patientsCol A list containing customized colors for distinct patients. Default NULL.
#' @param bgCol Background grid color. Default "#f0f0f0".
#' @param removeEmptyCols Logical (Default: TRUE). Whether remove the samples without alterations.
#' @param removeEmptyRows Logical (Default: TRUE). Whether remove the genes without alterations.
#' @param showColnames Logical (Default: TRUE). Show sample names of columns.
#' @param sampleOrder A named list which contains the sample order used in plotting the final profile. Default NULL.
#' @param use.tumorSampleLabel Logical (Default: FALSE). Rename the 'Tumor_Sample_Barcode' with 'Tumor_Sample_Label'.
#' @param ... Other options passed to \code{\link{subMaf}}
#' @return Mutational profile
#'
#' @examples
#' maf.File <- system.file("extdata/", "CRC_HZ.maf", package = "MesKit")
#' clin.File <- system.file("extdata/", "CRC_HZ.clin.txt", package = "MesKit")
#' ccf.File <- system.file("extdata/", "CRC_HZ.ccf.tsv", package = "MesKit")
#' maf <- readMaf(mafFile=maf.File, clinicalFile = clin.File, ccfFile=ccf.File, refBuild="hg19")
#' plotMutProfile(maf, class = "SP")
#' @import ComplexHeatmap
#' @importFrom stats na.omit
#' @export plotMutProfile
plotMutProfile <- function(maf,
patient.id = NULL,
class = "SP",
classByTumor = FALSE,
topGenesCount = 10,
geneList = NULL,
sample.text.size = 11,
gene.text.size = 11,
legend.text.size = 11,
legend.title.size = 11,
bgCol = "#f0f0f0",
patientsCol = NULL,
removeEmptyCols = TRUE,
removeEmptyRows = TRUE,
showColnames = TRUE,
sampleOrder = NULL,
use.tumorSampleLabel = FALSE,
...) {
## filter maf and order patient
maf_input <- subMaf(maf,
patient.id = patient.id,
mafObj = TRUE,
use.tumorSampleLabel = use.tumorSampleLabel,
...)
if (any(names(maf_input) != patient.id)) {
mafTemp <- list()
for (i in seq_len(length(maf_input))) {
mafTemp[i] <- maf_input[which(names(maf_input) == patient.id[i])]
}
names(mafTemp) <- patient.id
maf_input <- mafTemp
}
## merge maf data
maf_data_list <- lapply(maf_input, getMafData)
# order samples
if (!(is.null(sampleOrder))) {
for (i in seq_len(length(sampleOrder))) {
if (names(sampleOrder)[i] %in% patient.id) {
# select related maf data
mafRelated <- maf_data_list[names(sampleOrder)[i]]
if (all(sampleOrder[[i]] %in% unique(mafRelated[[1]]$Tumor_Sample_Barcode))) {
# filter samples based on sampleOrder
mafFiltered <- mafRelated[[1]][which(mafRelated[[1]]$Tumor_Sample_Barcode %in% sampleOrder[[i]]), ]
# order samples
mafFiltered$Tumor_Sample_Barcode <- factor(mafFiltered$Tumor_Sample_Barcode, levels = sampleOrder[[i]])
mafOrdered <- mafFiltered[with(mafFiltered, order(mafFiltered$Tumor_Sample_Barcode)), ]
mafOrdered$Tumor_Sample_Barcode <- as.character(mafOrdered$Tumor_Sample_Barcode)
} else {
stop(paste0("sampleOrder should be consistent with Tumor_Sample_Barcode in Maf obejct."))
}
}
maf_data_list[names(sampleOrder)[i]][[1]] <- as.data.table(mafOrdered)
}
}
maf_data <- maf_data_list[[1]]
for (d in maf_data_list[-1]){
maf_data <- rbind(maf_data, d)
}
maf_data<- as.data.frame(maf_data)
maf_data <- do.classify(maf_data, classByTumor = classByTumor, class = class)
patient.split <- maf_data %>%
dplyr::select("Patient_ID", "Tumor_Sample_Barcode") %>%
dplyr::distinct() %>%
dplyr::select("Patient_ID") %>%
as.matrix() %>%
as.vector() %>%
as.character()
maf_data_before <- maf_data
if (!is.null(geneList)) {
maf_data <- maf_data %>%
dplyr::rowwise() %>%
dplyr::mutate(Selected_Mut = dplyr::if_else(
any(.data$Hugo_Symbol %in% geneList),
TRUE,
FALSE)) %>%
dplyr::filter(.data$Selected_Mut)
}
if(length(unique(patient.split)) == 1){
patient.split = NULL
}
# long -> wider
mat <- maf_data %>%
dplyr::ungroup() %>%
dplyr::group_by(.data$Hugo_Symbol) %>%
dplyr::mutate(
total_barcode_count = sum(.data$unique_barcode_count)
) %>%
dplyr::select("Hugo_Symbol",
"Patient_ID",
"Tumor_Sample_Barcode",
"Mutation_Type",
"total_barcode_count"
) %>%
tidyr::pivot_wider(
#names_from = Tumor_Sample_Barcode,
names_from = c("Patient_ID", "Tumor_Sample_Barcode"),
values_from = "Mutation_Type",
names_sep = ":",
values_fn = list("Mutation_Type" = multiHits)
) %>%
dplyr::ungroup() %>%
dplyr::arrange(dplyr::desc(.data$total_barcode_count))
#dplyr::select_if(function(x) {!all(is.na(x))}) %>%
## add NA columns for filtered samples, if exist
ori_sample <- unique(paste(maf_data_before[, 'Patient_ID'],
maf_data_before[, 'Tumor_Sample_Barcode'],
sep = ":"))
if(ncol(mat) - 2 != length(ori_sample)){
helper_dat <- as.data.frame(matrix(ncol = length(ori_sample),
nrow = nrow(mat)))
colnames(helper_dat) <- ori_sample
for (i in colnames(helper_dat)) {
if (i %in% colnames(mat)){
helper_dat[, i] <- mat[, i]
}
}
mat <- cbind(mat[, 1:2], helper_dat)
}
if (nrow(mat) < topGenesCount) {
message(paste0("Warning: only ", nrow(mat), ' genes was/were found in this analysis.'))
} else{
mat <- as.data.frame(mat) %>% dplyr::slice(seq_len(topGenesCount))
#tibble::column_to_rownames(., "Hugo_Symbol") %>%
matTemp <- mat[, (seq_len(ncol(mat) - 1) + 1)]
rownames(matTemp) <- mat$Hugo_Symbol
mat <- matTemp %>%
dplyr::select(-"total_barcode_count") %>% as.matrix()
}
col_labels <- dplyr::select(maf_data_before, "Patient_ID", "Tumor_Sample_Barcode")%>%
dplyr::distinct()
col_labels <- as.vector(col_labels$Tumor_Sample_Barcode)
# get the order of rows
stat <- rep(0, topGenesCount)
for(i in seq_len(nrow(mat))){
stat[i] <- sum(!is.na(mat[i, ])) / ncol(mat)
}
rowOrderFrame <- data.frame(Genes = rownames(mat), freq = stat)
rowOrder <- as.numeric(rownames(rowOrderFrame[order(rowOrderFrame$freq, decreasing = TRUE), ]))
# View(mat)
#patient_id_cols <-
#RColorBrewer::brewer.pal(length(unique(patient.split)), "Set")
#names(patient_id_cols) <- unique(patient.split)
#
#patient_barcode <- maf_data %>%
#dplyr::select(Patient_ID, Tumor_Sample_Barcode) %>%
#dplyr::distinct() %>%
#dplyr::mutate(color = patient_id_cols[patient.split])
#
#sample_barcode <- patient_barcode$color
#names(sample_barcode) <- patient_barcode$Tumor_Sample_Barcode
multi_hit_exist = FALSE
for (i in seq_len(nrow(mat))) {
for (j in seq_len(ncol(mat))) {
if (length(temp <- grep("Multi_hits", mat[i, j]))) {
multi_hit_exist = TRUE
break
}
}
}
if (!(classByTumor)) {
col_type <- function(class) {
if (class == "SP") {
cols <- c("#3C5488FF", "#00A087FF", "#F39B7fFF")
names(cols) <- c("Public","Shared", "Private")
} else if (class == "CS") {
cols <- c("#00A087FF", "#3C5488FF")
names(cols) <- c("Clonal", "Subclonal")
} else if (class == "SPCS") {
cols <-
c(
"#00A087FF",
"#3C5488FF",
"#8491B4FF",
"#F39B7FFF",
"#E64B35FF",
"#4DBBD5FF"
)
names(cols) <-
c(
"Public_Clonal",
"Public_Subclonal",
"Shared_Clonal",
"Shared_Subclonal",
"Private_Clonal",
"Private_Subclonal"
)
}
mutTypes <- as.character(stats::na.omit(unique(unlist(strsplit(mat, ";")))))
cols <- cols[which(names(cols) %in% mutTypes)]
return(cols)
}
colorSelect <- col_type(class)
alter_fun <- function(class){
if(class == "SP"){
l <- list(
#background = function(x, y, w, h)
#grid::grid.rect(x, y, w * 0.9, h * 0.9,
# gp = grid::gpar(fill = bgCol, col = NA)),
Private = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Private"], col = NA)),
Public = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Public"], col = NA)),
Shared = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Shared"], col = NA)),
Multi_hits = function(x, y, w, h)
grid::grid.points(x, y, pch = 16, size = grid::unit(0.5, "char")
))
}else if(class == "CS"){
l <- list(
#background = function(x, y, w, h)
#grid::grid.rect(x, y, w * 0.9, h * 0.9,
#gp = grid::gpar(fill = bgCol, col = NA)),
Clonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Clonal"], col = NA)),
Subclonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Subclonal"], col = NA)),
Multi_hits = function(x, y, w, h)
grid::grid.points(x, y, pch = 16, size = grid::unit(0.5, "char")
))
}else if(class == "SPCS" ){
l <- list(
#background = function(x, y, w, h)
#grid::grid.rect(x, y, w * 0.9, h * 0.9,
#gp = grid::gpar(fill = bgCol, col = NA)),
Private_Clonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Private_Clonal"], col = NA)),
Private_Subclonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Private_Subclonal"], col = NA)),
Public_Clonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Public_Clonal"], col = NA)),
Public_Subclonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Public_Subclonal"], col = NA)),
Shared_Clonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Shared_Clonal"], col = NA)),
Shared_Subclonal = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect["Shared_Subclonal"], col = NA)),
Multi_hits = function(x, y, w, h)
grid::grid.points(x, y, pch = 16, size = grid::unit(0.5, "char")
))
}
mutTypes <- as.character(stats::na.omit(unique(unlist(strsplit(mat, ";")))))
l_filter <- l[which(names(l) %in% mutTypes)]
l_final <- c(background = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = bgCol, col = NA)), l_filter)
return(l_final)
}
} else{
# set certain colors
colorScale <- c("#3C5488FF", "#00A087FF", "#F39B7fFF",
"#8491B4FF","#E64B35FF","#4DBBD5FF",
"#E41A1C", "#377EB8", "#7F0000",
"#35978f", "#FC8D62", "#2166ac",
"#E78AC3", "#A6D854", "#FFD92F",
"#E5C494", "#8DD3C7", "#6E016B" ,
"#BEBADA", "#e08214", "#80B1D3",
"#d6604d", "#ffff99", "#FCCDE5",
"#FF6A5A", "#BC80BD", "#CCEBC5" ,
"#fb9a99", "#B6646A", "#9F994E",
"#7570B3" , "#c51b7d" ,"#66A61E" ,
"#E6AB02" , "#003c30", "#666666")
mutationTypes <- stats::na.omit(unique(maf_data$Mutation_Type))
# filter mutation types
filteredTypes <- c()
for (i in seq_len(length(mutationTypes))){
if (length(grep(mutationTypes[i], mat)) != 0) {
filteredTypes <- c(filteredTypes, mutationTypes[i])
}
}
mutationTypes <- filteredTypes
# sort types in legend
if (class == "SP" | class == "SPCS") {
sortType <- function(types) {
publicType <- sort(types[grep("Public", types)])
sharedType <- sort(types[grep("Shared", types)])
privateType <- sort(types[grep("Private", types)])
return(c(publicType, sharedType, privateType))
}
mutationTypes <- sortType(mutationTypes)
} else {
mutationTypes <- sort(mutationTypes)
}
col_type <- function(class) {
# set.seed(123)
cols <- colorScale[seq_len(length(mutationTypes))]
names(cols) <- mutationTypes
return(cols)
}
# prepare functions for assignment
alter_fun_functions <- list()
colorSelect <- col_type(class)
for (type_num in seq_len(length(mutationTypes))){
alter_fun_function <- paste0("function(x, y, w, h) grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = colorSelect[\'",mutationTypes[type_num], "\'],col = NA))")
alter_fun_functions <- c(alter_fun_functions, eval(parse(text = alter_fun_function)))
}
names(alter_fun_functions) <- mutationTypes
alter_fun <- function(class){
l <- c(alter_fun_functions, Multi_hits = function(x, y, w, h)
grid::grid.points(x, y, pch = 16, size = grid::unit(0.5, "char")
), background = function(x, y, w, h)
grid::grid.rect(x, y, w * 0.9, h * 0.9,
gp = grid::gpar(fill = bgCol, col = NA)))
return(l)
}
}
# prepare legends
## type legend
heatmapLegend <- ComplexHeatmap::Legend(title = "Type",
title_gp = grid::gpar(fontsize = legend.title.size),
#title_gp = grid::gpar(fontsize = 11, fontface = "bold"),
at = names(colorSelect),
labels = gsub("_", "-", names(colorSelect)),
labels_gp = grid::gpar(fontsize = legend.text.size),
grid_width = unit(4, "mm"),
grid_height = unit(4, "mm"), legend_gp = grid::gpar(fill = colorSelect))
## patient legend
#patient.id <- unique(patient.split)
if (is.null(patient.split)) {
patient.id <- NULL
} else if (removeEmptyCols ){
excluded_sample_index <- c()
for (i in seq_len(ncol(mat))) {
if (all(is.na(mat[,i]))) {
excluded_sample_index <- c(excluded_sample_index, i)
}
}
if(!(is.null(excluded_sample_index))) {
included_patients <- colnames(mat)[-excluded_sample_index]
} else {
included_patients <- colnames(mat)
}
patientID <- c()
for (i in included_patients) {
patientID <- c(patientID, strsplit(i, ":")[[1]][1])
}
patient.id <- unique(patientID)
} else {
included_patients <- colnames(mat)
patient.id <- c()
for (i in included_patients) {
patient.id <- unique(c(patient.id, strsplit(i, ":")[[1]][1]))
}
}
## multi-hits legend
multiLegend <- ComplexHeatmap::Legend(
labels = "Multi_hits",
labels_gp = grid::gpar(fontsize = legend.text.size),
type = "points",
pch = 16,
grid_width = unit(4, "mm"),
grid_height = unit(4, "mm")
)
if (is.null(patient.id)) {
## type-multi legend
hm <- ComplexHeatmap::packLegend(heatmapLegend, multiLegend, direction = "vertical", gap = unit(0.3, "mm"))
## type-multi-patient legend
hmp <- ComplexHeatmap::packLegend(hm, direction = "vertical", gap = unit(0.3, "cm"))
## type-patient legend
hp <- ComplexHeatmap::packLegend(heatmapLegend, direction = "vertical", gap = unit(1.2, "cm"))
}else {
# set.seed(1234)
if (is.null(patientsCol)) {
qual_col_pals <- brewer.pal.info[brewer.pal.info$category == 'qual',]
col_vector <- unlist(mapply(brewer.pal, qual_col_pals$maxcolors, rownames(qual_col_pals)))
patientsCol <- col_vector[seq_len(length(patient.id))]
names(patientsCol) <- patient.id
} else {
if (length(patientsCol) == length(patient.id)) {
names(patientsCol) <- patient.id
} else {
stop("The number of provided colors does not equal to number of patients.")
}
}
patientLegend <- ComplexHeatmap::Legend(
labels = patient.id,
legend_gp = grid::gpar(fill = patientsCol),
title_gp = grid::gpar(fontsize = legend.title.size),
#title_gp = grid::gpar(fontsize = 11, fontface = "bold"),
labels_gp = grid::gpar(fontsize = legend.text.size),
grid_width = unit(4, "mm"),
grid_height = unit(4, "mm"), title = "Patient")
## type-multi legend
hm <- ComplexHeatmap::packLegend(heatmapLegend, multiLegend, direction = "vertical", gap = unit(0.3, "mm"))
## type-multi-patient legend
hmp <- ComplexHeatmap::packLegend(hm, patientLegend, direction = "vertical", gap = unit(0.3, "cm"))
## type-patient legend
hp <- ComplexHeatmap::packLegend(heatmapLegend, patientLegend, direction = "vertical", gap = unit(1.2, "cm"))
}
if (is.null(patient.split)) {
ht <- suppressMessages(
ComplexHeatmap::oncoPrint(
mat,
alter_fun = alter_fun(class),
col = colorSelect,
#column_title = "Mutational profile",
column_title_gp = grid::gpar(fontsize = 13.5, col = "black"),
#column_title_gp = grid::gpar(fontsize = 13.5, fontface = "bold", col = "black"),
row_title_gp = grid::gpar(fontsize = 11, fontface = "plain", col = "black"),
#heatmap_legend_param = heatmap_legend(class),
show_heatmap_legend = FALSE,
remove_empty_columns = removeEmptyCols,
remove_empty_rows = removeEmptyRows,
row_order = rowOrder,
row_names_gp = grid::gpar(fontsize = gene.text.size, fontface = "italic", col = "black"),
column_names_gp = grid::gpar(fontsize = sample.text.size, fontface = "plain", col = "black"),
pct_digits = 2,
pct_side = "right",
row_names_side = "left",
#column_split = factor(patient.split,levels = unique(patient.split)),
column_order = colnames(mat),
column_labels = col_labels,
show_column_names = showColnames,
bottom_annotation = if(
is.null(patient.split)) NULL else{
ComplexHeatmap::HeatmapAnnotation(
#df = data.frame(patient = colnames(mat)),
df = data.frame(Patient = patient.split),
show_annotation_name = FALSE,
col = list(Patient = patientsCol),
simple_anno_size = unit(0.2, "cm"),
show_legend = FALSE,
annotation_legend_param = list(
title_gp = grid::gpar(fontsize = legend.title.size),
labels_gp = grid::gpar(fontsize = legend.text.size),
grid_width = unit(3.5, "mm"),
grid_height = unit(3.5, "mm")
#plot = FALSE
)
)}
)
)
} else {
ht <- suppressMessages(
ComplexHeatmap::oncoPrint(
mat,
alter_fun = alter_fun(class),
col = colorSelect,
column_title = NULL,
column_title_gp = grid::gpar(fontsize = 13.5, col = "black"),
#column_title_gp = grid::gpar(fontsize = 13.5, fontface = "bold", col = "black"),
row_title_gp = grid::gpar(fontsize = 11, fontface = "plain", col = "black"),
#heatmap_legend_param = heatmap_legend(class),
show_heatmap_legend = FALSE,
remove_empty_columns = removeEmptyCols,
remove_empty_rows = removeEmptyRows,
row_order = rowOrder,
row_names_gp = grid::gpar(fontsize = gene.text.size, fontface = "italic", col = "black"),
column_names_gp = grid::gpar(fontsize = sample.text.size, fontface = "plain", col = "black"),
pct_digits = 2,
pct_side = "right",
row_names_side = "left",
column_split = factor(patient.split,levels = unique(patient.split)),
column_order = colnames(mat),
column_labels = col_labels,
show_column_names = showColnames,
bottom_annotation = if(
is.null(patient.split)) NULL else{
ComplexHeatmap::HeatmapAnnotation(
#df = data.frame(patient = colnames(mat)),
df = data.frame(Patient = patient.split),
show_annotation_name = FALSE,
col = list(Patient = patientsCol),
simple_anno_size = unit(0.2, "cm"),
show_legend = FALSE,
annotation_legend_param = list(
#title_gp = grid::gpar(fontsize = 10, fontface = "bold"),
title_gp = grid::gpar(fontsize = legend.title.size),
labels_gp = grid::gpar(fontsize = legend.text.size),
grid_width = unit(3.5, "mm"),
grid_height = unit(3.5, "mm")
#plot = FALSE
)
)}
)
)
}
if (multi_hit_exist) {
ComplexHeatmap::draw(ht, heatmap_legend_list = hmp,
padding = unit(c(3, 3, 3, 3), "mm"))
} else {
ComplexHeatmap::draw(ht, heatmap_legend_list = hp,
padding = unit(c(3, 3, 3, 3), "mm"))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.