merge free_*, align_*, cross_* into one class

DESCRIPTION

@@ -45,7 +45,6 @@ Language: en-GB
 Collate: 
     'active.R'
     'plot-.R'
-    'plot-align-.R'
     'align-.R'
     'align-hclust.R'
     'align-dendrogram.R'
@@ -78,6 +77,8 @@ Collate:
     'dendrogram.R'
     'fortify-data_frame.R'
     'fortify-matrix.R'
+    'free-.R'
+    'free-gg.R'
     'geom-draw.R'
     'geom-pie.R'
     'geom-subrect.R'
@@ -111,8 +112,6 @@ Collate:
     'layout-stack-switch.R'
     'object-name.R'
     'plot-add.R'
-    'plot-free-.R'
-    'plot-free-gg.R'
     'raster-magick.R'
     'rasterise.R'
     'scheme-.R'

NAMESPACE

@@ -8,14 +8,10 @@ S3method(.raster_magick,Layer)
 S3method(.raster_magick,QuadLayout)
 S3method(.raster_magick,StackLayout)
 S3method(.raster_magick,default)
-S3method(.raster_magick,ggalign_align)
 S3method(.raster_magick,ggalign_plot)
 S3method(.raster_magick,ggplot)
 S3method(.raster_magick,grob)
 S3method(.raster_magick,list)
-S3method(align_add,Coord)
-S3method(align_add,default)
-S3method(align_add,ggalign_scheme)
 S3method(align_melt_facet,FacetGrid)
 S3method(align_melt_facet,FacetNull)
 S3method(align_melt_facet,FacetStack)
@@ -78,8 +74,6 @@ S3method(fortify_matrix,default)
 S3method(fortify_matrix,formula)
 S3method(fortify_matrix,matrix)
 S3method(fortify_matrix,waiver)
-S3method(free_add,default)
-S3method(free_add,ggalign_scheme)
 S3method(free_align,alignpatches)
 S3method(free_align,default)
 S3method(free_align,free_align)
@@ -119,17 +113,17 @@ S3method(ggalign_build,alignpatches)
 S3method(ggalign_build,ggplot)
 S3method(ggalign_gtable,alignpatches)
 S3method(ggalign_gtable,ggplot)
+S3method(ggalign_stat,Align)
 S3method(ggalign_stat,QuadLayout)
 S3method(ggalign_stat,StackLayout)
 S3method(ggalign_stat,default)
-S3method(ggalign_stat,ggalign_align)
+S3method(ggalign_stat,ggalign_plot)
 S3method(ggoncoplot,"NULL")
 S3method(ggoncoplot,default)
 S3method(ggoncoplot,formula)
 S3method(ggoncoplot,functon)
 S3method(ggplot_add,coord_ggalign)
 S3method(ggplot_add,ggalign_default_expansion)
-S3method(ggplot_add,ggalign_free_gg)
 S3method(ggplot_add,ggalign_layer_order)
 S3method(ggplot_add,ggalign_with_quad)
 S3method(ggplot_add,patch_inset)
@@ -145,6 +139,9 @@ S3method(inherit_scheme,"NULL")
 S3method(inherit_scheme,scheme_align)
 S3method(inherit_scheme,scheme_data)
 S3method(inherit_scheme,scheme_theme)
+S3method(is_coord_okay,CoordCartesian)
+S3method(is_coord_okay,CoordTrans)
+S3method(is_coord_okay,default)
 S3method(layer_order,Layer)
 S3method(layer_order,default)
 S3method(layer_order,ggalign_layer_order)
@@ -169,9 +166,7 @@ S3method(object_name,AlignProto)
 S3method(object_name,CrossGg)
 S3method(object_name,QuadLayout)
 S3method(object_name,StackLayout)
