save direction, position, object_name in AlignProto

Yunuuuu · Dec 13, 2024 · c3f8fa7 · c3f8fa7
1 parent d08c58a
commit c3f8fa7
Show file tree

Hide file tree

Showing 6 changed files with 49 additions and 64 deletions.
diff --git a/R/align-.R b/R/align-.R
@@ -180,12 +180,10 @@ Align <- ggproto("Align", AlignProto,
             self$extra_params
         )
     },
-    layout = function(self, direction, position, object_name,
-                      layout_data, layout_coords, layout_name) {
-        self$direction <- direction
-        self$position <- position
+    layout = function(self, layout_data, layout_coords, layout_name) {
         input_data <- .subset2(self, "input_data")
         input_params <- .subset2(self, "input_params")
+        object_name <- .subset2(self, "object_name")
         call <- .subset2(self, "call")
         layout_panel <- .subset2(layout_coords, "panel")
         layout_index <- .subset2(layout_coords, "index")
@@ -268,8 +266,9 @@ Align <- ggproto("Align", AlignProto,
             object_name
         )
     },
-    build = function(self, plot, direction, position,
+    build = function(self, plot, schemes,
                      coords, extra_coords, previous_coords = NULL) {
+        direction <- self$direction
         panel <- .subset2(coords, "panel")
         index <- .subset2(coords, "index")
         if (is.null(extra_coords)) {
@@ -280,18 +279,13 @@ Align <- ggproto("Align", AlignProto,
             extra_index <- .subset2(extra_coords, "index")
         }
         params <- .subset2(self, "params")
-        plot <- align_inject(self$draw, c(
-            params,
-            list(
-                plot = plot,
-                panel = panel,
-                index = index,
-                extra_panel = extra_panel,
-                extra_index = extra_index,
-                direction = direction,
-                position = position
-            )
-        ))
+        plot <- align_inject(self$draw, c(params, list(
+            plot = plot,
+            panel = panel,
+            index = index,
+            extra_panel = extra_panel,
+            extra_index = extra_index
+        )))
 
         coords$labels <- .subset(.subset2(self, "labels"), index)
         # only when user use the internal facet, we'll setup the limits
@@ -387,17 +381,15 @@ Align <- ggproto("Align", AlignProto,
 
     # initialize the plot, add the default mapping, theme, and et al.
     # if `NULL`, no plot area will be added.
-    setup_plot = function(self, plot, direction, position, object_name,
-                          layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
         plot
     },
 
     # Following methods will be executed when building plot with the final
     # heatmap layout you shouldn't modify the `Align` object when drawing,
     # since all of above process will only run once.
     # Note: panel input will be reordered by index
-    draw = function(self, plot, panel, index, extra_panel, extra_index,
-                    direction, position) {
+    draw = function(self, plot, panel, index, extra_panel, extra_index) {
         plot
     }
 )

diff --git a/R/align-dendrogram.R b/R/align-dendrogram.R
@@ -133,20 +133,19 @@ align_dendro <- function(mapping = aes(), ...,
 AlignDendro <- ggproto("AlignDendro", AlignHclust,
     #' @importFrom ggplot2 aes ggplot
     #' @importFrom rlang inject
-    setup_plot = function(self, plot, direction, position, object_name,
-                          layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
         ggadd_default(plot, aes(x = .data$x, y = .data$y)) + switch_direction(
-            direction,
+            self$direction,
             ggplot2::labs(x = "height"),
             ggplot2::labs(y = "height")
         )
     },
     draw = function(self, plot, panel, index, extra_panel, extra_index,
-                    direction,
                     # other argumentds
                     plot_dendrogram, segment_params,
                     plot_cut_height, center, type, root) {
         statistics <- .subset2(self, "statistics")
+        direction <- self$direction
         priority <- switch_direction(direction, "left", "right")
         dendrogram_panel <- self$panel[index]
         if (!is.null(dendrogram_panel) &&

diff --git a/R/align-gg.R b/R/align-gg.R
@@ -149,8 +149,8 @@ AlignGG <- ggproto("AlignGG", Align,
         ans$.names <- NULL # always remove names, we'll add it in `draw()`
         ans
     },
-    setup_plot = function(self, plot, direction, position, object_name,
-                          layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
+        direction <- self$direction
         ggadd_default(
             plot,
             mapping = switch_direction(

diff --git a/R/align-ranges.R b/R/align-ranges.R
@@ -45,19 +45,19 @@ AlignRanges <- ggproto("AlignRanges", AlignGG,
         params$margin <- .subset2(params, "margin") %||% margin()
         params
     },
-    setup_plot = function(self, plot, direction, position, object_name,
-                          layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
         ggadd_default(plot, theme = theme(
             panel.border = element_rect(fill = NA, colour = "grey20"),
             panel.background = element_rect(fill = "white", colour = NA)
         ))
     },
 
     #' @importFrom stats reorder
-    build = function(self, plot, direction, position,
+    build = function(self, plot,
                      coords, extra_coords, previous_coords = NULL) {
         params <- .subset2(self, "params")
-
+        direction <- self$direction
+        position <- self$position
         # parse link
         support_link <- switch_direction(
             direction, c("left", "right"), c("top", "bottom")

diff --git a/R/plot-align-.R b/R/plot-align-.R
@@ -50,28 +50,25 @@ AlignProto <- ggproto("AlignProto",
     ############################################################
     # when added to the `Layout` object, will call `$align` method
     # must have fixed parameters
-    layout = function(self, direction, position, object_name,
-                      layout_data, layout_coords, layout_name) {
+    layout = function(self, layout_data, layout_coords, layout_name) {
         cli_abort(sprintf(
-            "%s, has not implemented a {.fn align} method",
-            "{.fn {snake_class(self)}}"
+            "%s, has not implemented a {.fn layout} method",
+            object_name(self)
         ))
     },
-    setup_plot = function(self, plot, direction, position, object_name,
-                          layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
         cli_abort(sprintf(
             "%s, has not implemented a {.fn setup_plot} method",
-            "{.fn {snake_class(self)}}"
+            object_name(self)
         ))
     },
-    finish_layout = function(self, layout, direction, position, object_name,
-                             layout_data, layout_coords, layout_name) {
+    finish_layout = function(self, layout, layout_data,
+                             layout_coords, layout_name) {
         layout
     },
 
     ##############################################################
-    build = function(plot, schemes, direction, position,
-                     coords, extra_coords, previous_coords) {
+    build = function(plot, schemes, coords, extra_coords, previous_coords) {
         plot
     },
     add_schemes = function(plot, schemes) plot_add_schemes(plot, schemes),
@@ -106,7 +103,8 @@ align_method_params <- function(f, remove = character()) {
 
 #' @importFrom rlang inject
 #' @export
-plot_build.ggalign_align_plot <- function(plot, ..., direction, schemes) {
+plot_build.ggalign_align_plot <- function(plot, ..., schemes,
+                                          direction, position) {
     # let `Align` to determine how to build the plot
     align <- plot@align # `AlignProto` object
 
@@ -119,13 +117,7 @@ plot_build.ggalign_align_plot <- function(plot, ..., direction, schemes) {
     # coords
     # extra_coords
     # previous_coords
-    # direction
-    # position
-    ans <- align$build(
-        plot = plot@plot,
-        ...,
-        direction = direction
-    )
+    ans <- align$build(plot = plot@plot, ...)
 
     # remove axis titles, text, ticks used for alignment
     if (isTRUE(plot@no_axes)) {
@@ -149,10 +141,13 @@ stack_layout_add.ggalign_align_plot <- function(object, stack, object_name) {
             ))
         } else {
             align <- object@align
+            # initialize the necessary parameters for `AlignProto` object
+            align$direction <- stack@direction
+            align$position <- .subset2(stack@heatmap, "position")
+            align$object_name <- object_name
+
+            # prepare layout parameters used to setup layout coords
             params <- list(
-                direction = stack@direction,
-                position = .subset2(stack@heatmap, "position"),
-                object_name = object_name,
                 layout_data = stack@data, # must be a matrix
                 layout_coords = old_coords,
                 layout_name = object_name(stack)

diff --git a/R/plot-align-cross.R b/R/plot-align-cross.R
@@ -54,27 +54,25 @@ is_cross_link <- function(x) is(x, "ggalign_cross_link")
 
 #' @importFrom ggplot2 ggproto ggplot
 CrossLink <- ggproto("CrossLink", AlignProto,
-    layout = function(self, direction, position, object_name,
-                      layout_data, layout_coords, layout_name) {
+    layout = function(self, layout_data, layout_coords, layout_name) {
         if (is.null(.subset2(layout_coords, "nobs"))) {
             cli_abort(sprintf(
-                "layout observations for %s must be initialized before adding {.var {object_name}}",
-                layout_name
+                "layout observations for %s must be initialized before adding {.var {%s}}",
+                layout_name, .subset2(self, "object_name")
             ))
         }
         # we keep the names from the layout data for usage
         self$labels <- vec_names(layout_data)
         layout_coords["index"] <- list(NULL) # reset the index
         layout_coords
     },
-    setup_plot = function(self, plot, direction, position, object_name,
-                          layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
         ggadd_default(plot, mapping = switch_direction(
-            direction, aes(y = .data$.y), aes(x = .data$.x)
+            self$direction, aes(y = .data$.y), aes(x = .data$.x)
         ))
     },
-    finish_layout = function(self, layout, direction, position, object_name,
-                             layout_data, layout_coords, layout_name) {
+    finish_layout = function(self, layout, layout_data, layout_coords,
+                             layout_name) {
         # udpate cross_points
         layout@cross_points <- c(layout@cross_points, length(layout@plot_list))
         # update index
@@ -84,8 +82,9 @@ CrossLink <- ggproto("CrossLink", AlignProto,
         )
         layout
     },
-    build = function(self, plot, schemes, coords, extra_coords, previous_coords,
-                     direction, position) {
+    build = function(self, plot, schemes, coords,
+                     extra_coords, previous_coords) {
+        direction <- self$direction
         index <- vec_c(
             .subset2(previous_coords, "index"),
             .subset2(coords, "index")