Merge pull request #7 from ycl6/get_Legend_fix

Add 'get_Legend()' to extract legend from a ggplot object

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: scRUtils
 Type: Package
 Title: Single-Cell Sequencing Analysis Utilities
-Version: 0.3.6
+Version: 0.3.7
 Authors@R:
     person(
       given = "I-Hsuan",
@@ -56,4 +56,4 @@ VignetteBuilder: knitr
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NAMESPACE

@@ -10,6 +10,7 @@ export(fig)
 export(geom_parallel_sets_labs)
 export(getDEGs)
 export(getMarkers)
+export(get_Legend)
 export(netVis_heatmap)
 export(plotBox)
 export(plotCyclone)
@@ -49,7 +50,6 @@ importFrom(SummarizedExperiment,rowData)
 importFrom(bluster,approxSilhouette)
 importFrom(circlize,colorRamp2)
 importFrom(cowplot,draw_label)
-importFrom(cowplot,get_legend)
 importFrom(cowplot,ggdraw)
 importFrom(cowplot,plot_grid)
 importFrom(cowplot,theme_cowplot)
@@ -76,6 +76,7 @@ importFrom(ggforce,geom_parallel_sets_axes)
 importFrom(ggnewscale,new_scale_colour)
 importFrom(ggplot2,GeomText)
 importFrom(ggplot2,aes_string)
+importFrom(ggplot2,ggplotGrob)
 importFrom(ggplot2,layer)
 importFrom(ggplot2,position_nudge)
 importFrom(ggrepel,geom_label_repel)

R/func_basics.R

@@ -440,3 +440,51 @@ plotParallel <- function(lab1, lab2, labels = c("label1", "label2"), color = NUL
   # Return plot
   p + scale_fill_manual(values = choosePalette(data$y, color))
 }
+
+#' Retrieve the legend of a plot
+#'
+#' This function extracts just the legend from a ggplot.
+#'
+#' @param object A `ggplot` or `gtable` from which to retrieve the legend.
+#'
+#' @return A `gtable` object holding just the legend or \code{NULL} if there is no legend.
+#'
+#' @details The `get_legend` function from the cowplot package stopped working properly 
+#' with ggplot2 v3.5.0. A modified function was contributed by Teun van den Brand 
+#' (teunbrand) on cowplot's GitHub Issues and should work with the newer version of ggplot2. 
+#' Please refer to \url{https://github.com/wilkelab/cowplot/issues/202} on the discussion of 
+#' this bug and fixes.
+#'
+#' @name get_Legend
+#'
+#' @export
+#' @importFrom ggplot2 ggplotGrob
+#' @examples
+#' library(ggplot2)
+#'
+#' p <- ggplot(mpg, aes(displ, hwy, colour = factor(cyl), shape = factor(year))) +
+#'   geom_point() + guides(shape = guide_legend(position = "bottom"))
+#'
+#' plot(get_Legend(p))
+get_Legend <- function(plot, legend = NULL) {
+  gt <- ggplotGrob(plot)
+
+  pattern <- "guide-box"
+  if (!is.null(legend)) {
+    pattern <- paste0(pattern, "-", legend)
+  }
+
+  indices <- grep(pattern, gt$layout$name)
+
+  not_empty <- !vapply(
+    gt$grobs[indices],
+    inherits, what = "zeroGrob",
+    FUN.VALUE = logical(1)
+  )
+  indices <- indices[not_empty]
+
+  if (length(indices) > 0) {
+    return(gt$grobs[[indices[1]]])
+  }
+  return(NULL)
+}

R/func_sc.R

@@ -1043,10 +1043,9 @@ plotProjection <- function(sce, feature, dimname = "TSNE", feat_desc = NULL, fea
 #' @return A \pkg{ggplot2} plot with an object of class `c("gg", "ggplot")`
 #'
 #' @details
-#' The function uses `plotProjection()` to create 2 base plots, then
-#' `get_legend()` from the \pkg{cowplot} package to produce a shared legend
-#' and `plot_grid()` from \pkg{cowplot} to create a compound figure with
-#' legend placed at the desired position as specified by `legend_pos`.
+#' The function uses `plotProjection()` to create 2 base plots, then `get_Legend()` 
+#' to produce a shared legend and `plot_grid()` from \pkg{cowplot} to create a compound 
+#' figure with legend placed at the desired position as specified by `legend_pos`.
 #'
 #' @author I-Hsuan Lin
 #'
@@ -1058,7 +1057,6 @@ plotProjection <- function(sce, feature, dimname = "TSNE", feat_desc = NULL, fea
 #' @import ggplot2
 #' @importFrom rlang warn
 #' @importFrom rlang abort
-#' @importFrom cowplot get_legend
 #' @importFrom cowplot plot_grid
 #' @examples
 #' # Load demo dataset
@@ -1137,7 +1135,7 @@ plotProjections <- function(sce, feature, dimnames = c("TSNE", "UMAP"), feat_des
         frame.colour = "black", ticks.colour = "black"
       ))
     }
-    legend <- get_legend(tmp + theme(legend.position = legend_pos, legend.justification = legend_just))
+    legend <- get_Legend(tmp + theme(legend.position = legend_pos, legend.justification = legend_just))
   }
 
   if (legend_pos == "right") {