From f756c4f3134746acb6a277e680b9b9d8035f1bde Mon Sep 17 00:00:00 2001 From: Don van den Bergh Date: Mon, 15 Jun 2026 00:27:43 +0200 Subject: [PATCH] add infrastructure for plot recipes --- NAMESPACE | 5 ++ R/convertGgplotToPlotly.R | 3 + R/plotEditing.R | 10 +++ R/plotEditingOptions.R | 8 +++ R/plotRecipe.R | 110 +++++++++++++++++++++++++++++++ man/createJaspPlotRecipe.Rd | 20 ++++++ tests/testthat/test-plotRecipe.R | 38 +++++++++++ 7 files changed, 194 insertions(+) create mode 100644 R/plotRecipe.R create mode 100644 man/createJaspPlotRecipe.Rd create mode 100644 tests/testthat/test-plotRecipe.R diff --git a/NAMESPACE b/NAMESPACE index 5ccc3e1c..4948e489 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/convertGgplotToPlotly.R b/R/convertGgplotToPlotly.R index fc565217..4f02a2db 100644 --- a/R/convertGgplotToPlotly.R +++ b/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)) diff --git a/R/plotEditing.R b/R/plotEditing.R index fce3af5e..98b84bcf 100644 --- a/R/plotEditing.R +++ b/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") diff --git a/R/plotEditingOptions.R b/R/plotEditingOptions.R index bfbe8bd8..96641731 100644 --- a/R/plotEditingOptions.R +++ b/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 diff --git a/R/plotRecipe.R b/R/plotRecipe.R new file mode 100644 index 00000000..f0767100 --- /dev/null +++ b/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 +} diff --git a/man/createJaspPlotRecipe.Rd b/man/createJaspPlotRecipe.Rd new file mode 100644 index 00000000..b808bae7 --- /dev/null +++ b/man/createJaspPlotRecipe.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotRecipe.R +\name{createJaspPlotRecipe} +\alias{createJaspPlotRecipe} +\title{Create a serializable plot recipe} +\usage{ +createJaspPlotRecipe(fun, args = list(), editOptions = NULL) +} +\arguments{ +\item{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.} + +\item{args}{Named list of arguments passed to \code{fun}.} + +\item{editOptions}{Optional plot editing options to apply after materializing.} +} +\description{ +Create a serializable plot recipe +} diff --git a/tests/testthat/test-plotRecipe.R b/tests/testthat/test-plotRecipe.R new file mode 100644 index 00000000..3836b891 --- /dev/null +++ b/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) +})