more tests and add assignments

.gitignore

@@ -2,3 +2,4 @@
 .Rhistory
 .RData
 .Ruserdata
+Rplots.pdf

NAMESPACE

@@ -3,6 +3,7 @@
 S3method("+",gg)
 export(eval_ggcall)
 export(ggcall)
+export(ggcall_add_assignments)
 export(ggcall_env)
 export(ggplot)
 importFrom(ggplot2,ggplot)

NEWS.md

@@ -1,7 +1,9 @@
 # ggcall v0.1.0.9000
 
+* Added plot_call_with_assignments function, ggcall can be extended with connected variables assignments.
+* Edited README file with more clear examples.
 * Added pre-commit.
-* add coverage.
+* Added coverage.
 
 # ggcall v0.1.0
 

R/ggcall.R

@@ -83,9 +83,25 @@ ggplot <- function(...) {
 #' a list representing the history of the ggplot object.
 #'
 #' @examples
-#' p <- ggplot(mtcars, aes(x = wt, y = mpg)) +
-#'   geom_point()
-#' plot_call <- ggcall(p)
+#' # Example: Create a function which combines a few ggplot layers
+#' # Typically, it will be a function from your R package where you implemented ggcall
+#' func <- function(data, x, y, bool = TRUE) {
+#'   # layers have to be added with +
+#'   gg <- ggplot(data, aes(x=!!as.name(x), y=!!as.name(y))) +
+#'     geom_point(alpha = 0.4) +
+#'     facet_grid(~gear)
+#'
+#'   if (bool) {
+#'     gg <- gg + theme(axis.title.x = element_blank())
+#'   }
+#'
+#'   func_internal <- function(gg) {
+#'     gg + labs(x = "custom xlab")
+#'  }
+#'
+#'   func_internal(gg)
+#' }
+#' plot_call <- ggcall(func(mtcars, "wt", "mpg"))
 #' # Optionally: Style the code with styler
 #' styler::style_text(backports:::deparse1(plot_call))
 #'
@@ -100,6 +116,95 @@ ggcall <- function(plot) {
   res
 }
 
+#' Add Assignments to ggplot Construction Code
+#'
+#' This function modifies a `ggcall()` object by adding variable assignments
+#' to it, ensuring that any atomic variables or non-atomic objects referenced
+#' in the environment are explicitly assigned in the construction code.
+#'
+#' @param call A `ggcall_code` object, which represents a ggplot construction
+#'             call generated by the `ggcall()` function.
+#'
+#' @param vars a `character` value. Optional vector of variable names to include from ggcall environment.
+#' By default all environment variables connected with the call are added.
+#' Please be careful when updating this argument.
+#' @return A modified call with additional assignments for all the variables
+#'         used in the construction code, ensuring the plot can be fully
+#'         reconstructed from the code.
+#' @note Currently only atomic variables are supported to be assign directly.
+#' More complex variables are referenced to ggcall environment.
+#'
+#' @examples
+#' # Example: Create a function which combines a few ggplot layers
+#' # Typically, it will be a function from your R package where you implemented ggcall
+#' func <- function(data, x, y, bool = TRUE) {
+#'   # layers have to be added with +
+#'   gg <- ggplot(data, aes(x=!!as.name(x), y=!!as.name(y))) +
+#'     geom_point(alpha = 0.4) +
+#'     facet_grid(~gear)
+#'
+#'   if (bool) {
+#'     gg <- gg + theme(axis.title.x = element_blank())
+#'   }
+#'
+#'   func_internal <- function(gg) {
+#'     gg + labs(x = "custom xlab")
+#'  }
+#'
+#'   func_internal(gg)
+#' }
+#' plot_call <- ggcall(func(mtcars, "wt", "mpg"))
+#' # Optionally: Add assignments
+#' plot_call_with_assignments <- ggcall_add_assignments(plot_call)
+#' styler::style_text(
+#'   paste(deparse(plot_call_with_assignments), collapse = "\n")
+#' )
+#'
+#' eval_ggcall(plot_call_with_assignments)
+#'
+#' # Will Fail as data is needed and skipped
+#' # eval_ggcall(ggcall_add_assignments(plot_call, vars = c("x", "y")))
+#' @export
+ggcall_add_assignments <- function(call, vars = extract_names(call)) {
+  stopifnot(inherits(call, "ggcall_code"))
+  stopifnot(inherits(vars, "character"))
+
+  ggcall_name <- substitute(call)
+  env <- ggcall_env(call)
+  if (length(vars)) {
+    var_names <- intersect(vars, ls(env))
+  } else {
+    var_names <- ls(env)
+  }
+
+  new_env <- new.env(parent = parent.env(.GlobalEnv))
+  output <- list()
+  for (var in var_names) {
+    value <- get(var, envir = env)
+    new_env[[var]] <- value
+    if (is.atomic(value)) {
+      output <- c(var = substitute(lhs <- rhs, list(lhs = as.name(var), rhs = value)), output)
+    } else {
+      output <- c(
+        output,
+        sprintf("# %s is %s", var, paste(class(value), collapse = ", ")),
+        var = substitute(
+          lhs <- ggcall_env(name)[[lhs_string]],
+          list(lhs = as.name(var), lhs_string = var, name = as.name(ggcall_name))
+        )
+      )
+    }
+  }
+
+  new_env[[as.character(ggcall_name)]] <- call
+
+  structure(
+    as.call(c(as.name("{"), c(output, "# ggcall call", call))),
+    class = "ggcall_code",
+    ggcall_env = new_env
+  )
+}
+
 #' Evaluate ggcall
 #'
 #' This function evaluates an expression representing a ggplot construction code.
@@ -131,6 +236,7 @@ eval_ggcall <- function(call, ...) {
   for (nam in names(ellipsis)) {
     eval_env[[nam]] <- ellipsis[[nam]]
   }
+  if (is.null(eval_env[["..."]])) eval_env[["..."]] <- NULL
   eval(call, eval_env)
 }
 
@@ -151,9 +257,9 @@ eval_ggcall <- function(call, ...) {
 #' env[["data"]]
 #' as.list(env)
 #' @export
-ggcall_env <- function(code) {
-  stopifnot(inherits(code, "ggcall_code"))
-  attr(code, "ggcall_env")
+ggcall_env <- function(call) {
+  stopifnot(inherits(call, "ggcall_code"))
+  attr(call, "ggcall_env")
 }
 
 #' @keywords internal
@@ -175,3 +281,20 @@ merge_env <- function(to_env, from_env) {
 
   to_env
 }
+
+#' @keywords internal
+extract_names <- function(expr) {
+  if (is.symbol(expr)) {
+    return(as.character(expr))
+  }
+
+  if (is.call(expr)) {
+    func_name <- as.character(expr[[1]])
+    args <- as.list(expr)[-1]
+    arg_names <- unlist(lapply(args, extract_names))
+    return(unique(c(func_name, arg_names)))
+  }
+
+  return(character())
+}
+

README.md

@@ -27,7 +27,7 @@ library(ggcall)
 # Typically, it will be a function from your R package where you implemented ggcall
 func <- function(data, x, y, bool = TRUE) {
   # layers have to be added with +
-  gg <- ggplot(data, aes(x=!!as.name(x), y=!!as.name(y))) +
+  gg <- ggplot(data, aes(x = .data[[x]], y = .data[[y]])) +
     geom_point(alpha = 0.4) +
     facet_grid(~gear)
 
@@ -50,14 +50,25 @@ plot_call <- ggcall(gg_plot)
 plot_call
 
 # Optionally: Style the code with styler
+# install.packages("styler")
 styler::style_text(backports:::deparse1(plot_call))
 
-# Optional
+# Optionally: add assignments to call
+plot_call_with_assignments <- ggcall_add_assignments(plot_call)
+styler::style_text(
+  paste(deparse(plot_call_with_assignments), collapse = "\n")
+)
+
+# Optionally: access call environment
 # Access call environment and/or use it to evaluate the call
 plot_call_env <- ggcall_env(plot_call)
 as.list(plot_call_env)
+
+# Optionally: reevaulate the call
 # Reproduce the plot by evaluating the code
 eval_ggcall(plot_call)
+eval_ggcall(plot_call_with_assignments)
+
 # Optionally overwrite variables
 eval_ggcall(plot_call, mtcars = mtcars[1:10, ], x = "gear")
 ```
@@ -115,33 +126,86 @@ check out the inst/ggally.R for more details
 ```
 remotes::install_github("https://github.com/Polkas/ggally")
 library(GGally)
+
+###########################
+# Example for GGally ggcorr
+###########################
+
 data(mtcars)
-gg <- ggcorr(mtcars, method = "everything", label = TRUE)
+gg <- GGally::ggcorr(
+    mtcars,
+    name = expression(rho),
+    geom = "circle",
+    max_size = 10,
+    min_size = 2,
+    size = 3,
+    hjust = 0.75,
+    nbreaks = 6,
+    angle = -45,
+    palette = "PuOr",
+    legend.position = "top"
+) + 
+ggtitle("Correlation Matrix for mtcars Dataset")
+# gg is a ggplot object
+gg
+
+# Retrieve the plot construction code
 gg_call <- ggcall(gg)
 gg_call
+
 # Optionally: Style the code with styler
-# styler::style_text(deparse1(gg_call))
-# Optional
-# Access call environment and/or use it to evaluate the call
-# as.list(ggcall_env(gg_call))
-eval_ggcall(gg_call)
-#'
+styler::style_text(deparse1(gg_call))
+
+# Optionally: add assignments to call
+gg_call_with_assignments <- ggcall_add_assignments(gg_call)
+gg_call_with_assignments
+styler::style_text(
+  paste(deparse(gg_call_with_assignments), collapse = "\n")
+)
+
+# Optionally: reevaulate the call
+# Reproduce the plot by evaluating the code
+eval_ggcall(gg_call_with_assignments)
+eval_ggcall(ggcall_add_assignments(gg_call))
+
+##############################
+# Example for GGally ggscatmat
+##############################
+
 data(iris)
-gg <- ggscatmat(iris, color = "Species")
+gg <- GGally::ggscatmat(iris, color = "Species", columns = 1:4)
+# gg is a ggplot object
+gg
+
+# Retrieve the plot construction code
 gg_call <- ggcall(gg)
 gg_call
+
 # Optionally: Style the code with styler
-# styler::style_text(deparse1(gg_call))
-# Optional
-# Access call environment and/or use it to evaluate the call
-# as.list(ggcall_env(gg_call))
+styler::style_text(deparse1(gg_call))
+
+# Optionally: add assignments to call
+gg_call_with_assignments <- ggcall_add_assignments(gg_call)
+gg_call_with_assignments
+styler::style_text(
+  paste(deparse(gg_call_with_assignments), collapse = "\n")
+)
+
+# Optionally: reevaulate the call
+# Reproduce the plot by evaluating the code
 eval_ggcall(gg_call)
-#'
-data(tips, package = "reshape")
+eval_ggcall(gg_call_with_assignments)
+
+##########################
+# Example for GGally ggduo
+##########################
+
 # Not supported for ggmatrix like plots
-gg <- ggduo(tips, mapping = ggplot2::aes(colour = sex), columnsX = 3:4, columnsY = 1:2)
-# Will fail
-# gg_call <- ggcall(gg)
+# ggcall will fail as ggmatrix plots are not build with pure ggplot2
+
+gg <- GGally::ggduo(tips, mapping = ggplot2::aes(colour = sex), columnsX = 3:4, columnsY = 1:2)
+ggplot2::is.ggplot(gg)
+# Fail gg_call <- ggcall(gg)
 ```
 
 ## Contributions