-S3method(object_name,ggalign_align_plot)
-S3method(object_name,ggalign_free_gg)
-S3method(object_name,ggalign_free_plot)
+S3method(object_name,ggalign_plot)
 S3method(order2,dendrogram)
 S3method(order2,hclust)
 S3method(order2,ser_permutation)
@@ -194,14 +189,11 @@ S3method(patch,recordedplot)
 S3method(patch,trellis)
 S3method(plot,ggalign_area)
 S3method(plot,ggalign_plot)
-S3method(plot_add,ggalign_align_plot)
-S3method(plot_add,ggalign_free_plot)
+S3method(plot_add,default)
+S3method(plot_add,ggalign_scheme)
 S3method(plot_add_scheme,"NULL")
 S3method(plot_add_scheme,scheme_data)
 S3method(plot_add_scheme,scheme_theme)
-S3method(plot_build,ggalign_align_plot)
-S3method(plot_build,ggalign_free_plot)
-S3method(plot_initialize,ggalign_free_gg)
 S3method(print,LayoutProto)
 S3method(print,alignpatches)
 S3method(print,ggalign_plot)
@@ -225,10 +217,8 @@ S3method(quad_layout_add,QuadLayout)
 S3method(quad_layout_add,StackLayout)
 S3method(quad_layout_add,data.frame)
 S3method(quad_layout_add,default)
-S3method(quad_layout_add,ggalign_align_plot)
-S3method(quad_layout_add,ggalign_free_plot)
+S3method(quad_layout_add,ggalign_plot)
 S3method(quad_layout_add,ggalign_with_quad)
-S3method(quad_layout_add,ggplot)
 S3method(quad_layout_add,layout_title)
 S3method(quad_layout_add,list)
 S3method(quad_layout_add,matrix)
@@ -253,9 +243,7 @@ S3method(stack_layout_add,CrossLayout)
 S3method(stack_layout_add,QuadLayout)
 S3method(stack_layout_add,StackLayout)
 S3method(stack_layout_add,default)
-S3method(stack_layout_add,ggalign_align_plot)
-S3method(stack_layout_add,ggalign_cross)
-S3method(stack_layout_add,ggalign_free_plot)
+S3method(stack_layout_add,ggalign_plot)
 S3method(stack_layout_add,ggalign_with_quad)
 S3method(stack_layout_add,ggplot)
 S3method(stack_layout_add,layout_annotation)
@@ -270,12 +258,16 @@ S3method(stack_layout_and_add,theme)
 S3method(stack_layout_subtract,default)
 S3method(stack_layout_subtract,ggalign_scheme)
 S3method(stack_layout_subtract,ggalign_with_quad)
+S3method(summary,Align)
+S3method(summary,AlignGg)
 S3method(summary,AlignGroup)
 S3method(summary,AlignHclust)
 S3method(summary,AlignKmeans)
 S3method(summary,AlignOrder)
 S3method(summary,AlignProto)
-S3method(summary,ggalign_align_plot)
+S3method(summary,AlignReorder)
+S3method(summary,Cross)
+S3method(summary,Free)
 S3method(summary,ggalign_plot)
 S3method(update_layout_coords,CrossLayout)
 S3method(update_layout_coords,QuadLayout)

R/align-.R

@@ -86,6 +86,8 @@ align <- function(align, data, params = list(), plot = NULL,
     data <- allow_lambda(data)
     assert_bool(facet, call = call)
     assert_bool(limits, call = call)
+    no_axes <- no_axes %||%
+        getOption(sprintf("%s.align_no_axes", pkg_nm()), default = TRUE)
     schemes <- schemes %|w|% default_schemes(data)
 
     # Warn about extra params or missing parameters ---------------
@@ -100,46 +102,57 @@ align <- function(align, data, params = list(), plot = NULL,
         }
     }
     input_params <- params[vec_set_intersect(input, all)]
