add infrastructure for plot recipes

NAMESPACE

@@ -15,6 +15,7 @@ S3method(getPlotEditingOptions,gg)
 S3method(getPlotEditingOptions,ggplot)
 S3method(getPlotEditingOptions,ggplot_built)
 S3method(getPlotEditingOptions,jaspGraphsPlot)
+S3method(getPlotEditingOptions,jaspPlotRecipe)
 S3method(getPlotEditingOptions,qgraph)
 S3method(getPrettyAxisBreaks,character)
 S3method(getPrettyAxisBreaks,default)
@@ -48,6 +49,7 @@ export(PlotPriorAndPosterior)
 export(PlotRobustnessSequential)
 export(axesLabeller)
 export(convertGgplotToPlotly)
+export(createJaspPlotRecipe)
 export(descriptivesPlot)
 export(drawAxis)
 export(drawBFpizza)
@@ -69,9 +71,11 @@ export(ggMatrixPlot)
 export(graphOptions)
 export(hypothesis2BFtxt)
 export(is.jaspGraphsPlot)
+export(isJaspPlotRecipe)
 export(jaspHistogram)
 export(jaspHistogramBinWidth)
 export(makeAlignedMatrixPlot)
+export(materializeJaspPlotRecipe)
 export(needsParsing)
 export(parseThis)
 export(plotEditing)
@@ -85,6 +89,7 @@ export(scale_JASPfill_discrete)
 export(scale_x_continuous)
 export(scale_y_continuous)
 export(setGraphOption)
+export(setJaspPlotRecipeEditOptions)
 export(themeApaRaw)
 export(themeJasp)
 export(themeJaspRaw)

R/convertGgplotToPlotly.R

