diff --git a/R/pretty_CN_heatmap.R b/R/pretty_CN_heatmap.R index 0c0c577..6046f8a 100644 --- a/R/pretty_CN_heatmap.R +++ b/R/pretty_CN_heatmap.R @@ -7,7 +7,7 @@ #' @param these_samples_metadata The output of get_gambl_metadata #' @param metadataColumns One or more columns from the metadata you want to display beside the heatmap #' @param expressionColumns Optional: One or more columns from the metadata that include gene expression values you want shown -#' @param geneBoxPlot Optional: Specify the Hugo symbol of a single gene to embed box plots adjacent to the heatmap. Expression data for this gene must be present in the metadata in a column of the same name. +#' @param geneBoxPlot Optional: Specify the Hugo symbol of a single gene to embed box plots adjacent to the heatmap. Expression data for this gene must be present in the metadata in a column of the same name. #' @param show_column_names Set to TRUE to display the sample_id of every sample shown in the heatmap #' @param show_row_names Set to TRUE to display the ID of every bin (region) shown in the heatmap #' @param keep_these_chromosomes A vector of chromosome names to include (all others will be excluded) @@ -27,7 +27,7 @@ #' @param drop_if_PGA_above Upper limit for proportion of genome altered (PGA). Samples above this value will be dropped (default 1) #' @param show_bottom_annotation_name set to TRUE to label the bottom annotation tracks with more details #' @param bottom_annotation_name_side If using show_bottom_annotation_name, set this to "left" or "right" to relocate the names -#' @param bin_labels Instead of automatically labeling genes, you can instead explicitly provide a list of labels for any bins in the heatmap. The names of each element should match a bin. The value of each element is the label that will be shown. This option can be used to skip gene location look-ups (see examples). +#' @param bin_labels Instead of automatically labeling genes, you can instead explicitly provide a list of labels for any bins in the heatmap. The names of each element should match a bin. The value of each element is the label that will be shown. This option can be used to skip gene location look-ups (see examples). #' @param legend_direction Which orientation to use for the legend #' @param legend_position Where to put the legend #' @param legend_row How many rows for the legend layout @@ -41,13 +41,13 @@ #' @export #' #' @examples -#' -#' +#' +#' #' #get some metadata for subsetting the data to just one pathology (DLBCL) -#' dlbcl_genome_meta = get_gambl_metadata() %>% +#' dlbcl_genome_meta = get_gambl_metadata() %>% #' filter(pathology=="DLBCL", #' seq_type=="genome") -#' +#' #' # Create the copy number matrix using the helper functions #' all_segments = get_cn_segments() #' all_states_binned = get_cn_states(n_bins_split=2500, @@ -60,8 +60,8 @@ #' pretty_CN_heatmap(cn_state_matrix=all_states_binned, #' these_samples_metadata = dlbcl_genome_meta, #' hide_annotations = "chromosome") -#' -#' # Disable row (sample) clustering and restrict to a few chromosomes +#' +#' # Disable row (sample) clustering and restrict to a few chromosomes #' # and highlight some genes of interest #' pretty_CN_heatmap(cn_state_matrix=all_states_binned, #' these_samples_metadata = dlbcl_genome_meta, @@ -69,21 +69,21 @@ #' keep_these_chromosomes = c("chr9","chr17"), #' cluster_rows=F, #' labelTheseGenes = c("CDKN2A","TP53")) -#' -#' +#' +#' #' # get gene expression data #' gene_exp_all = get_gene_expression(all_genes=T,lazy_join=T,arbitrarily_pick = T,HGNC=T,format="wide") -#' -#' genome_meta_exp = left_join(get_gambl_metadata() %>% -#' filter(seq_type=="genome") %>% +#' +#' genome_meta_exp = left_join(get_gambl_metadata() %>% +#' filter(seq_type=="genome") %>% #' select(sample_id,pathology,lymphgen), #' select(gene_exp_all,-sample_id), -#' by=c("sample_id"="genome_sample_id")) %>% +#' by=c("sample_id"="genome_sample_id")) %>% #' filter(!is.na(MYC)) -#' +#' #' # Include gene expression data and embed a box plot showing the expression of one gene across different CN states -#' -#' +#' +#' #' pretty_CN_heatmap(cn_state_matrix=all_states_binned, #' these_samples_metadata = filter(genome_meta_exp,pathology=="DLBCL"), #' hide_annotations = "chromosomes", @@ -91,8 +91,8 @@ #' geneBoxPlot = "TP53", #' boxplot_orientation="horizontal",bin_label_fontsize = 9,bin_label_nudge = 19 #' ) -#' -#' +#' +#' pretty_CN_heatmap = function(cn_state_matrix, scale_by_sample=FALSE, these_samples_metadata, @@ -143,14 +143,14 @@ pretty_CN_heatmap = function(cn_state_matrix, } map_bin_to_bin = function(query_region,regions=colnames(cn_state_matrix),first=TRUE){ - these_coords = suppressMessages(region_to_chunks(query_region)) + these_coords = suppressMessages(GAMBLR.data::region_to_chunks(query_region)) these_coords$chromosome = str_remove(these_coords$chromosome,"chr") all_matches = c() for(r in regions){ - region_coords = region_to_chunks(r) + region_coords = GAMBLR.data::region_to_chunks(r) region_coords$chromosome = str_remove(region_coords$chromosome,"chr") if(these_coords$chromosome == region_coords$chromosome){ - if(((as.integer(these_coords$start) > as.integer(region_coords$start)) & + if(((as.integer(these_coords$start) > as.integer(region_coords$start)) & (as.integer(these_coords$start) < as.integer(region_coords$end))) || (as.integer(these_coords$start) < as.integer(region_coords$start) & as.integer(these_coords$end) > as.integer(region_coords$end))){ @@ -164,11 +164,11 @@ pretty_CN_heatmap = function(cn_state_matrix, } } if(first){ - return(NA) + return(NA) }else{ return(all_matches) } - + } bin_labels = list() if(!missing(geneBoxPlot)){ @@ -176,10 +176,10 @@ pretty_CN_heatmap = function(cn_state_matrix, labelTheseGenes = geneBoxPlot expressionColumns = geneBoxPlot message(paste("setting expressionColumns and labelTheseGenes to",geneBoxPlot)) - + } } - + if(!missing(labelTheseGenes)){ message("mapping genes to bins") for(g in labelTheseGenes){ @@ -207,7 +207,7 @@ pretty_CN_heatmap = function(cn_state_matrix, if(!missing(geneBoxPlot)){ gene_region = suppressMessages(gene_to_region(g)) this_gene_region = map_bin_to_bin(gene_region) - + #print(paste(g,gene_region)) if(is.na(this_gene_region)){ message(paste("no region for",g)) @@ -224,17 +224,17 @@ pretty_CN_heatmap = function(cn_state_matrix, } } } - - + + if(!missing(these_samples_metadata)){ keep_samples = pull(these_samples_metadata,sample_id) all_samples = rownames(cn_state_matrix) cn_state_matrix = cn_state_matrix[all_samples[all_samples %in% keep_samples],] } - - colours = map_metadata_to_colours(metadataColumns = metadataColumns, + + colours = map_metadata_to_colours(metadataColumns = metadataColumns, these_samples_metadata = these_samples_metadata, verbose=verbose) if(!missing(expressionColumns)){ @@ -273,16 +273,16 @@ pretty_CN_heatmap = function(cn_state_matrix, "chr21"="#E6C66F", "chr22"="#5B665D", "chrX"="#CA992C") - + #assume format is chrX:XXX-XXX column_chromosome = str_remove(colnames(cn_state_matrix),":.+") - + if(!missing(hide_these_chromosomes)){ keep_cols = which(!column_chromosome %in% hide_these_chromosomes) cn_state_matrix = cn_state_matrix[,keep_cols] column_chromosome = column_chromosome[keep_cols] - + } splits = NULL if(!missing(sortByBins)){ @@ -294,9 +294,9 @@ pretty_CN_heatmap = function(cn_state_matrix, cn_state_matrix = cn_state_matrix[new_order,] } - - - + + + gain_state = cn_state_matrix gain_state[gain_state<=2]=0 gain_state[gain_state>0]=1 @@ -308,7 +308,7 @@ pretty_CN_heatmap = function(cn_state_matrix, if(!missing(expressionColumns)){ metadataColumns = c(metadataColumns,expressionColumns) } - row_df = select(these_samples_metadata,sample_id,all_of(unique(c(metadataColumns)))) %>% + row_df = select(these_samples_metadata,sample_id,all_of(unique(c(metadataColumns)))) %>% column_to_rownames("sample_id") either_state = loss_state either_state[gain_state==1]=1 @@ -318,7 +318,7 @@ pretty_CN_heatmap = function(cn_state_matrix, cn_state_matrix = cn_state_matrix[samples_keep_PGA,] sample_average = sample_average[samples_keep_PGA] - + #REDO gain_state = cn_state_matrix gain_state[gain_state<=2]=0 @@ -329,7 +329,7 @@ pretty_CN_heatmap = function(cn_state_matrix, loss_state[loss_state!=0]=1 total_loss = colSums(loss_state) #sample_CN_anno = HeatmapAnnotation(PGA=sample_average,which="row") - + if(!missing(keep_these_chromosomes)){ keep_cols = which(column_chromosome %in% keep_these_chromosomes) @@ -338,7 +338,7 @@ pretty_CN_heatmap = function(cn_state_matrix, total_gain = total_gain[keep_cols] total_loss = total_loss[keep_cols] } - + #erase (set to diploid) any value opposing the most common event in that bin if(flip){ flipped_data = cn_state_matrix @@ -352,11 +352,11 @@ pretty_CN_heatmap = function(cn_state_matrix, } } - + cn_state_matrix = flipped_data } - - + + if(!missing(keep_these_bins)){ available_bins = keep_these_bins[which(keep_these_bins %in% colnames(cn_state_matrix))] @@ -366,23 +366,23 @@ pretty_CN_heatmap = function(cn_state_matrix, total_gain = total_gain[available_bins] total_loss = total_loss[available_bins] } - - - + + + anno_rows = row_df[rownames(cn_state_matrix),,drop=FALSE] - + anno_rows$PGA = sample_average - + if(sortByPGA){ anno_rows = arrange(anno_rows,PGA) cn_state_matrix = cn_state_matrix[rownames(anno_rows),] } - + if(!missing(splitByBinState)){ splits = round(cn_state_matrix[,splitByBinState]) anno_rows$CN_state = splits - + if(!missing(geneBoxPlot)){ rg = c(0,1) panel_fun = function(index, nm) { @@ -390,38 +390,38 @@ pretty_CN_heatmap = function(cn_state_matrix, pushViewport(viewport(yscale = rg, xscale = c(0, 2))) grid.rect() grid.yaxis(gp = gpar(fontsize = 5)) - grid.boxplot(anno_rows[index,geneBoxPlot], + grid.boxplot(anno_rows[index,geneBoxPlot], gp = gpar(fill = colours[["CN"]][as.character(splits[index][1])]), - pos = 1, + pos = 1, direction = "vertical" ,outline = T) }else{ pushViewport(viewport(xscale = rg, yscale = c(0, 2))) grid.rect() grid.xaxis(gp = gpar(fontsize = 5)) - grid.boxplot(anno_rows[index,geneBoxPlot], + grid.boxplot(anno_rows[index,geneBoxPlot], gp = gpar(fill = colours[["CN"]][as.character(splits[index][1])]), - pos = 1, + pos = 1, direction = "horizontal" ,outline = T) } - + popViewport() } - anno = anno_link(align_to = splits, - which = "row", - panel_fun = panel_fun, - size = unit(2, "cm"), - gap = unit(1, "cm"), + anno = anno_link(align_to = splits, + which = "row", + panel_fun = panel_fun, + size = unit(2, "cm"), + gap = unit(1, "cm"), width = unit(3, "cm")) } - coldf = get_gambl_colours("copy_number",as_dataframe = T) %>% + coldf = get_gambl_colours("copy_number",as_dataframe = T) %>% filter(name %in% splits) colvec = pull(coldf,colour) names(colvec)=pull(coldf,name) colours[["CN"]] = colvec colours[["CN_state"]] = colvec - + if(!missing(hide_annotations)){ show_legend = rep(TRUE, length(colnames(anno_rows))) @@ -442,9 +442,9 @@ pretty_CN_heatmap = function(cn_state_matrix, nrow=legend_row, ncol = legend_col, direction=legend_direction)) - + }else{ - + if(!missing(hide_annotations)){ show_legend = rep(TRUE, length(colnames(anno_rows))) names(show_legend) = colnames(anno_rows) @@ -465,7 +465,7 @@ pretty_CN_heatmap = function(cn_state_matrix, ncol = legend_col, direction=legend_direction)) } - + if(!missing(hide_annotations)){ if("chromosome" %in% hide_annotations){ show_legend = FALSE @@ -481,7 +481,7 @@ pretty_CN_heatmap = function(cn_state_matrix, local.minima=ifelse(lag(x,n=15)>x & lead(x,n=15) > x & x < 2,TRUE,FALSE), local.maxima=ifelse(lag(x,n=15) 2,TRUE,FALSE), extreme=ifelse(local.maxima | local.minima,TRUE,FALSE)) - + average_anno = HeatmapAnnotation(Mean_CN = bin_average, which = "column", show_annotation_name = show_bottom_annotation_name, @@ -489,9 +489,9 @@ pretty_CN_heatmap = function(cn_state_matrix, show_legend=show_legend, col=list(Mean_CN=col_fun)) cumulative_anno = HeatmapAnnotation(chromosome=column_chromosome, - - - + + + Gain = anno_barplot(total_gain, gp=gpar(fill="red",col="red")), loss=anno_barplot(total_loss, @@ -509,7 +509,7 @@ pretty_CN_heatmap = function(cn_state_matrix, show_legend=show_legend, col=list(chromosome=chrom_col)) heatmap_legend_param = list(title = "Copy Number", - + by_row=F, legend_direction = legend_direction) #bottom_anno = HeatmapAnnotation() @@ -548,13 +548,13 @@ pretty_CN_heatmap = function(cn_state_matrix, heatmap_legend_param = heatmap_legend_param ) } - + draw(ho,heatmap_legend_side=legend_position,annotation_legend_side=legend_position) if(!missing(labelTheseGenes)){ for(i in c(1:length(bin_labels))){ gene_region = names(bin_labels)[i] gene_name = unname(bin_labels[[i]]) - gene_region_chunks = region_to_chunks(gene_region) + gene_region_chunks = GAMBLR.data::region_to_chunks(gene_region) if(gene_region_chunks$chromosome %in% column_chromosome){ decorate_heatmap_body("CN", {i=which(colnames(cn_state_matrix)==gene_region) @@ -565,7 +565,7 @@ pretty_CN_heatmap = function(cn_state_matrix, } #decorate_column_title("CN",{grid.rect(gp = gpar(fill = "#00FF0040"))}) } - + } if(return_data){ @@ -579,6 +579,6 @@ pretty_CN_heatmap = function(cn_state_matrix, local_optima=cn_av_df, row_anno = anno_rows)) } - + } diff --git a/R/pretty_circular_mutation_frequency_heatmap.R b/R/pretty_circular_mutation_frequency_heatmap.R index f221f75..2905338 100644 --- a/R/pretty_circular_mutation_frequency_heatmap.R +++ b/R/pretty_circular_mutation_frequency_heatmap.R @@ -1,39 +1,39 @@ #' pretty_circular_mutation_frequency_heatmap #' -#' @param prettyOncoplot_output -#' @param genes -#' @param keep_these_pathologies -#' @param min_sample_num +#' @param prettyOncoplot_output +#' @param genes +#' @param keep_these_pathologies +#' @param min_sample_num #' #' @return #' @export #' #' @examples -#' -#' all_gambl_meta = get_gambl_metadata() %>% +#' +#' all_gambl_meta = get_gambl_metadata() %>% #' filter(!seq_type == "mrna") %>% #' filter(pathology %in% names(get_gambl_colours("pathology"))) -#' +#' #' all_coding = get_all_coding_ssm(these_samples_metadata = all_gambl_meta) -#' -#' genes = filter(GAMBLR.data::lymphoma_genes_dlbcl_v_latest,curated==TRUE) %>% +#' +#' genes = filter(GAMBLR.data::lymphoma_genes_dlbcl_v_latest,curated==TRUE) %>% #' pull(Gene) #' genes = unique(c(genes,filter(GAMBLR.data::lymphoma_genes_mcl_v_latest,,curated==TRUE) %>% pull(Gene))) -#' genes = unique(c(genes,filter(GAMBLR.data::lymphoma_genes_bl_v_latest,,curated==TRUE) %>% pull(Gene))) +#' genes = unique(c(genes,filter(GAMBLR.data::lymphoma_genes_bl_v_latest,,curated==TRUE) %>% pull(Gene))) #' oncoplot_output = prettyOncoplot(all_coding, #' genes=genes, #' minMutationPercent = 2, #' these_samples_metadata = all_gambl_meta, #' simplify = T,return_inputs = T) -#' +#' #' pretty_circular_mutation_frequency_heatmap(prettyOncoplot_output = oncoplot_output, #' keep_these_pathologies = c("FL", #' "DLBCL", #' "PMBCL", #' "BL", #' "HGBL")) -#' -#' genes_and_cn_threshs = +#' +#' genes_and_cn_threshs = #' data.frame(gene_id=c("MYC", #' "MIR17HG", "TNFAIP3","TCF4", #' "TNFRSF14","REL","CD274", @@ -43,51 +43,51 @@ #' "ETV6","TMEM30A"), #' cn_thresh=c(3,3,1,3,1,3,3,1,1,1,1,1,1,1,1,1,1,1,3,1,1)) %>% #' mutate(name=ifelse(cn_thresh>2,paste0(gene_id,"_gain"),paste0(gene_id,"_loss"))) -#' +#' #' seg_data = get_cn_segments() -#' +#' #' cn_status = get_cnv_and_ssm_status(only_cnv="all", #' these_samples_metadata = all_gambl_meta, #' genes_and_cn_threshs = genes_and_cn_threshs, #' adjust_for_ploidy=T) -#' -#' +#' +#' #' pretty_circular_mutation_frequency_heatmap(cn_status_matrix = cn_status, #' prettyOncoplot_output = oncoplot_output) -#' -#' sv_collated = GAMBLR.results:::collate_sv_results() %>% +#' +#' sv_collated = GAMBLR.results:::collate_sv_results() %>% #' select(sample_id,ends_with("sv")) -#' -#' NFKBIZ_genome = GAMBLR.results:::collate_nfkbiz_results() %>% +#' +#' NFKBIZ_genome = GAMBLR.results:::collate_nfkbiz_results() %>% #' select(sample_id,NFKBIZ_UTR) -#' NFKBIZ_capture = GAMBLR.results:::collate_nfkbiz_results(seq_type_filter="capture") %>% +#' NFKBIZ_capture = GAMBLR.results:::collate_nfkbiz_results(seq_type_filter="capture") %>% #' select(sample_id,NFKBIZ_UTR) -#' -#' HNRNPH1_genome = GAMBLR.results:::collate_hnrnph1_mutations() %>% +#' +#' HNRNPH1_genome = GAMBLR.results:::collate_hnrnph1_mutations() %>% #' select(sample_id,HNRNPH1_splice) -#' HNRNPH1_capture = GAMBLR.results:::collate_hnrnph1_mutations(seq_type_filter="capture") %>% +#' HNRNPH1_capture = GAMBLR.results:::collate_hnrnph1_mutations(seq_type_filter="capture") %>% #' select(sample_id,HNRNPH1_splice) -#' +#' #' NFKBIZ = bind_rows(NFKBIZ_genome,NFKBIZ_capture) #' HNRNPH1 = bind_rows(HNRNPH1_genome,HNRNPH1_capture) -#' +#' #' pretty_circular_mutation_frequency_heatmap(cn_status_matrix = cn_status, #' collated_results = list(sv_collated, #' NFKBIZ, #' HNRNPH1), #' prettyOncoplot_output = oncoplot_output, #' these_samples_metadata = all_gambl_meta) -#' -#' +#' +#' #' all_states_binned = get_cn_states(n_bins_split=2500, #' missing_data_as_diploid = T, -#' seg_data = seg_data) -#' +#' seg_data = seg_data) +#' #' CN_out = pretty_CN_heatmap(cn_state_matrix=all_states_binned, #' these_samples_metadata = all_gambl_meta, #' hide_annotations = "chromosome", #' scale_by_sample=T, -#' return_data = T) +#' return_data = T) #' #' arm_level_events = categorize_CN_events(CN_out) #' @@ -101,19 +101,19 @@ #' arm_level_annotated), #' prettyOncoplot_output = oncoplot_output, #' these_samples_metadata = all_gambl_meta) -#' -#' +#' +#' #' ashm_freq = get_ashm_count_matrix( #' regions_bed = dplyr::mutate(GAMBLR.data::grch37_ashm_regions, #' name = paste(gene, region, sep = "_")), #' this_seq_type = "genome" #' ) -#' ashm_freq_collated = mutate(ashm_freq,across(,~ifelse(.x>0,1,0))) -#' +#' ashm_freq_collated = mutate(ashm_freq,across(,~ifelse(.x>0,1,0))) +#' #' ashm_freq_collated = ashm_freq_collated[,colSums(ashm_freq_collated) >130] #' ashm_freq_collated = rownames_to_column(ashm_freq_collated,"sample_id") -#' -#' +#' +#' pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, cn_status_matrix, collated_results, @@ -156,7 +156,7 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, "#E8DACD80", "#E1816588", "#f0817f", - + "#B0174A99", "#91282699", "#790821", @@ -167,7 +167,7 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, label_alpha=1 } #if(!missing(prettyOncoplot_output) & !missing(cn_status_matrix)){ - # + # # cn_status_rn = rownames_to_column(cn_status_matrix,"sample_id") # mut_status_rn = left_join(mut_status_rn,cn_status_rn,by="sample_id") # mut_status_rn[is.na(mut_status_rn)]=0 @@ -175,30 +175,30 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, if(missing(these_samples_metadata)){ if(!missing(prettyOncoplot_output)){ message("defaulting to metadata in prettyOncoplot output") - these_samples_metadata = rownames_to_column(oncoplot_output$metadata,"sample_id") - mut_status = rownames_to_column(oncoplot_output$mut_status,"sample_id") + these_samples_metadata = rownames_to_column(prettyOncoplot_output$metadata,"sample_id") + mut_status = rownames_to_column(prettyOncoplot_output$mut_status,"sample_id") mut_status_meta = left_join(select(these_samples_metadata,sample_id,pathology), mut_status) }else{ message("getting metadata for samples in the matrix provided. For more control over this, supply these_samples_metadata") - these_samples_metadata = get_gambl_metadata() %>% + these_samples_metadata = get_gambl_metadata() %>% filter(sample_id %in% mut_status_rn$sample_id) mut_status_meta = select(these_samples_metadata,sample_id,pathology) } }else{ mut_status_meta = select(these_samples_metadata,sample_id,pathology) if(!missing(prettyOncoplot_output)){ - mut_status = rownames_to_column(oncoplot_output$mut_status,"sample_id") + mut_status = rownames_to_column(prettyOncoplot_output$mut_status,"sample_id") mut_status_meta = left_join(select(these_samples_metadata,sample_id,pathology), mut_status) } } if(ncol(mut_status_meta)>2){ splits = rep("Mutation",ncol(mut_status_meta)-2) - + } - + if(!missing(collated_results)){ #the main (possibly only) source of data to include in the plot fix_pos_neg = function(x){ @@ -211,15 +211,15 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, result_df = collated_results[[i]] result_name = names(collated_results)[i] num_col = ncol(result_df)-1 - + splits = c(splits,rep(result_name,num_col)) result_df = mutate(result_df,across(-sample_id,~fix_pos_neg(.x))) mut_status_meta = left_join(mut_status_meta,result_df) } #mut_status_rn = column_to_rownames(mut_status,"sample_id") - - - + + + } genes = colnames(mut_status_meta)[c(3:ncol(mut_status_meta))] @@ -232,14 +232,14 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, } return(percent) } - mut_sums = group_by(mut_status_meta,pathology) %>% + mut_sums = group_by(mut_status_meta,pathology) %>% mutate(total=n()) %>% group_by(total,add=T) %>% - summarise(across(all_of(genes),~calc_percent(.x))) %>% + summarise(across(all_of(genes),~calc_percent(.x))) %>% as.data.frame() - - - + + + if(!missing(keep_these_pathologies)){ mut_sums = filter(mut_sums,pathology %in% keep_these_pathologies) %>% select(-total) @@ -248,20 +248,20 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, mut_sums = filter(mut_sums,total >= min_sample_num) %>% select(-total) } - circos_mat = t(column_to_rownames(mut_sums,"pathology")) + circos_mat = t(column_to_rownames(mut_sums,"pathology")) #make rows genes, columns pathologies circos_mat = circos_mat[,keep_these_pathologies] - - - + + + cn = rev(colnames(circos_mat)) n = length(cn) - + cn_col = get_gambl_colours("pathology",alpha = label_alpha) cn_col = cn_col[rev(colnames(circos_mat))] - - - + + + if(colour_labels){ ncat = length(unique(splits)) label_pal = brewer.pal(ncat,"Dark2") @@ -270,7 +270,7 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, }else{ rownames.col = "black" } - + if(border){ cell.border=0.2 }else{ @@ -291,36 +291,36 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, rownames.cex = rownames_cex, rownames.side = "inside", track.height=0.4,distance.method = clustering_distance_method) - - - circos.track(track.index = get.current.track.index(), + + + circos.track(track.index = get.current.track.index(), panel.fun = function(x, y) { if(CELL_META$sector.numeric.index == 1) { # the last sector cn = rev(colnames(circos_mat)) n = length(cn) - - circos.text(rep(CELL_META$cell.xlim[2], n) + - convert_x(1, "mm"), - 1:n/3 + 1, - cn, - cex = 0.5, + + circos.text(rep(CELL_META$cell.xlim[2], n) + + convert_x(1, "mm"), + 1:n/3 + 1, + cn, + cex = 0.5, adj = c(0, 1), facing = "inside") } }, bg.border = NA) - - + + }else{ circos.clear() - + circos.par(start.degree=75+ rotate_degrees) - - + + circos.par(gap.degree = gap.degree) if(!split_by_type){ splits= NULL } - - + + circos.heatmap(circos_mat, col = col_fun, cluster = cluster, @@ -332,74 +332,74 @@ pretty_circular_mutation_frequency_heatmap = function(prettyOncoplot_output, track.height=0.4, cell.border=cell.border, show.sector.labels=show.sector.labels) - - - circos.track(track.index = 2, + + + circos.track(track.index = 2, panel.fun = function(x, y) { #if(CELL_META$sector.numeric.index == 1) { # the last sector - + if(label_group == "colour"){ - circos.rect(rep(CELL_META$cell.xlim[2], n) + + circos.rect(rep(CELL_META$cell.xlim[2], n) + convert_x(1, "mm")+6.5, 1:n-1, - rep(CELL_META$cell.xlim[2], n) + - convert_x(1, "mm")-0.5, + rep(CELL_META$cell.xlim[2], n) + + convert_x(1, "mm")-0.5, 1:n,col=cn_col,border=FALSE) - + }else if(label_group == "text"){ - circos.text(rep(CELL_META$cell.xlim[2], n) + - convert_x(1, "mm"), - 1:n-0.25, - cn, - cex = label_cex, + circos.text(rep(CELL_META$cell.xlim[2], n) + + convert_x(1, "mm"), + 1:n-0.25, + cn, + cex = label_cex, adj = c(0, 1), facing = "inside",niceFacing=T) } - + #} }, bg.border = NA) - - + + } if(include_legend){ - lgd = Legend(at = c(0,2.5,5,10,20,30,40,50,80), - col_fun = col_fun, + lgd = Legend(at = c(0,2.5,5,10,20,30,40,50,80), + col_fun = col_fun, title_position = "topcenter", title = "Frequency") - + if(colour_labels){ - - lgd2 = Legend(at = names(label_pal), - legend_gp = gpar(col = label_pal), + + lgd2 = Legend(at = names(label_pal), + legend_gp = gpar(col = label_pal), labels_gp = gpar(col = label_pal), - title_position = "topcenter", + title_position = "topcenter", title = "Type") if(label_group=="colour"){ lgd3 = Legend(at = names(cn_col), type="points", - legend_gp = gpar(col = cn_col), + legend_gp = gpar(col = cn_col), #labels_gp = gpar(col = cn_col), - title_position = "topcenter", + title_position = "topcenter", background="white", title = "Group") lgd_list = packLegend(lgd,lgd2,lgd3,direction = "horizontal") }else{ lgd_list = packLegend(lgd,lgd2,direction = "horizontal") } - + }else{ if(label_group=="colour"){ lgd3 = Legend(at = names(cn_col), type="points", - legend_gp = gpar(col = cn_col), + legend_gp = gpar(col = cn_col), #labels_gp = gpar(col = cn_col), - title_position = "topcenter", + title_position = "topcenter", background="white", title = "Group") lgd_list = packLegend(lgd,lgd3,direction = "horizontal") }else{ lgd_list = packLegend(lgd) } - + } draw(lgd_list, x = unit(12, "mm"), y = unit(12, "mm"), just = c("left", "bottom")) }