diff --git a/NAMESPACE b/NAMESPACE index 12d68ae5..dccb63e0 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/common.R b/R/common.R index dc056e9d..42cdaadc 100644 --- a/R/common.R +++ b/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)) } } - - - diff --git a/R/writeImage.R b/R/writeImage.R index 0d6360ad..876ac352 100755 --- a/R/writeImage.R +++ b/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! diff --git a/tests/testthat/test-plotRecipe.R b/tests/testthat/test-plotRecipe.R new file mode 100644 index 00000000..91e08df5 --- /dev/null +++ b/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" + ) +})