diff --git a/R/callHSCN.R b/R/callHSCN.R index 4b97ac2..0555f37 100644 --- a/R/callHSCN.R +++ b/R/callHSCN.R @@ -623,7 +623,7 @@ callHaplotypeSpecificCN <- function(CNbins, phased_haplotypes = NULL, clustering_method = "copy", maxloherror = 0.035, - mincells = 5, + mincells = 10, overwritemincells = NULL, cluster_per_chr = TRUE, viterbiver = "cpp", diff --git a/R/heatmap_plot.R b/R/heatmap_plot.R index 2dba0e2..7abbe6c 100644 --- a/R/heatmap_plot.R +++ b/R/heatmap_plot.R @@ -308,9 +308,29 @@ get_clone_label_pos <- function(clones) { return(clone_label_pos) } -get_library_labels <- function(cell_ids, idx = 1) { - labels <- sapply(strsplit(cell_ids, "-"), function(x) { - return(x[idx]) +get_label <- function(cell_id, idx, str_to_remove){ + totndash <- stringr::str_count(cell_id, "-") + ndash <- totndash - 2 + #remove last 2 dashes (-R*-C*) + lab <- sub(paste0("^(([^-]*-){", ndash, "}[^-]*).*"), "\\1", cell_id) + if (idx == 2){ + #get the library id + lab <- strsplit(lab, "-")[[1]][ndash + 1] + } else if (idx == 1){ + #get the sample id (complicated because some sample IDs have -'s) + lab <- sub(paste0("^(([^-]*-){", ndash - 1, "}[^-]*).*"), "\\1", lab) + } + + if (!is.null(str_to_remove)){ + lab <- stringr::str_remove(lab, str_to_remove) + } + + return(lab) +} + +get_library_labels <- function(cell_ids, idx = 1, str_to_remove = NULL) { + labels <- sapply(cell_ids, function(x) { + return(get_label(x, idx, str_to_remove)) }) return(labels) } @@ -322,14 +342,15 @@ make_left_annot <- function(copynumber, show_clone_label = TRUE, clone_pal = NULL, idx = 1, - show_legend = TRUE) { + show_legend = TRUE, + str_to_remove = NULL) { annot_colours <- list() if (show_clone_label == FALSE & show_library_label == FALSE) { return(NULL) } - library_labels <- get_library_labels(rownames(copynumber), idx = idx) + library_labels <- get_library_labels(rownames(copynumber), idx = idx, str_to_remove = str_to_remove) if (!is.null(library_mapping)) { library_labels <- unlist(library_mapping[library_labels]) if (!all(library_labels %in% names(library_mapping)) == FALSE) { @@ -773,6 +794,7 @@ make_copynumber_heatmap <- function(copynumber, annofontsize = 14, na_col = "white", linkheight = 5, + str_to_remove = NULL, ...) { if (class(colvals) == "function"){ @@ -796,7 +818,8 @@ make_copynumber_heatmap <- function(copynumber, bottom_annotation = make_bottom_annot(copynumber, chrlabels = chrlabels, nticks = nticks, annotation_height = annotation_height, annofontsize = annofontsize, linkheight = linkheight), left_annotation = make_left_annot(copynumber, clones, library_mapping = library_mapping, clone_pal = clone_pal, show_clone_label = show_clone_label, - idx = sample_label_idx, show_legend = show_legend, show_library_label = show_library_label + idx = sample_label_idx, show_legend = show_legend, show_library_label = show_library_label, + str_to_remove = str_to_remove ), heatmap_legend_param = leg_params, top_annotation = make_top_annotation_gain(copynumber, @@ -854,6 +877,7 @@ getSVlegend <- function(include = NULL) { #' @param na_col colour of NA values #' @param linkheight height of x-axis ticks #' @param newlegendname overwrite default legend name +#' @param str_to_remove string to remove from cell_id's when plotting labels #' #' If clusters are set to NULL then the function will compute clusters using UMAP and HDBSCAN. #' @@ -899,6 +923,7 @@ plotHeatmap <- function(cn, na_col = "white", linkheight = 5, newlegendname = NULL, + str_to_remove = NULL, ...) { if (is.hscn(cn) | is.ascn(cn)) { CNbins <- cn$data @@ -1110,6 +1135,7 @@ plotHeatmap <- function(cn, annofontsize = annofontsize, na_col = na_col, linkheight = linkheight, + str_to_remove = str_to_remove, ... ) if (plottree == TRUE) { @@ -1163,7 +1189,8 @@ plotSNVHeatmap <- function(SNVs, mymaxcol = "firebrick4", sample_label_idx = 1, nsample = 10000, - clustercols = FALSE) { + clustercols = FALSE, + str_to_remove = NULL) { muts <- createSNVmatrix(SNVs) if (is.null(clusters)) { @@ -1202,7 +1229,8 @@ plotSNVHeatmap <- function(SNVs, # bottom_annotation=make_bottom_annot(copynumber), left_annotation = make_left_annot(muts, clones_formatted, library_mapping = library_mapping, clone_pal = clone_pal, show_clone_label = show_clone_label, - idx = sample_label_idx, show_legend = show_legend, show_library_label = show_library_label + idx = sample_label_idx, show_legend = show_legend, show_library_label = show_library_label, + str_to_remove = strstr_to_remove ), use_raster = TRUE, # top_annotation = HeatmapAnnotation(df = mutgroups,col = list(MutationGroup = colpal)), diff --git a/man/callHaplotypeSpecificCN.Rd b/man/callHaplotypeSpecificCN.Rd index 4028bf1..67fe1af 100644 --- a/man/callHaplotypeSpecificCN.Rd +++ b/man/callHaplotypeSpecificCN.Rd @@ -21,7 +21,7 @@ callHaplotypeSpecificCN( phased_haplotypes = NULL, clustering_method = "copy", maxloherror = 0.035, - mincells = 5, + mincells = 10, overwritemincells = NULL, cluster_per_chr = TRUE, viterbiver = "cpp", diff --git a/man/plotHeatmap.Rd b/man/plotHeatmap.Rd index 8c58588..6f3eb7c 100644 --- a/man/plotHeatmap.Rd +++ b/man/plotHeatmap.Rd @@ -38,6 +38,7 @@ plotHeatmap( na_col = "white", linkheight = 5, newlegendname = NULL, + str_to_remove = NULL, ... ) } @@ -96,7 +97,9 @@ plotHeatmap( \item{linkheight}{height of x-axis ticks} -\item{newlegendname}{overwrite default legend name +\item{newlegendname}{overwrite default legend name} + +\item{str_to_remove}{string to remove from cell_id's when plotting labels If clusters are set to NULL then the function will compute clusters using UMAP and HDBSCAN.