+    new_ggalign_plot(
+        align = align,
 
-    new_align_plot(
-        align = ggproto(
-            NULL,
-            align,
-            # Following fields will be initialzed when added into the layout
-            # and will be saved and accessed across the plot rendering process
-            direction = NULL,
-            position = NULL,
-            params = NULL, # `$setup_params` method
-            data = NULL, # $setup_data method
-            statistics = NULL, # `$compute` method
-            labels = NULL, # the original `vec_names()` of the `input_data`
+        # additional field for `align` object
+        no_axes = no_axes,
 
-            # new fields
-            facet = facet,
-            limits = limits,
+        # Following fields will be initialzed when added into the layout
+        # and will be saved and accessed across the plot rendering process
+        direction = NULL,
+        position = NULL,
+        params = NULL, # `$setup_params` method
+        data = NULL, # $setup_data method
+        statistics = NULL, # `$compute` method
+        labels = NULL, # the original `vec_names()` of the `input_data`
 
-            # use `NULL` if this align don't require any data
-            # use `waiver()` to inherit from the layout data
-            input_data = data,
+        # new fields
+        facet = facet,
+        limits = limits,
 
-            # collect parameters
-            input_params = input_params
-        ),
-        no_axes = no_axes,
+        # use `NULL` if this align don't require any data
+        # use `waiver()` to inherit from the layout data
+        input_data = data,
+
+        # collect parameters
+        input_params = input_params,
+
+        # object slots
         plot = plot,
         active = active,
         size = size,
         schemes = schemes,
-        class = "ggalign_align",
+
+        # call
         call = call
     )
 }
 
-#' @include plot-align-.R
-methods::setClass("ggalign_align", contains = "ggalign_align_plot")
+is_align_plot <- function(x) is_ggalign_plot(x) && is_align(x@align)
 
-#' @importFrom methods is
-is_align <- function(x) is(x, "ggalign_align")
+is_align <- function(x) inherits(x, "Align")
+
+#' @export
+summary.Align <- function(object, ...) {
+    # we always push user define summary method
+    # since `Align` object should reorder observations or split observations
+    # into groups
+    cli_abort(sprintf(
+        "You must define {.fn summary} method for {.cls %s}",
+        .subset(class(object), 1L)
+    ))
+}
 
 #' @details
 #' Each of the `Align*` objects is just a [`ggproto()`][ggplot2::ggproto]
@@ -159,8 +172,9 @@ is_align <- function(x) is(x, "ggalign_align")
 #' @format NULL
 #' @usage NULL
 #' @rdname align
