ggplot2 compatibility cleanup (#29)

* leverage ggplot2::ggplot_add for more responsible composition

DESCRIPTION

@@ -1,11 +1,11 @@
 Package: ggpackets
 Title: Package Plot Layers for Easier Portability and Modularization
-Version: 0.2.1.9000
-Authors@R: 
-    person("Doug", "Kelkhoff", 
-        email = "[email protected]", 
+Version: 0.2.1
+Authors@R:
+    person("Doug", "Kelkhoff",
+        email = "[email protected]",
         role = c("aut", "cre"))
-Description: 
+Description:
     Create groups of 'ggplot2' layers that can be easily migrated from one plot
     to another, reducing redundant code and improving the ability to format many
     plots that draw from the same source 'ggpacket' layers.
@@ -15,9 +15,7 @@ Depends:
 Imports:
     utils,
     methods,
-    tibble,
-    rlang,
-    crayon
+    rlang
 Suggests:
     testthat,
     dplyr,
@@ -28,8 +26,9 @@ Suggests:
     covr
 LazyData: true
 License: MIT + file LICENSE
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.1
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr
-URL: https://dgkf.github.io/ggpackets/ 
+URL: https://github.com/dgkf/ggpackets, https://dgkf.github.io/ggpackets/
+BugReports: https://github.com/dgkf/ggpackets/issues

NAMESPACE

@@ -1,13 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method("+",gg)
 S3method(format,ggpacket)
+S3method(ggplot_add,ggpacket)
 S3method(print,ggpacket)
 export("%+%")
 export(ggpacket)
-importFrom(crayon,red)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggplot_add)
 importFrom(ggplot2,ggplot_build)
 importFrom(ggplot2,standardise_aes_names)
 importFrom(ggplot2,waiver)

NEWS.md

@@ -1,6 +1,10 @@
-# ggpackets (dev)
+# ggpackets v0.2.1
 
+* handle `+.gg` using recommended `ggplot2::ggplot_add` instead of intercepting
+  calls (#24, @dgkf)
 
+* remove `crayon` package dependency, only used for console output of missing
+  aesthetics
 
 # ggpackets v0.2.0
 

R/ggcall.R

@@ -1,12 +1,14 @@
 #' Convert an expression into a call as a list of quosure components
-#' 
+#'
 #' @param x An expression to convert to a ggcall.
 #' @param which The relative frame offset in which the expression should be
 #' eventually evaluated.
 #'
 #' @importFrom rlang quos enquo quo_get_expr quo_set_env
 #' @importFrom ggplot2 standardise_aes_names
 #'
+#' @keywords internal
+#'
 as_gg_call <- function(x, which = -3L) {
   xexpr <- eval(bquote(
     substitute(.(substitute(x)))),
@@ -20,7 +22,7 @@ as_gg_call <- function(x, which = -3L) {
     if (".id" %in% names(xcall)[-1]) {
       xids <- rlang::eval_tidy(xcall[[".id"]])
       xcall <- xcall[c(1, 1 + which(names(xcall[-1]) != ".id"))]
-    } 
+    }
     xcallname <- infer_ggcall_name(rlang::quo_get_expr(xcall[[1]]))
   } else {
     xcall <- rlang::quo_set_env(rlang::enquo(xexpr), parent.frame(-which - 1L))
@@ -39,11 +41,13 @@ as_gg_call <- function(x, which = -3L) {
 
 
 #' Label ggcall with function name if it can be deduced
-#' 
+#'
 #' @param expr An expression from which a call name should be inferred.
-#' 
+#'
+#' @keywords internal
+#'
 infer_ggcall_name <- function(expr) {
-  # TODO: prohibit names ambiguous with gg args with dots 
+  # TODO: prohibit names ambiguous with gg args with dots
   #       (inherit.aes, na.rm, show.legend, fun.data, label.r)
   if (is.name(expr) && grepl("\\w", expr)) as.character(expr)
   else "layer"
@@ -52,10 +56,11 @@ infer_ggcall_name <- function(expr) {
 
 
 #' Convert ggplot geom layers to friendly names
-#' 
+#'
 #' @param x A function name from which an id should be inferred.
-#' 
+#'
+#' @keywords internal
+#'
 infer_ggcall_id <- function(x) {
   gsub("^(geom|stat)_", "", x)
 }
-

R/ggpacket.R

@@ -403,7 +403,7 @@ required_aesthetics.LayerInstance <- function(x) {
 }
 
 required_aesthetics.quosures <- function(x) {
-  aess <- .all_aesthetics
+  aess <- .all_aesthetics()
   names(aess) <- paste0("..", aess, "..")
 
   layer <- tryCatch(rlang::eval_tidy(x[[1]]), error = function(e) NULL)

R/ggpacket_index.R

@@ -11,4 +11,3 @@ subset_ggpacket.character <- function(x, i, ...) {
   xs <- vapply(x@ggcalls, function(xi) any(i %in% attr(xi, "ids")), logical(1L))
   x[xs, ...]
 }
-

R/ggpacket_show.R

@@ -131,12 +131,11 @@ format_ggpacket_mapping.NULL <- function(x,
 }
 
 #' @importFrom utils capture.output
-#' @importFrom crayon red
 format_ggpacket_mapping.default <- function(x,
     width = getOption("width", 80) * 0.9, missing_aes = character(0L)) {
 
   x[missing_aes] <- " MISSING "
-  gsub("\" MISSING \"", crayon::red("<missing>"), utils::capture.output(x)[-1])
+  gsub("\" MISSING \"", "<missing>", utils::capture.output(x)[-1])
 }
 
 format_ggpacket_ggcalls <- function(x,

R/ggpackets.R

@@ -4,6 +4,7 @@
 #' plots that draw from the same source ggpacket layers.
 #'
 #' @examples
+#' library(ggplot2)
 #'
 #' # Prep a tidy data.frame to plot with
 #' airquality_long <- rbind(

R/ggplot2_ext.R

@@ -1,36 +1,11 @@
-#' ggplot2 internal gg addition method
-#'
-#' @param e1 Addition lhs
-#' @param e2 Addition rhs
-#'
-.plus_gg <- getNamespace("ggplot2")[["+.gg"]]
-
-
-#' Intercept ggplot2 ggproto plus operator
-#'
-#' @param e1 An object to add to a ggproto object.
-#' @param e2 A ggproto object to add.
-#'
-#' @return A \code{ggplot2} object or \code{ggpacket}, dependent on whether
-#'   \code{e1} is a materialized \code{ggproto} object or a \code{ggpacket}.
-#'
-#' @importFrom methods new
+#' @importFrom ggplot2 ggplot_add
 #' @export
-"+.gg" <- function(e1, e2) {
-  if (inherits(e2, "ggpacket"))
-    return(gg_plus_ggpacket(e1, e2))
-
-  if (!inherits(e1, "ggproto"))
-   return(.plus_gg(e1, e2))
-
-  methods::new(
-    "ggpacket",
-    ggpacket_call,
-    ggcalls = list(as_gg_call(e1), as_gg_call(e2))
-  )
+ggplot_add.ggpacket <- function(object, plot, object_name) {
+  gg_plus_ggpacket(plot, object)
 }
 
 
+
 #' Lazy handler for ggplot addition
 #'
 #' @param e1 Addition lhs.

R/utils_aesthetics.R

@@ -1,7 +1,8 @@
 #' Extracted .all_aesthetics from internal ggplot2 with hardcoded fallback
-.all_aesthetics <- tryCatch({
+.all_aesthetics <- function() {
+  tryCatch({
     # attempt to stay current with ggplot .all_aesthetics upstream
-    get('.all_aesthetics', asNamespace('ggplot2'), inherits = FALSE)
+    get(".all_aesthetics", asNamespace("ggplot2"), inherits = FALSE)
   }, error = function(e) {
     # hard coded fallback in case upstream changes private variable name
     # #est for fallback viability included in testthat tests
@@ -11,6 +12,7 @@
       "upper", "vjust", "weight", "width", "x", "xend", "xmax", "xmin",
       "xintercept", "y", "yend", "ymax", "ymin", "yintercept", "z")
   })
+}
 
 
 
@@ -33,7 +35,7 @@ handle_reset_mapping <- function(mapping) {
 #' @param envir An environment in which the dot aesthetics should be evaluated.
 #'
 substitute_ggcall_dot_aes <- function(mapping, ggcall, envir = parent.frame()) {
-  aess <- .all_aesthetics
+  aess <- .all_aesthetics()
   names(aess) <- ggplot2::standardise_aes_names(aess)
 
   # add in mappings for alternative naming conventions before substitution
@@ -74,4 +76,3 @@ substitute_quote.quosure <- function(q, env = parent.frame()) {
   # TODO: handle mixed quosure environments instead of retaining original
   rlang::quo_set_expr(q, do.call(substitute, list(rlang::quo_squash(q), env)))
 }
-

R/zzz.R

@@ -1,9 +1,9 @@
 .onLoad <- function(libname, pkgname) {
   # Some current base functions are used which are not included in older
-  # versions of R. These are provided through an 'Enhances' pacakge,
-  # "backports" but this dependency is unnecessary otherwise. 
-  if (package_version(R.Version()) < package_version("3.5") && 
+  # versions of R. These are provided through an 'Enhances' package,
+  # "backports" but this dependency is unnecessary otherwise.
+  if (package_version(R.Version()) < package_version("3.5") &&
       requireNamespace("backports")) {
     backports::import(pkgname, "isFALSE")
   }
-} 
+}

tests/testthat/test-ggpacket-show.R

@@ -62,15 +62,15 @@ test_that("ggpacket with a bound ggcall layer prints bound ggcall expression", {
 
 test_that("ggpacket lacking required aesthetics indicates aesthetic missing", {
   expect_match({
-    crayon::strip_style(paste(capture.output({
+    paste(capture.output({
       ggpacket() + geom_line()
-    }), collapse = "\n"))
+    }), collapse = "\n")
   }, c("`x` -> <missing>"))
 
   expect_match({
-    crayon::strip_style(paste(capture.output({
+    paste(capture.output({
       ggpacket() + geom_line()
-    }), collapse = "\n"))
+    }), collapse = "\n")
   }, c("`y` -> <missing>"))
 })
 
@@ -88,3 +88,10 @@ test_that("ggpacket including required aesthetics considers internal remappings"
     ))
   })
 })
+
+test_that("show(<ggpacket>) behaviors identical to print for command line output", {
+  expect_identical(
+    capture.output(show(ggpacket(aes(y = test)) + geom_line(aes(x = ..y..)))),
+    capture.output(print(ggpacket(aes(y = test)) + geom_line(aes(x = ..y..))))
+  )
+})