add infrastructure for plot recipes

NAMESPACE

@@ -16,6 +16,7 @@ S3method(decodeplot,gg)
 S3method(decodeplot,grob)
 S3method(decodeplot,gtable)
 S3method(decodeplot,jaspGraphsPlot)
+S3method(decodeplot,jaspPlotRecipe)
 S3method(decodeplot,patchwork)
 S3method(decodeplot,qgraph)
 S3method(decodeplot,recordedplot)

R/common.R

@@ -1105,8 +1105,18 @@ editImage <- function(name, optionsJson) {
         jaspPlotCPP$resizedByUser <- TRUE
       }
 
-    } else if (type == "interactive") {
+    } else if (type == "interactive" && jaspGraphs::isJaspPlotRecipe(plot)) {
 
+      newOpts <- optionsList[["editOptions"]]
+      oldOpts       <- jaspGraphs::plotEditingOptions(plot)
+      newOpts$xAxis <- list(type = oldOpts$xAxis$type, settings = newOpts$xAxis$settings[names(newOpts$xAxis$settings) != "type"])
+      newOpts$yAxis <- list(type = oldOpts$yAxis$type, settings = newOpts$yAxis$settings[names(newOpts$yAxis$settings) != "type"])
+      newPlot <- jaspGraphs::plotEditing(plot, newOpts)
+      # plot editing did nothing or was canceled
+      if (!identical(plot, newPlot))
+        jaspPlotCPP$plotObject <- newPlot
+
+    } else if (type == "interactive" && ggplot2::is.ggplot(plot)) {
 
       # copy plot and check if we edit it
       if (ggplot2::is_ggplot(plot)) {
@@ -1200,6 +1210,3 @@ runWrappedAnalysis <- function(moduleName, analysisName, qmlFileName, options, v
      return(runJaspResults(name=internalAnalysisName, title=analysisName, dataKey="{}", options=options, stateKey="{}", functionCall=internalAnalysisName, preloadData=preloadData))
   }
 }
-
-
-

R/writeImage.R

@@ -47,7 +47,7 @@ writeImageJaspResults <- function(plot, width = 320, height = 320, obj = TRUE, r
   setwd(root)
   on.exit(setwd(oldwd))
 
-  if (length(oldPlotInfo) != 0L && !is.null(oldPlotInfo[["editOptions"]]) && ggplot2::is.ggplot(plot)) {
+  if (length(oldPlotInfo) != 0L && !is.null(oldPlotInfo[["editOptions"]]) && (ggplot2::is.ggplot(plot) || jaspGraphs::isJaspPlotRecipe(plot))) {
 
     # uncommenting this applies the edits previously done with plot editing to an older figure to the new figure.
     # see https://github.com/jasp-stats/INTERNAL-jasp/issues/1257 for discussion on what needs to be done before we can do this.
@@ -79,7 +79,12 @@ writeImageJaspResults <- function(plot, width = 320, height = 320, obj = TRUE, r
   width  <- width  * (ppi / 96)
   height <- height * (ppi / 96)
 
-  plot2draw <- decodeplot(plot)
+  plotForOutput <- if (jaspGraphs::isJaspPlotRecipe(plot)) {
+    .materializeDecodedJaspPlotRecipe(plot)
+  } else {
+    plot
+  }
+  plot2draw <- decodeplot(plotForOutput)
 
   openGrDevice(file = relativePathpng, width = width, height = height, res = 72 * (ppi / 96), background = backgroundColor)#, dpi = ppi)
   on.exit(grDevices::dev.off(), add = TRUE)
@@ -120,13 +125,13 @@ writeImageJaspResults <- function(plot, width = 320, height = 320, obj = TRUE, r
     image[["obj"]]         <- plot2draw
   }
 
-  image[["editOptions"]] <- jaspGraphs::plotEditingOptions(plot, asJSON = TRUE)
+  image[["editOptions"]] <- jaspGraphs::plotEditingOptions(plotForOutput, asJSON = TRUE)
 
-  image[["interactive"]] <- ggplot2::is.ggplot(plot) || inherits(plot, "jaspMatrixPlot")
-  if (image[["interactive"]] )
+  image[["interactive"]] <- ggplot2::is.ggplot(plot) || jaspGraphs::isJaspPlotRecipe(plot) || inherits(plot, "jaspMatrixPlot")
+  if (image[["interactive"]])
     tryCatch(
     {
-      jsonOrTryError <- jaspGraphs::convertGgplotToPlotly(plot)
+      jsonOrTryError <- jaspGraphs::convertGgplotToPlotly(plotForOutput)
 
       if (exists(".fromRCPP")) {
         if (isTryError(jsonOrTryError)) {
@@ -157,7 +162,7 @@ writeImageJaspResults <- function(plot, width = 320, height = 320, obj = TRUE, r
     error	= function(e) {
       image[["interactiveConvertError"]]  <- e
     })
-  
+
   return(image)
 }
 
@@ -176,6 +181,42 @@ decodeplot.jaspGraphsPlot <- function(x, ...) {
 }
 
 
+#' @export
+decodeplot.jaspPlotRecipe <- function(x, ...) {
+  decodeplot(.materializeDecodedJaspPlotRecipe(x), ...)
+}
+
+.materializeDecodedJaspPlotRecipe <- function(recipe) {
+  recipe[["args"]] <- .decodeJaspPlotRecipeArguments(recipe[["args"]], decodeNames = FALSE)
+  jaspGraphs::materializeJaspPlotRecipe(recipe)
+}
+
+.decodeJaspPlotRecipeArguments <- function(x, decodeNames = TRUE) {
+  if (is.environment(x))
+    stop("Plot recipe arguments cannot contain environments.", domain = NA)
+
+  if (is.factor(x)) {
+    levels(x) <- decodeColNames(levels(x))
+  } else if (is.character(x)) {
+    x <- decodeColNames(x)
+  } else if (is.data.frame(x)) {
+    x[] <- lapply(x, .decodeJaspPlotRecipeArguments)
+    names(x) <- decodeColNames(names(x))
+    if (is.character(attr(x, "row.names")))
+      row.names(x) <- decodeColNames(row.names(x))
+  } else if (is.list(x)) {
+    x[] <- lapply(x, .decodeJaspPlotRecipeArguments)
+  }
+
+  if (is.array(x) && !is.null(dimnames(x)))
+    dimnames(x) <- lapply(dimnames(x), decodeColNames)
+
+  if (decodeNames && !is.null(names(x)))
+    names(x) <- decodeColNames(names(x))
+
+  x
+}
+
 #' @export
 decodeplot.gg <- function(x, returnGrob = TRUE, ...) {
   # TODO: do not return a grid object!

tests/testthat/test-plotRecipe.R

@@ -0,0 +1,34 @@
+test_that("plot recipe arguments are decoded recursively", {
+  oldDecoder <- get0(".decodeColNamesLax", envir = .GlobalEnv, inherits = FALSE)
+  assign(".decodeColNamesLax", function(x) sub("^encoded_", "", x), envir = .GlobalEnv)
+  on.exit({
+    if (is.null(oldDecoder))
+      rm(".decodeColNamesLax", envir = .GlobalEnv)
+    else
+      assign(".decodeColNamesLax", oldDecoder, envir = .GlobalEnv)
+  })
+
+  args <- list(
+    data = data.frame(
+      encoded_column = factor(c("encoded_a", "encoded_b")),
+      label = c("encoded_label", "encoded_other")
+    ),
+    nested = list(encoded_name = "encoded_value")
+  )
+
+  decoded <- jaspBase:::.decodeJaspPlotRecipeArguments(args, decodeNames = FALSE)
+
+  expect_named(decoded, c("data", "nested"))
+  expect_named(decoded$data, c("column", "label"))
+  expect_equal(levels(decoded$data$column), c("a", "b"))
+  expect_equal(decoded$data$label, c("label", "other"))
+  expect_named(decoded$nested, "name")
+  expect_equal(decoded$nested$name, "value")
+})
+
+test_that("plot recipe arguments reject environments", {
+  expect_error(
+    jaspBase:::.decodeJaspPlotRecipeArguments(list(data = new.env())),
+    "cannot contain environments"
+  )
+})