New SV plot function

DESCRIPTION

@@ -41,7 +41,7 @@ Imports:
     grid,
     ggforce,
     ggtree
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Suggests: 
     knitr,
     rmarkdown,

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)

R/heatmap_plot.R

@@ -326,15 +326,15 @@ 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))
       grid.draw(ggplot2::ggplotGrob(tree_ggplot)$grobs[[5]])
       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,17 +1127,17 @@ 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 %>%
       dplyr::select(cell_id, clone_id)
   }
 
   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)
   }
 

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,