refine class_ggplot_built and related functions

Author: teunbrand

NAMESPACE

@@ -58,11 +58,6 @@ S3method(fortify,tbl_df)
 S3method(get_alt_text,ggplot)
 S3method(get_alt_text,ggplot_built)
 S3method(get_alt_text,gtable)
-S3method(ggplot,"function")
-S3method(ggplot,default)
-S3method(ggplot_build,ggplot)
-S3method(ggplot_build,ggplot_built)
-S3method(ggplot_gtable,ggplot_built)
 S3method(grid.draw,absoluteGrob)
 S3method(grobHeight,absoluteGrob)
 S3method(grobHeight,zeroGrob)
@@ -292,6 +287,8 @@ export(binned_scale)
 export(borders)
 export(calc_element)
 export(check_device)
+export(class_ggplot)
+export(class_ggplot_built)
 export(class_mapping)
 export(combine_vars)
 export(complete_theme)

R/all-classes.R

@@ -7,6 +7,5 @@ class_facet  <- S7::new_S3_class("Facet")
 class_layer  <- S7::new_S3_class("Layer")
 class_layout <- S7::new_S3_class("Layout")
 class_scales_list <- S7::new_S3_class("ScalesList")
-class_layout <- S7::new_S3_class("Layout")
 class_ggproto <- S7::new_S3_class("ggproto")
 class_gtable <- S7::new_S3_class("gtable")

R/plot-build.R

@@ -1,12 +1,37 @@
 #' @include plot.R
+NULL
 
+#' The ggplot built class
+#'
+#' The ggplot built class is an intermediate class and represents a processed
+#' ggplot object ready for rendering. It is constructed by calling
+#' [`ggplot_build()`] on a [ggplot][class_ggplot] object and is not meant to be
+#' instantiated directly. The class can be rendered to a gtable object by
+#' calling the [`ggplot_gtable()`] function on a ggplot built class object.
+#'
+#' @param data A list of plain data frames; one for each layer.
+#' @param layout A Layout ggproto object.
+#' @param plot A completed ggplot class object.
+#'
+#' @export
 class_ggplot_built <- S7::new_class(
   "ggplot_built",
   properties = list(
-    data = S7::class_list,
+    data   = S7::class_list,
     layout = class_layout,
-    plot = class_ggplot
-  )
+    plot   = class_ggplot
+  ),
+  constructor = function(data = NULL, layout = NULL, plot = NULL) {
+    if (is.null(data) || is.null(layout) || is.null(plot)) {
+      cli::cli_abort(
+        "The {.cls ggplot_built} class should be constructed by {.fn ggplot_build}."
+      )
+    }
+    S7::new_object(
+      S7::S7_object(),
+      data = data, layout = layout, plot = plot
+    )
+  }
 )
 
 #' Build ggplot for rendering.