-#' @include plot-align-.R
+#' @include plot-.R
 Align <- ggproto("Align", AlignProto,
+    free_align = FALSE,
     parameters = function(self) {
         c(
             align_method_params(
@@ -264,7 +278,8 @@ Align <- ggproto("Align", AlignProto,
             object_name
         )
     },
-    build = function(self, plot, coords, extra_coords, previous_coords = NULL) {
+    build_plot = function(self, plot, coords, extra_coords,
+                          previous_coords = NULL) {
         direction <- self$direction
         panel <- .subset2(coords, "panel")
         index <- .subset2(coords, "index")
@@ -375,39 +390,32 @@ Align <- ggproto("Align", AlignProto,
     #    index, this will be checked in `align_initialize_layout` function.
     align = function(self, panel, index) list(panel, index),
 
-    # initialize the plot, add the default mapping, theme, and et al.
-    # if `NULL`, no plot area will be added.
-    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) {
         plot
-    }
-)
-
-remove_scales <- function(plot, scale_aesthetics) {
-    scales <- .subset2(plot, "scales")$clone()
-    if (any(prev_aes <- scales$find(scale_aesthetics))) {
-        scales$scales <- scales$scales[!prev_aes]
-    }
-    plot$scales <- scales
-    plot
-}
+    },
 
-#' @importFrom rlang is_empty
-extract_scales <- function(plot, axis, n_panel, facet_scales) {
-    # if no facets, or if no facet scales, we replicate the single scale
-    # object to match the panel numbers
-    if (n_panel > 1L &&
-        !is.null(facet_scales) &&
-        !is_empty(ans <- .subset2(facet_scales, axis))) {
-    } else {
-        ans <- rep_len(list(plot$scales$get_scales(axis)), n_panel)
+    # let AlignProto to add schemes and theme acoordingly
+    finish_plot = function(self, plot, schemes, theme) {
+        direction <- self$direction
+        # remove axis titles, text, ticks used for alignment
+        if (isTRUE(self$no_axes)) {
+            schemes$scheme_theme <- .subset2(schemes, "scheme_theme") +
+                theme_no_axes(switch_direction(direction, "y", "x"))
+        }
+        plot <- plot_add_schemes(plot, schemes)
+        if (is_horizontal(direction)) {
+            theme <- theme(
+                panel.spacing.y = calc_element("panel.spacing.y", theme)
+            )
+        } else {
+            theme <- theme(
+                panel.spacing.x = calc_element("panel.spacing.x", theme)
+            )
+        }
+        plot + theme + theme_recycle()
     }
-    ans
-}
+)

R/align-dendrogram.R

@@ -133,7 +133,7 @@ align_dendro <- function(mapping = aes(), ...,
 AlignDendro <- ggproto("AlignDendro", AlignHclust,
     #' @importFrom ggplot2 aes ggplot
     #' @importFrom rlang inject
-    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot) {
         ggadd_default(plot, aes(x = .data$x, y = .data$y)) + switch_direction(
             self$direction,
             ggplot2::labs(x = "height"),

R/align-gg.R

@@ -126,12 +126,15 @@ align_gg <- function(data = waiver(), mapping = aes(), size = NULL,
 #' @rdname align_gg
 ggalign <- align_gg
 
+#' @export
+summary.AlignGg <- function(object, ...) c(FALSE, FALSE)
+
 #' @importFrom ggplot2 ggproto ggplot
 AlignGg <- ggproto("AlignGg", Align,
     nobs = function(self) { # no input data
         axis <- to_coord_axis(.subset2(self, "direction"))
         cli_abort(c(
-            "You cannot add {.fn {snake_class(self)}}",
+            sprintf("You cannot add %s", object_name(self)),
             i = "layout {axis}-axis is not initialized or you must provide {.arg data}"
         ), call = .subset2(self, "call"))
     },
@@ -146,7 +149,7 @@ AlignGg <- ggproto("AlignGg", Align,
         ans$.names <- NULL # always remove names, we'll add it in `draw()`
         ans
     },
-    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
+    setup_plot = function(self, plot) {
         direction <- self$direction
         ggadd_default(
             plot,

R/align-link.R

@@ -322,7 +322,7 @@ AlignLinkProto <- ggproto("AlignLinkProto", AlignGg,
                 plot$links_data$element <- element
             }
         }
-        plot
+        plot + theme_recycle()
     },
     setup_params = function(self, nobs, params) {
         if (!is.waive(x <- .subset2(params, self$arg))) {
@@ -352,9 +352,6 @@ AlignLinkProto <- ggproto("AlignLinkProto", AlignGg,
         }
         params
     },
-    setup_plot = function(self, plot, layout_data, layout_coords, layout_name) {
-        plot
-    },
 
     #' @importFrom stats reorder
     build = function(self, plot, coords, extra_coords, previous_coords = NULL) {

R/align-reorder.R

@@ -53,13 +53,12 @@ align_reorder <- function(stat, ..., reverse = FALSE,
             strict = strict
         ),
         active = active,
-        check.param = TRUE,
         data = data %||% waiver()
     )
 }
 
 #' @export
-summary.AlignOrder <- function(object, ...) c(TRUE, FALSE)
+summary.AlignReorder <- function(object, ...) c(TRUE, FALSE)
 
 #' @importFrom ggplot2 ggproto
 #' @importFrom rlang inject