remove classes from patchwork method

Yunuuuu · Sep 13, 2024 · b2157ec · b2157ec
1 parent 1a15e1a
commit b2157ec
Show file tree

Hide file tree

Showing 8 changed files with 9 additions and 14 deletions.
diff --git a/R/alignpatch-free-align.R b/R/alignpatch-free-align.R
@@ -103,11 +103,6 @@ free_align.default <- function(plot, axes = "tlbr") {
 #' @importFrom ggplot2 ggproto ggproto_parent
 #' @export
 alignpatch.free_align <- function(x) {
-    # we remove the class of `free_align()`
-    # patchwork will keep the class when extracting patches from it.
-    # we removed the free_align class here, in case of re-call this
-    # function again in `alignpatch.patchwork`
-    class(x) <- setdiff(class(x), "free_align")
     Parent <- NextMethod()
     ggproto(
         "PatchFreeAlign", Parent,

diff --git a/R/alignpatch-free-border.R b/R/alignpatch-free-border.R
@@ -60,7 +60,6 @@ free_border.default <- function(plot, borders = "tlbr") {
 #' @importFrom ggplot2 ggproto ggproto_parent
 #' @export
 alignpatch.free_border <- function(x) {
-    class(x) <- setdiff(class(x), "free_border")
     Parent <- NextMethod()
     ggproto(
         "PatchFreeBorder", Parent,

diff --git a/R/alignpatch-free-lab.R b/R/alignpatch-free-lab.R
@@ -53,7 +53,6 @@ free_lab.default <- function(plot, labs = "tlbr") {
 #' @importFrom ggplot2 ggproto ggproto_parent
 #' @export
 alignpatch.free_lab <- function(x) {
-    class(x) <- setdiff(class(x), "free_lab")
     Parent <- NextMethod()
     ggproto(
         "PatchFreeLab", Parent,

diff --git a/R/alignpatch-free-space.R b/R/alignpatch-free-space.R
@@ -35,7 +35,6 @@ free_space.free_space <- function(plot, borders = "tlbr") {
 #' @importFrom grid unit
 #' @export
 alignpatch.free_space <- function(x) {
-    class(x) <- setdiff(class(x), "free_space")
     Parent <- NextMethod()
     ggproto(
         "PatchFreeSpace", Parent,

diff --git a/R/alignpatch-free-vp.R b/R/alignpatch-free-vp.R
@@ -32,7 +32,6 @@ free_vp.alignpatches <- free_vp.ggplot
 #' @importFrom ggplot2 ggproto ggproto_parent
 #' @export
 alignpatch.free_vp <- function(x) {
-    class(x) <- setdiff(class(x), "free_vp")
     Parent <- NextMethod()
     ggproto(
         "PatchFreeViewport", Parent,

diff --git a/R/alignpatch-ggplot2.R b/R/alignpatch-ggplot2.R
@@ -15,10 +15,7 @@ grid.draw.patch_ggplot <- grid.draw.alignpatches
 #################################################
 #' @importFrom ggplot2 ggproto
 #' @export
-alignpatch.ggplot <- function(x) {
-    class(x) <- setdiff(class(x), "patch_ggplot")
-    ggproto(NULL, PatchGgplot, plot = x)
-}
+alignpatch.ggplot <- function(x) ggproto(NULL, PatchGgplot, plot = x)
 
 # ggplot2 has following grobs:
 #    panel

diff --git a/R/alignpatch-patchwork.R b/R/alignpatch-patchwork.R
@@ -4,6 +4,14 @@
 alignpatch.patchwork <- function(x) {
     rlang::check_installed("patchwork", "to align patchwork")
     get_patches <- getFromNamespace("get_patches", "patchwork")
+    # patchwork will keep the class when extracting patches from it.
+    # we removed the classes for patchwork, added behind patchwork
+    # in this way, the last plot won't have class like `free_align`,
+    # `free_border`, `free_lab`, et al. which is added for the patchwork
+    sub_patchwork_cls <- which(class(x) == "patchwork") - 1L # nolint
+    if (sub_patchwork_cls > 0L) {
+        class(x) <- class(x)[-seq_len(sub_patchwork_cls)]
+    }
     x <- get_patches(x)
     plots <- .subset2(x, "plots")
     layout <- .subset2(x, "layout")

diff --git a/R/alignpatch-wrap.R b/R/alignpatch-wrap.R
@@ -197,7 +197,6 @@ patch.HeatmapAnnotation <- patch.HeatmapList
 #' @importFrom ggplot2 ggproto ggproto_parent
 #' @export
 alignpatch.wrapped_plot <- function(x) {
-    class(x) <- setdiff(class(x), "wrapped_plot")
     Parent <- NextMethod()
     ggproto(
         "PatchWrapped", Parent,