@@ -34,21 +59,19 @@ class_ggplot_built <- S7::new_class(
 #' The `r link_book("build step section", "internals#sec-ggplotbuild")`
 #' @keywords internal
 #' @export
-ggplot_build <- function(plot) {
+ggplot_build <- S7::new_generic("ggplot_build", "plot", fun = function(plot) {
   # Attaching the plot env to be fetched by deprecations etc.
-  attach_plot_env(plot$plot_env)
+  if (S7::S7_inherits(plot) && S7::prop_exists(plot, "plot_env")) {
+    attach_plot_env(plot@plot_env)
+  }
+  S7::S7_dispatch()
+})
 
-  UseMethod('ggplot_build')
+S7::method(ggplot_build, class_ggplot_built) <- function(plot) {
+  plot # This is a no-op
 }
 
-#' @export
-ggplot_build.ggplot_built <- function(plot) {
-  # This is a no-op
-  plot
-}
-
-#' @export
-ggplot_build.ggplot <- function(plot) {
+S7::method(ggplot_build, class_ggplot) <- function(plot) {
   plot <- plot_clone(plot)
   if (length(plot@layers) == 0) {
     plot <- plot + geom_blank()
@@ -202,15 +225,12 @@ layer_grob <- get_layer_grob
 #' @keywords internal
 #' @param data plot data generated by [ggplot_build()]
 #' @export
-ggplot_gtable <- function(data) {
-  # Attaching the plot env to be fetched by deprecations etc.
-  attach_plot_env(data$plot@plot_env)
-
-  UseMethod('ggplot_gtable')
-}
+ggplot_gtable <- S7::new_generic("ggplot_gtable", "data", function(data) {
+  attach_plot_env(data@plot@plot_env)
+  S7::S7_dispatch()
+})
 
-#' @export
-ggplot_gtable.ggplot_built <- function(data) {
+S7::method(ggplot_gtable, class_ggplot_built) <- function(data) {
   plot <- data@plot
   layout <- data@layout
   data <- data@data

R/plot.R

@@ -1,6 +1,27 @@
 #' @include all-classes.R
 #' @include theme.R
+NULL
 
+#' The ggplot class
+#'
+#' The ggplot class collects the needed information to render a plot.
+#' This class can be constructed using the [`ggplot()`] function.
+#'
+#' @param data A property containing any data coerced by [`fortify()`].
+#' @param layers A list of layer instances created by [`layer()`].
+#' @param scales A ScalesList ggproto object.
+#' @param guides A Guides ggproto object created by [`guides()`].
+#' @param mapping A mapping class object created by [`aes()`].
+#' @param theme A theme class object created by [`theme()`].
+#' @param coordinates A Coord ggproto object created by `coord_*()` family of
+#'   functions.
+#' @param facet A Facet ggproto object created by `facet_*()` family of
+#'   functions.
+#' @param layout A Layout ggproto object.
+#' @param labels A labels object created by [`labs()`].
+#' @param plot_env An environment.
+#'
+#' @export
 class_ggplot <- S7::new_class(
   name = "ggplot", parent = class_gg,
   properties = list(
@@ -15,7 +36,23 @@ class_ggplot <- S7::new_class(
     layout  = class_layout,
     labels  = labs,
     plot_env = S7::class_environment
-  )
+  ),
+  constructor = function(data = waiver(), layers = list(), scales = NULL,
+                         guides = NULL, mapping = aes(), theme = NULL,
+                         coordinates = coord_cartesian(default = TRUE),
+                         facet = facet_null(), layout = NULL,
+                         labels = labs(), plot_env = parent.frame()) {
+    S7::new_object(
+      S7::S7_object(),
+      data = data, layers = layers,
+      scales = scales %||% scales_list(),
+      guides = guides %||% guides_list(),
+      mapping = mapping, theme = theme %||% theme(),
+      coordinates = coordinates, facet = facet,
+      layout = layout %||% ggproto(NULL, Layout),
+      labels = labels, plot_env = plot_env
+    )
+  }
 )
 
 #' Create a new ggplot
@@ -123,51 +160,48 @@ class_ggplot <- S7::new_class(
 #'     mapping = aes(x = group, y = group_mean), data = group_means_df,
 #'     colour = 'red', size = 3
 #'   )
-ggplot <- function(data = NULL, mapping = aes(), ...,
-                   environment = parent.frame()) {
-  UseMethod("ggplot")
-}
+ggplot <- S7::new_generic(
+  "ggplot2", "data",
+  fun = function(data, mapping = aes(), ..., environment = parent.frame()) {
+    S7::S7_dispatch()
+  }
+)
 
-#' @export
-ggplot.default <- function(data = NULL, mapping = aes(), ...,
-                           environment = parent.frame()) {
+S7::method(ggplot, S7::class_any) <- function(
+    data, mapping = aes(), ...,
+    environment = parent.frame()) {
   if (!missing(mapping) && !is.mapping(mapping)) {
     cli::cli_abort(c(
       "{.arg mapping} must be created with {.fn aes}.",
       "x" = "You've supplied {.obj_type_friendly {mapping}}."
     ))
   }
+  if (missing(data)) {
+    data <- NULL
+  }
 
   data <- fortify(data, ...)
 
   p <- class_ggplot(
     data = data,
-    layers = list(),
-    scales = scales_list(),
-    guides = guides_list(),
     mapping = mapping,
-    theme = theme(),
-    coordinates = coord_cartesian(default = TRUE),
-    facet = facet_null(),
-    plot_env = environment,
-    layout = ggproto(NULL, Layout),
-    labels = labs()
+    plot_env = environment
   )
   class(p) <- union("ggplot", class(p))
 
   set_last_plot(p)
   p
 }
 
-#' @export
-ggplot.function <- function(data = NULL, mapping = aes(), ...,
-                            environment = parent.frame()) {
-  # Added to avoid functions end in ggplot.default
-  cli::cli_abort(c(
-    "{.arg data} cannot be a function.",
-    "i" = "Have you misspelled the {.arg data} argument in {.fn ggplot}"
-  ))
-}
+S7::method(ggplot, S7::class_function) <-
+  function(data, mapping = aes(), ...,
+           environment = parent.frame()) {
+    # Added to avoid functions end in ggplot.default
+    cli::cli_abort(c(
+      "{.arg data} cannot be a function.",
+      "i" = "Have you misspelled the {.arg data} argument in {.fn ggplot}"
+    ))
+  }
 
 #' Reports whether x is a type of object
 #' @param x An object to test

man/class_ggplot.Rd

@@ -12,6 +12,9 @@
       $calc_element
       [1] "skip_blank"
       
+      $class_ggplot
+      [1] "plot_env"
+      
       $continuous_scale
       [1] "scale_name"   "minor_breaks"