@@ -49,6 +49,9 @@ convertGgplotToPlotly <- function(ggplotObj, returnJSON = TRUE) {
 }
 
 convertPlotObjectToPlotly <- function(plotObj) {
+  if (isJaspPlotRecipe(plotObj))
+    plotObj <- materializeJaspPlotRecipe(plotObj)
+
   if (inherits(plotObj, "jaspMatrixPlot"))
     return(convertJaspMatrixPlotToPlotly(plotObj))
 

R/plotEditing.R

@@ -70,6 +70,16 @@ optionsDiff <- function(new, old) {
 #' @export
 plotEditing <- function(graph, newOptions) {
 
+  if (isJaspPlotRecipe(graph)) {
+    if (isTRUE(newOptions[["resetPlot"]]))
+      return(setJaspPlotRecipeEditOptions(graph, newOptions))
+
+    # Validate against the materialized plot, but keep the serialized state as
+    # a recipe plus edit options rather than storing the edited ggplot object.
+    plotEditing(materializeJaspPlotRecipe(graph, applyEdits = FALSE), newOptions)
+    return(setJaspPlotRecipeEditOptions(graph, newOptions))
+  }
+
   if (!is_ggplot(graph))
     stop2("graph should be a ggplot2")
 

R/plotEditingOptions.R

@@ -27,6 +27,14 @@ getPlotEditingOptions <- function(graph) {
   UseMethod("getPlotEditingOptions", graph)
 }
 
+#' @exportS3Method
+getPlotEditingOptions.jaspPlotRecipe <- function(graph) {
+  if (!is.null(graph[["editOptions"]]))
+    return(graph[["editOptions"]])
+
+  getPlotEditingOptions(materializeJaspPlotRecipe(graph, applyEdits = FALSE))
+}
+
 #' @exportS3Method
 getPlotEditingOptions.gg <- function(graph) {
   # ensures    that loading an edited graph returns the final set of options

R/plotRecipe.R

@@ -0,0 +1,110 @@
+#' @title Create a serializable plot recipe
+#' @param fun Function reference. Prefer a string such as
+#'   \code{"pkg:::functionName"} or \code{"pkg::functionName"} so the closure
+#'   environment is not serialized with the recipe.
+#' @param args Named list of arguments passed to \code{fun}.
+#' @param editOptions Optional plot editing options to apply after materializing.
+#' @export
+createJaspPlotRecipe <- function(fun, args = list(), editOptions = NULL) {
+  if (!is.character(fun) || length(fun) != 1L || !nzchar(fun))
+    stop("`fun` must be a single non-empty function reference string.", domain = NA)
+
+  if (!is.list(args))
+    stop("`args` must be a list.", domain = NA)
+  assertJaspPlotRecipeValue(args)
+  editOptions <- normalizeJaspPlotRecipeEditOptions(editOptions)
+  assertJaspPlotRecipeValue(editOptions)
+
+  structure(
+    list(
+      fun         = fun,
+      args        = args,
+      editOptions = editOptions
+    ),
+    class = "jaspPlotRecipe"
+  )
+}
+
+#' @export
+isJaspPlotRecipe <- function(x) {
+  inherits(x, "jaspPlotRecipe")
+}
+
+assertJaspPlotRecipeValue <- function(x) {
+  if (is.environment(x) || is.function(x))
+    stop("Plot recipe arguments cannot contain environments or functions.", domain = NA)
+
+  if (is.list(x))
+    lapply(x, assertJaspPlotRecipeValue)
+
+  attrs <- attributes(x)
+  if (length(attrs) > 0L)
+    lapply(attrs, assertJaspPlotRecipeValue)
+
+  invisible(NULL)
+}
+
+resolveJaspPlotRecipeFunction <- function(fun) {
+  if (is.function(fun))
+    return(fun)
+
+  if (!is.character(fun) || length(fun) != 1L || !nzchar(fun))
+    stop("Invalid plot recipe function reference.", domain = NA)
+
+  parts <- strsplit(fun, ":::", fixed = TRUE)[[1L]]
+  if (length(parts) == 2L)
+    return(utils::getFromNamespace(parts[[2L]], parts[[1L]]))
+
+  parts <- strsplit(fun, "::", fixed = TRUE)[[1L]]
+  if (length(parts) == 2L) {
+    if (!requireNamespace(parts[[1L]], quietly = TRUE))
+      stop(sprintf("Could not load namespace '%s' for plot recipe.", parts[[1L]]), domain = NA)
+    return(getExportedValue(parts[[1L]], parts[[2L]]))
+  }
+
+  obj <- get(fun, mode = "function", inherits = TRUE)
+  if (!is.function(obj))
+    stop(sprintf("Plot recipe reference '%s' did not resolve to a function.", fun), domain = NA)
+
+  obj
+}
+
+#' @export
+materializeJaspPlotRecipe <- function(recipe, applyEdits = TRUE) {
+  if (!isJaspPlotRecipe(recipe))
+    return(recipe)
+
+  assertJaspPlotRecipeValue(recipe[["args"]])
+  fun  <- resolveJaspPlotRecipeFunction(recipe[["fun"]])
+  plot <- do.call(fun, recipe[["args"]])
+
+  if (applyEdits && !is.null(recipe[["editOptions"]]))
+    plot <- plotEditing(plot, recipe[["editOptions"]])
+
+  plot
+}
+
+normalizeJaspPlotRecipeEditOptions <- function(editOptions) {
+  if (is.null(editOptions))
+    return(NULL)
+
+  if (!is.list(editOptions))
+    stop("`editOptions` must be a list or NULL.", domain = NA)
+
+  if (isTRUE(editOptions[["resetPlot"]]))
+    return(NULL)
+
+  editOptions[["resetPlot"]] <- FALSE
+  editOptions
+}
+
+#' @export
+setJaspPlotRecipeEditOptions <- function(recipe, editOptions) {
+  if (!isJaspPlotRecipe(recipe))
+    stop("`recipe` is not a jaspPlotRecipe.", domain = NA)
+
+  editOptions <- normalizeJaspPlotRecipeEditOptions(editOptions)
+  assertJaspPlotRecipeValue(editOptions)
+  recipe[["editOptions"]] <- editOptions
+  recipe
+}

tests/testthat/test-plotRecipe.R

@@ -0,0 +1,38 @@
+test_that("plot recipes materialize without retaining a ggplot", {
+  recipe <- createJaspPlotRecipe(
+    "jaspGraphs::plotQQnorm",
+    list(residuals = stats::rnorm(20))
+  )
+
+  expect_true(isJaspPlotRecipe(recipe))
+  expect_false(ggplot2::is_ggplot(recipe))
+  expect_true(ggplot2::is_ggplot(materializeJaspPlotRecipe(recipe)))
+})
+
+test_that("plot recipes reject environment-bearing arguments", {
+  expect_error(
+    createJaspPlotRecipe("ggplot2::ggplot", list(data = new.env())),
+    "cannot contain environments or functions"
+  )
+  expect_error(
+    createJaspPlotRecipe("ggplot2::ggplot", list(mapping = y ~ x)),
+    "cannot contain environments or functions"
+  )
+})
+
+test_that("plot recipe edit options can be stored and reset", {
+  recipe <- createJaspPlotRecipe(
+    "jaspGraphs::plotQQnorm",
+    list(residuals = stats::rnorm(20))
+  )
+  options <- plotEditingOptions(recipe)
+  options$xAxis$settings$title <- "Edited x"
+
+  edited <- plotEditing(recipe, options)
+  expect_false(edited$editOptions$resetPlot)
+  expect_identical(edited$editOptions[names(options)], options)
+  expect_true(ggplot2::is_ggplot(materializeJaspPlotRecipe(edited)))
+
+  reset <- plotEditing(edited, list(resetPlot = TRUE))
+  expect_null(reset$editOptions)
+})