Allow addition of custom objects (#2309)

`add_to_ggplot()` generic for extending `+` to other classes

Author: thomasp85

NAMESPACE

@@ -37,6 +37,18 @@ S3method(fortify,summary.glht)
 S3method(fortify,tbl)
 S3method(ggplot,data.frame)
 S3method(ggplot,default)
+S3method(ggplot_add,"NULL")
+S3method(ggplot_add,Coord)
+S3method(ggplot_add,Facet)
+S3method(ggplot_add,Layer)
+S3method(ggplot_add,Scale)
+S3method(ggplot_add,data.frame)
+S3method(ggplot_add,default)
+S3method(ggplot_add,guides)
+S3method(ggplot_add,labels)
+S3method(ggplot_add,list)
+S3method(ggplot_add,theme)
+S3method(ggplot_add,uneval)
 S3method(grid.draw,absoluteGrob)
 S3method(grid.draw,ggplot)
 S3method(grobHeight,absoluteGrob)
@@ -314,6 +326,7 @@ export(geom_vline)
 export(gg_dep)
 export(ggplot)
 export(ggplotGrob)
+export(ggplot_add)
 export(ggplot_build)
 export(ggplot_gtable)
 export(ggproto)

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 2.2.1.9000
 
+* Custom objects can now be added using `+` if a `ggplot_add` method has been
+  defined for the class of the object (@thomasp85).
+  
 * Fix bug in secondary axis that would lead to incorrectly placed ticks with
   strong transforms (@thomasp85, #1992)
 

R/plot-construction.r

@@ -60,46 +60,92 @@ add_ggplot <- function(p, object, objectname) {
   if (is.null(object)) return(p)
 
   p <- plot_clone(p)
-  if (is.data.frame(object)) {
-    p$data <- object
-  } else if (is.theme(object)) {
-    p$theme <- update_theme(p$theme, object)
-  } else if (inherits(object, "Scale")) {
-    p$scales$add(object)
-  } else if (inherits(object, "labels")) {
-    p <- update_labels(p, object)
-  } else if (inherits(object, "guides")) {
-    p <- update_guides(p, object)
-  } else if (inherits(object, "uneval")) {
-      p$mapping <- defaults(object, p$mapping)
-      # defaults() doesn't copy class, so copy it.
-      class(p$mapping) <- class(object)
-
-      labels <- lapply(object, deparse)
-      names(labels) <- names(object)
-      p <- update_labels(p, labels)
-  } else if (is.Coord(object)) {
-      p$coordinates <- object
-      p
-  } else if (is.facet(object)) {
-      p$facet <- object
-      p
-  } else if (is.list(object)) {
-    for (o in object) {
-      p <- p %+% o
-    }
-  } else if (is.layer(object)) {
-    p$layers <- append(p$layers, object)
-
-    # Add any new labels
-    mapping <- make_labels(object$mapping)
-    default <- make_labels(object$stat$default_aes)
-    new_labels <- defaults(mapping, default)
-    p$labels <- defaults(p$labels, new_labels)
-  } else {
-    stop("Don't know how to add ", objectname, " to a plot",
-      call. = FALSE)
-  }
+  p <- ggplot_add(object, p, objectname)
   set_last_plot(p)
   p
 }
+#' Add custom objects to ggplot
+#'
+#' This generic allows you to add your own methods for adding custom objects to
+#' a ggplot with [+.gg].
+#'
+#' @param object An object to add to the plot
+#' @param plot The ggplot object to add `object` to
+#' @param object_name The name of the object to add
+#'
+#' @return A modified ggplot object
+#'
+#' @keywords internal
+#' @export
+ggplot_add <- function(object, plot, object_name) {
+  UseMethod("ggplot_add")
+}
+#' @export
+ggplot_add.default <- function(object, plot, object_name) {
+  stop("Don't know how to add ", object_name, " to a plot", call. = FALSE)
+}
+#' @export
+ggplot_add.NULL <- function(object, plot, object_name) {
+  plot
+}
+#' @export
+ggplot_add.data.frame <- function(object, plot, object_name) {
+  plot$data <- object
+  plot
+}
+#' @export
+ggplot_add.theme <- function(object, plot, object_name) {
+  plot$theme <- update_theme(plot$theme, object)
+  plot
+}
+#' @export
+ggplot_add.Scale <- function(object, plot, object_name) {
+  plot$scales$add(object)
+  plot
+}
+#' @export
+ggplot_add.labels <- function(object, plot, object_name) {
+  update_labels(plot, object)
+}
+#' @export
+ggplot_add.guides <- function(object, plot, object_name) {
+  update_guides(plot, object)
+}
+#' @export
+ggplot_add.uneval <- function(object, plot, object_name) {
+  plot$mapping <- defaults(object, plot$mapping)
+  # defaults() doesn't copy class, so copy it.
+  class(plot$mapping) <- class(object)
+
+  labels <- lapply(object, deparse)
+  names(labels) <- names(object)
+  update_labels(plot, labels)
+}
+#' @export
+ggplot_add.Coord <- function(object, plot, object_name) {
+  plot$coordinates <- object
+  plot
+}
+#' @export
+ggplot_add.Facet <- function(object, plot, object_name) {
+  plot$facet <- object
+  plot
+}
+#' @export
+ggplot_add.list <- function(object, plot, object_name) {
+  for (o in object) {
+    plot <- plot %+% o
+  }
+  plot
+}
+#' @export
+ggplot_add.Layer <- function(object, plot, object_name) {
+  plot$layers <- append(plot$layers, object)
+
+  # Add any new labels
+  mapping <- make_labels(object$mapping)
+  default <- make_labels(object$stat$default_aes)
+  new_labels <- defaults(mapping, default)
+  plot$labels <- defaults(plot$labels, new_labels)
+  plot
+}