From dca00c18e1b4edefcc882f5441da6dbb8aa34aab Mon Sep 17 00:00:00 2001 From: marcjwilliams1 Date: Tue, 7 May 2024 11:34:38 -0400 Subject: [PATCH] New SV plot function --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/heatmap_plot.R | 49 +++++++++++++++++++---------- R/plotting.R | 47 +++++++++++++++++++++++++++ man/callAlleleSpecificCN.Rd | 2 +- man/callAlleleSpecificCNfromHSCN.Rd | 2 +- man/callHaplotypeSpecificCN.Rd | 2 +- man/getBins.Rd | 2 +- man/plotCNprofile.Rd | 2 -- man/plotCNprofileBAF.Rd | 6 ++++ man/plotHeatmap.Rd | 12 +++++-- 11 files changed, 100 insertions(+), 27 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index bfeb39f0..500a60d6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,7 @@ Imports: grid, ggforce, ggtree -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: knitr, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 335f446a..d32eee9f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,7 @@ export(plotHeatmapBAF) export(plotSNVHeatmap) export(plotSV) export(plotSV2) +export(plotSVlines) export(plot_clusters_used_for_phasing) export(plot_proportions) export(plot_umap) diff --git a/R/heatmap_plot.R b/R/heatmap_plot.R index 4702e875..06ef0e37 100644 --- a/R/heatmap_plot.R +++ b/R/heatmap_plot.R @@ -326,7 +326,7 @@ format_clones <- function(clones, ordered_cell_ids) { return(clonesdf) } -make_corrupt_tree_heatmap <- function(tree_ggplot, ...) { +make_corrupt_tree_heatmap <- function(tree_ggplot, tree_width, ...) { tree_annot_func <- ComplexHeatmap::AnnotationFunction( fun = function(index) { pushViewport(viewport(height = 1)) @@ -334,7 +334,7 @@ make_corrupt_tree_heatmap <- function(tree_ggplot, ...) { popViewport() }, var_import = list(tree_ggplot = tree_ggplot), - width = grid::unit(4, "cm"), + width = grid::unit(tree_width, "cm"), which = "row" ) tree_annot <- ComplexHeatmap::HeatmapAnnotation( @@ -466,7 +466,9 @@ make_left_annot <- function(copynumber, annotation_legend_param = list( Cluster = list(nrow = clone_legend_rows, direction = "horizontal"), Sample = list(nrow = library_legend_rows, direction = "horizontal"), - labels_gp = grid::gpar(fontsize = annofontsize) + labels_gp = grid::gpar(fontsize = annofontsize-1), + legend_gp = grid::gpar(fontsize = annofontsize-1), + title_gp = grid::gpar(fontsize = annofontsize-1) ), show_legend = show_legend ) @@ -479,7 +481,9 @@ make_left_annot <- function(copynumber, annotation_name_gp = grid::gpar(fontsize = annofontsize - 1), annotation_legend_param = list( Cluster = list(nrow = clone_legend_rows), - labels_gp = grid::gpar(fontsize = annofontsize) + labels_gp = grid::gpar(fontsize = annofontsize-1), + legend_gp = grid::gpar(fontsize = annofontsize-1), + title_gp = grid::gpar(fontsize = annofontsize-1) ), show_legend = show_legend ) @@ -493,7 +497,9 @@ make_left_annot <- function(copynumber, annotation_legend_param = list( Cluster = list(nrow = clone_legend_rows, direction = "horizontal"), Sample = list(nrow = library_legend_rows, direction = "horizontal"), - labels_gp = grid::gpar(fontsize = annofontsize) + labels_gp = grid::gpar(fontsize = annofontsize-1), + legend_gp = grid::gpar(fontsize = annofontsize-1), + title_gp = grid::gpar(fontsize = annofontsize-1) ), show_legend = show_legend ) @@ -504,7 +510,9 @@ make_left_annot <- function(copynumber, annotation_name_gp = grid::gpar(fontsize = annofontsize - 1), annotation_legend_param = list( Sample = list(nrow = library_legend_rows), - labels_gp = grid::gpar(fontsize = annofontsize) + labels_gp = grid::gpar(fontsize = annofontsize-1), + legend_gp = grid::gpar(fontsize = annofontsize-1), + title_gp = grid::gpar(fontsize = annofontsize-1) ), show_legend = show_legend ) @@ -517,7 +525,9 @@ make_left_annot <- function(copynumber, annotation_name_gp = grid::gpar(fontsize = annofontsize - 1), annotation_legend_param = list( Cluster = list(nrow = clone_legend_rows), - labels_gp = grid::gpar(fontsize = annofontsize) + labels_gp = grid::gpar(fontsize = annofontsize-1), + legend_gp = grid::gpar(fontsize = annofontsize-1), + title_gp = grid::gpar(fontsize = annofontsize-1) ), show_legend = show_legend ) @@ -528,7 +538,10 @@ make_left_annot <- function(copynumber, which = "row", simple_anno_size = grid::unit(0.4, "cm"), annotation_name_gp = grid::gpar(fontsize = annofontsize - 1), annotation_legend_param = list( - Sample = list(nrow = library_legend_rows) + Cluster = list(nrow = clone_legend_rows), + labels_gp = grid::gpar(fontsize = annofontsize-1), + legend_gp = grid::gpar(fontsize = annofontsize-1), + title_gp = grid::gpar(fontsize = annofontsize-1) ), show_legend = show_legend ) @@ -930,6 +943,7 @@ getSVlegend <- function(include = NULL) { #' @param Mb Use Mb ticks when plotting single chromosome #' @param annofontsize Font size to use for annotations, default = 10 #' @param annotation_height Height of the annotations +#' @param tree_width Width of phylogenetic tree, default = 4 #' #' If clusters are set to NULL then the function will compute clusters using UMAP and HDBSCAN. #' @@ -984,6 +998,7 @@ plotHeatmap <- function(cn, maxCNcol = 11, anno_width = 0.4, rasterquality = 15, + tree_width = 4, ...) { if (is.hscn(cn) | is.ascn(cn)) { CNbins <- cn$data @@ -1112,7 +1127,7 @@ plotHeatmap <- function(cn, tree_ggplot <- make_tree_ggplot(tree, as.data.frame(clustering_results$clusters), clone_pal = clone_pal) tree_plot_dat <- tree_ggplot$data message("Creating tree...") - tree_hm <- make_corrupt_tree_heatmap(tree_ggplot) + tree_hm <- make_corrupt_tree_heatmap(tree_ggplot, tree_width = tree_width) ordered_cell_ids <- get_ordered_cell_ids(tree_plot_dat) clusters <- clustering_results$clustering %>% @@ -1120,9 +1135,9 @@ plotHeatmap <- function(cn, } if (!is.null(clusters)) { - cells_clusters <- length(unique(clusters$cell_id)) - cells_data <- length(unique(CNbins$cell_id)) - if (cells_data != cells_clusters){ + cells_clusters <- unique(clusters$cell_id) + cells_data <- unique(CNbins$cell_id) + if (length(cells_data) != length(cells_clusters)){ warning("Number of cells in clusters dataframe != number of cells in the bins data! Removing some cells") cells_to_keep <- intersect(cells_clusters, cells_data) CNbins <- dplyr::filter(CNbins, cell_id %in% cells_to_keep) @@ -1147,7 +1162,7 @@ plotHeatmap <- function(cn, tree_plot_dat <- tree_ggplot$data message("Creating tree...") - tree_hm <- make_corrupt_tree_heatmap(tree_ggplot) + tree_hm <- make_corrupt_tree_heatmap(tree_ggplot, tree_width = tree_width) ordered_cell_ids <- get_ordered_cell_ids(tree_plot_dat) } @@ -1165,7 +1180,7 @@ plotHeatmap <- function(cn, tree_plot_dat <- tree_ggplot$data message("Creating tree...") - tree_hm <- make_corrupt_tree_heatmap(tree_ggplot) + tree_hm <- make_corrupt_tree_heatmap(tree_ggplot, tree_width = tree_width) ordered_cell_ids <- get_ordered_cell_ids(tree_plot_dat) } else if (reorderclusters == TRUE & is.null(tree)) { @@ -1290,7 +1305,7 @@ plotSNVHeatmap <- function(SNVs, tree_plot_dat <- tree_ggplot$data message("Creating tree...") - tree_hm <- make_corrupt_tree_heatmap(tree_ggplot) + tree_hm <- make_corrupt_tree_heatmap(tree_ggplot, tree_width = tree_width) ordered_cell_ids <- get_ordered_cell_ids(tree_plot_dat) muts <- muts[ordered_cell_ids, ] @@ -1399,7 +1414,7 @@ plotHeatmapQC <- function(cn, tree_ggplot <- make_tree_ggplot(tree, as.data.frame(clustering_results$clusters), clone_pal = clone_pal) tree_plot_dat <- tree_ggplot$data message("Creating tree...") - tree_hm <- make_corrupt_tree_heatmap(tree_ggplot) + tree_hm <- make_corrupt_tree_heatmap(tree_ggplot, tree_width = tree_width) ordered_cell_ids <- get_ordered_cell_ids(tree_plot_dat) clusters <- clustering_results$clustering %>% @@ -1426,7 +1441,7 @@ plotHeatmapQC <- function(cn, tree_plot_dat <- tree_ggplot$data message("Creating tree...") - tree_hm <- make_corrupt_tree_heatmap(tree_ggplot) + tree_hm <- make_corrupt_tree_heatmap(tree_ggplot, tree_width = tree_width) ordered_cell_ids <- get_ordered_cell_ids(tree_plot_dat) } diff --git a/R/plotting.R b/R/plotting.R index d4fcfbd3..e87a6421 100644 --- a/R/plotting.R +++ b/R/plotting.R @@ -286,6 +286,53 @@ plotSV <- function(breakpoints, return(p) } +#' @export +plotSVlines <- function(breakpoints, + chrfilt = NULL, + returnlist = FALSE, + ylims = c(0, 2), + legend.position = "bottom", + ...) { + pl <- plottinglistSV(breakpoints, chrfilt = chrfilt) + + pl$breakpoints <- pl$breakpoints %>% + mutate(rearrangement_type = ifelse(rearrangement_type %in% c("unbalanced", "balanced"), type, rearrangement_type)) + + pl$breakpoints$rearrangement_type <- unlist(lapply(pl$breakpoints$rearrangement_type, CapStr)) + + gSV <- pl$bins %>% + ggplot2::ggplot(ggplot2::aes(x = idx, y = 1)) + + ggplot2::geom_vline(xintercept = pl$chrbreaks, col = "grey90", alpha = 0.75) + + ggplot2::scale_x_continuous(breaks = pl$chrticks, labels = pl$chrlabels, expand = c(0, 0), limits = c(pl$minidx, pl$maxidx)) + + xlab("Chromosome") + + cowplot::theme_cowplot(...) + + ggplot2::theme( + axis.line.y = ggplot2::element_blank(), + axis.text.y = ggplot2::element_blank(), + axis.ticks.y = ggplot2::element_blank(), + legend.position = legend.position + ) + + ylab("SV") + + ggplot2::ylim(ylims) + + gSV <- gSV + + ggplot2::geom_linerange(data = pl$breakpoints, aes(x = idx_1, ymin = 0, ymax = 2, col = rearrangement_type)) + + ggplot2::geom_linerange(data = pl$breakpoints, aes(x = idx_2, ymin = 0, ymax = 2, col = rearrangement_type)) + + ggplot2::labs(col = "Rearrangement") + + ggplot2::scale_color_manual( + breaks = names(SV_colors), + values = as.vector(SV_colors) + ) + + if (returnlist == TRUE) { + p <- list(SV = gSV, plist = pl) + } else { + p <- gSV + } + + return(p) +} + #' @export plotSV2 <- function(breakpoints, diff --git a/man/callAlleleSpecificCN.Rd b/man/callAlleleSpecificCN.Rd index 6c0b3cf3..143ea1c8 100644 --- a/man/callAlleleSpecificCN.Rd +++ b/man/callAlleleSpecificCN.Rd @@ -7,7 +7,7 @@ callAlleleSpecificCN( CNbins, haplotypes, - eps = 0.000000000001, + eps = 1e-12, loherror = 0.02, maxCN = NULL, selftransitionprob = 0.95, diff --git a/man/callAlleleSpecificCNfromHSCN.Rd b/man/callAlleleSpecificCNfromHSCN.Rd index 449b50bc..71478e61 100644 --- a/man/callAlleleSpecificCNfromHSCN.Rd +++ b/man/callAlleleSpecificCNfromHSCN.Rd @@ -6,7 +6,7 @@ \usage{ callAlleleSpecificCNfromHSCN( hscn, - eps = 0.000000000001, + eps = 1e-12, maxCN = NULL, selftransitionprob = 0.95, progressbar = TRUE, diff --git a/man/callHaplotypeSpecificCN.Rd b/man/callHaplotypeSpecificCN.Rd index d3bffc6f..1e8ac40c 100644 --- a/man/callHaplotypeSpecificCN.Rd +++ b/man/callHaplotypeSpecificCN.Rd @@ -7,7 +7,7 @@ callHaplotypeSpecificCN( CNbins, haplotypes, - eps = 0.000000000001, + eps = 1e-12, maskedbins = NULL, loherror = 0.02, maxCN = NULL, diff --git a/man/getBins.Rd b/man/getBins.Rd index 92903060..6d293656 100644 --- a/man/getBins.Rd +++ b/man/getBins.Rd @@ -4,7 +4,7 @@ \alias{getBins} \title{Make fixed-width bins} \usage{ -getBins(chrom.lengths = hg19_chrlength, binsize = 1000000, chromosomes = NULL) +getBins(chrom.lengths = hg19_chrlength, binsize = 1e+06, chromosomes = NULL) } \arguments{ \item{chrom.lengths}{A named character vector with chromosome lengths. Names correspond to chromosomes.} diff --git a/man/plotCNprofile.Rd b/man/plotCNprofile.Rd index a7119720..1f826950 100644 --- a/man/plotCNprofile.Rd +++ b/man/plotCNprofile.Rd @@ -93,8 +93,6 @@ plotCNprofile( \item{positionticks}{set to TRUE to use position ticks rather than chromosome ticks} \item{ideogram}{plot ideogram at the top, default = TRUE} - -\item{ideogram_height}{height of the ideogram} } \value{ ggplot2 plot diff --git a/man/plotCNprofileBAF.Rd b/man/plotCNprofileBAF.Rd index 2e57f888..33f0abcb 100644 --- a/man/plotCNprofileBAF.Rd +++ b/man/plotCNprofileBAF.Rd @@ -34,7 +34,9 @@ plotCNprofileBAF( chrstart = NULL, chrend = NULL, shape = 16, + ideogram = FALSE, positionticks = FALSE, + genome = "hg19", ... ) } @@ -91,8 +93,12 @@ plotCNprofileBAF( \item{shape}{shape for plotting, default = 16} +\item{ideogram}{plot ideogram at the top, default = TRUE} + \item{positionticks}{set to TRUE to use position ticks rather than chromosome ticks} +\item{genome}{genome to use, default = "hg19" (only used for ideogram)} + \item{offest}{to use when plotting inferred states in homolog plot} } \value{ diff --git a/man/plotHeatmap.Rd b/man/plotHeatmap.Rd index 181b0a1e..00a9b5ce 100644 --- a/man/plotHeatmap.Rd +++ b/man/plotHeatmap.Rd @@ -23,6 +23,7 @@ plotHeatmap( frequencycutoff = 2, maxf = NULL, plotfrequency = FALSE, + frequency_height = 1.4, show_legend = TRUE, show_library_label = TRUE, show_clone_label = TRUE, @@ -45,6 +46,7 @@ plotHeatmap( maxCNcol = 11, anno_width = 0.4, rasterquality = 15, + tree_width = 4, ... ) } @@ -85,6 +87,8 @@ plotHeatmap( \item{plotfrequency}{Plot the frequency track of gains and losses across the genome} +\item{frequency_height}{height of the frequency track if using, default = 1.4} + \item{show_legend}{plot legend or not, boolean} \item{show_library_label}{show library label or not, boolean} @@ -111,9 +115,7 @@ plotHeatmap( \item{fillgenome}{fill in any missing bins and add NA to centromeric regions} -\item{annotation_height}{Height of the annotations - -If clusters are set to NULL then the function will compute clusters using UMAP and HDBSCAN.} +\item{annotation_height}{Height of the annotations} \item{annofontsize}{Font size to use for annotations, default = 10} @@ -130,6 +132,10 @@ If clusters are set to NULL then the function will compute clusters using UMAP a \item{anno_width}{width of left annotations} \item{rasterquality}{default = 15} + +\item{tree_width}{Width of phylogenetic tree, default = 4 + +If clusters are set to NULL then the function will compute clusters using UMAP and HDBSCAN.} } \description{ Plot a heatmap where rows are cells, columns are genome coordinates and colours map to (allele-specific) copy-number states