Fix RecordArgs

Author: elgabbas

R/General_RecordArgs.R

@@ -8,35 +8,51 @@
 #' unevaluated and evaluated forms of arguments passed to a parent function. It
 #' returns a tibble with columns reflecting argument states: when unevaluated
 #' and evaluated values differ, columns are named with `_orig` and `_eval`
-#' suffixes; when they are the same, a single column is used with the argument
-#' name alone. The function dynamically handles scalars, call objects, and
-#' complex objects (e.g., `lm` models, `SpatRaster` objects), preserving their
-#' structure appropriately.
+#' suffixes; when they are the same (including symbols evaluated to scalars), a
+#' single column is used with the argument name alone. The function dynamically
+#' handles scalars, call objects, and complex objects (e.g., `lm` models,
+#' `SpatRaster` objects), preserving their structure appropriately.
 #'
 #' @param ExportPath Character. The path to an `.RData` file where the tibble
 #'   will be exported. If `NULL` (default), the tibble is returned without
 #'   saving. If provided, the tibble is saved to the specified file and `NULL`
 #'   is returned invisibly.
+#' @param call Language object (optional). The call to the parent function, as
+#'   provided by `match.call()` from the caller. If `NULL` (default), the
+#'   function falls back to `sys.call(-1)` to capture the parent call. Used to
+#'   ensure accurate argument capture in iterative contexts (e.g., `lapply`,
+#'   `purrr::map`).
+#' @param env Environment (optional). The environment in which to evaluate the
+#'   arguments, typically provided by `parent.frame()` from the caller. If
+#'   `NULL` (default), the function uses `parent.frame()` to determine the
+#'   evaluation environment. Used to resolve variables in iterative contexts.
 #'
-#' @details This function must be called from within another function. It uses
-#'   `sys.call(-1)` to capture the parent function’s call, evaluates arguments
-#'   in the parent environment, and combines them with default values from the
-#'   parent function’s formal arguments. Unevaluated expressions (e.g., `a + b`)
-#'   are preserved as `call` objects, while evaluated values are kept as-is for
-#'   scalars or wrapped in lists for complex objects. Columns are ordered based
-#'   on the original argument sequence: single columns (for matching values)
-#'   appear first, followed by `_orig` and `_eval` pairs (for differing values)
+#' @details This function must be called from within another function. It
+#'   captures the parent function’s call using either a provided `call` argument
+#'   or `sys.call(-1)`, evaluates arguments in the specified or default parent
+#'   environment, and combines them with default values from the parent
+#'   function’s formal arguments. Unevaluated expressions (e.g., `a + b`) are
+#'   preserved as character strings via `deparse()`, while scalars (including
+#'   symbols like `i` in loops that evaluate to scalars) and complex objects
+#'   (e.g., `lm`, `SpatRaster`) are handled appropriately:
+#'   - Symbols (e.g., `i` in `lapply`) are treated as matching their evaluated
+#'   scalar values, resulting in a single column.
+#'   - Calls (e.g., `a + b`) result in `_orig`/`_eval` pairs.
+#'   - Complex objects are wrapped in lists in `_eval` columns.
+#'   Columns are ordered based on the original argument sequence: single columns
+#'   (for matching values) appear first, followed by `_orig` and `_eval` pairs
 #'   in that order.
 #'
 #' @return A `tibble` containing the unevaluated and evaluated forms of the
 #'   parent function’s arguments. Column naming depends on whether unevaluated
 #'   and evaluated values match:
 #'   - **Single columns** (e.g., `y`): Used when unevaluated and evaluated
-#'   values are identical (e.g., scalars like `2` or defaults like `10`),
+#'   values are identical or effectively equivalent (e.g., scalars like `2`,
+#'   defaults like `10`, or symbols like `i` evaluating to `1` in loops),
 #'   containing the evaluated value as-is.
 #'   - **Paired columns** (e.g., `x_orig`, `x_eval`):
-#'     - `*_orig`: Unevaluated expressions as list columns with `call` objects
-#'   (e.g., `a + b`) or scalars as-is.
+#'     - `*_orig`: Unevaluated expressions as character strings (e.g.,
+#'   `"a + b"`) or scalars as-is for non-call objects.
 #'     - `*_eval`: Evaluated values, either scalars (e.g., `8`) or list columns
 #'   for complex objects (e.g., `lm`, `SpatRaster`).
 #'
@@ -46,152 +62,219 @@
 #'
 #' @author Ahmed El-Gabbas
 #' @export
+#' @name RecordArgs
 #' @examples
 #' a <- 5
 #' b <- 3
+#' 
 #' Function1 <- function(w = 5, x, y, z = 10) {
-#'   Args <- RecordArgs()
+#'   Args <- IASDT.R::RecordArgs(call = match.call(), env = parent.frame())
 #'   return(Args)
 #' }
 #'
 #' # --------------------------------------------------------------
 #'
 #' # Basic usage with scalars and expressions
 #' Out1 <- Function1(x = a + b, y = 2)
-#' Out1$w              # 5 (single column, same as orig and eval)
-#' Out1$x_orig         # call object: a + b
-#' Out1$x_eval         # 8
-#' Out1$y              # 2 (single column)
-#' Out1$z              # 10 (single column)
+#'
+#' Out1
+#'
+#' Out1$w              # 5 (single column, default matches evaluated)
+#' Out1$x_orig         # "a + b" (unevaluated expression)
+#' Out1$x_eval         # 8 (evaluated result)
+#' Out1$y              # 2 (single column, scalar matches evaluated)
+#' Out1$z              # 10 (single column, default matches evaluated)
 #'
 #' # --------------------------------------------------------------
 #'
-#' #' # Usage with complex objects (lm and SpatRaster)
+#' # Usage with complex objects (lm and Raster)
 #' Out2 <- Function1(
 #'   w = 10,
 #'   x = a + b,
 #'   y = stats::lm(mpg ~ disp + hp, data = mtcars),
-#'   z = terra::rast(system.file("ex/logo.tif", package = "terra")))
+#'   z = raster::raster())
+#'
+#' Out2
+#'
 #' Out2$w              # 10 (single column)
-#' Out2$x_orig         # call object: a + b
-#' Out2$x_eval         # 8
-#' Out2$y_orig         # call object: lm(mpg ~ disp + hp, data = mtcars)
+#' Out2$x_orig         # "a + b" (unevaluated expression)
+#' Out2$x_eval         # 8 (evaluated result)
+#' Out2$y_orig         # "stats::lm(mpg ~ disp + hp, data = mtcars)"
 #' Out2$y_eval[[1]]    # lm object
-#' Out2$z_orig         # call object: terra::rast(system.file(...))
-#' Out2$z_eval[[1]]    # SpatRaster object
+#' Out2$z_orig         # "raster::raster()"
+#' Out2$z_eval[[1]]    # RasterLayer object
 #'
+#' # --------------------------------------------------------------
+#'
+#' # Usage with purrr::pmap for multiple inputs
+#' w_values <- 1:3
+#' x_values <- c(a + b, 10, 15)
+#' y_values <- c("ABCD", "XYZ123", "TEST")
+#' Out3 <- purrr::pmap(
+#'   .l = list(w = w_values, x = x_values, y = y_values),
+#'   .f = function(w, x, y) {
+#'     Function1(
+#'       w = w,
+#'       x = x,
+#'       y = stringr::str_extract(y, "B.+$"),
+#'       z = terra::rast(system.file("ex/elev.tif", package="terra")))
+#'   }) %>%
+#'   dplyr::bind_rows()
+#'
+#' Out3
+#'
+#' Out3$w        # 1, 2, 3
+#' Out3$x        # 8, 10, 15
+#' Out3$y_orig   # 'stringr::str_extract(y, "B.+$")', repeated for each row
+#' Out3$y_eval   # "BCD", NA, NA
+#' Out3$z_orig   # "terra::rast(...))", repeated for each row
+#' Out3$z_eval   # Packed SpatRaster, repeated for each row
+
+RecordArgs <- function(ExportPath = NULL, call = NULL, env = NULL) {
 
-RecordArgs <- function(ExportPath = NULL) {
-  # Get the call to the parent function (one level up)
-  call_info <- sys.call(-1)
+  # Capture the parent function's call: use provided call (e.g., from
+  # match.call()) or fall back to sys.call(-1) for direct calls
+  call_info <- if (!is.null(call)) call else sys.call(-1)
 
+  # Check if call_info is valid; stop if not called within a function
   if (is.null(call_info)) {
     stop(
       "RecordArgs() must be called from within another function", call. = FALSE)
   }
 
-  # Extract the arguments, excluding the function name
+  # Extract the arguments from the call, excluding the function name (first
+  # element)
   args_list <- as.list(call_info)[-1]
 
-  # Extract the name of the calling function
+  # Get the name of the calling function as a character string
   calling_func <- deparse(call_info[[1]])
 
-  # Get the parent function's environment and formal arguments
-  parent_env <- parent.frame()
+  # Determine the environment for evaluation: use provided env (e.g., from
+  # parent.frame()) or default to the immediate parent environment
+  parent_env <- if (!is.null(env)) env else parent.frame()
+
+  # Retrieve the parent function and its formal arguments (including defaults)
   parent_func <- sys.function(-1)
   formals_full <- formals(parent_func)
 
-  # Evaluate the arguments in the parent environment
+  # Evaluate the captured arguments in the parent environment
   args_values <- lapply(args_list, eval, envir = parent_env)
+
+  # Name the evaluated values with their corresponding argument names
   recorded_values <- stats::setNames(args_values, names(args_list))
-  # Combine with default values
+
+  # Merge evaluated values with defaults, overriding defaults with provided
+  # values
   Evaluated <- utils::modifyList(formals_full, recorded_values)
-  # Store unevaluated expressions
+
+  # Merge unevaluated expressions with defaults, keeping unevaluated forms
   Unevaluated <- utils::modifyList(formals_full, args_list)
 
-  # Get argument names in their original order
+  # Get the argument names in their original order from the function definition
   arg_names <- names(formals_full)
 
-  # Determine which arguments have identical unevaluated and evaluated values
+  # Identify which arguments have identical unevaluated and evaluated values
+  # - Calls (e.g., a + b) are always different
+  # - Symbols (e.g., i in loops) are treated as matching their evaluated scalar
+  # - Scalars and defaults are compared directly
   same_values <- purrr::map2_lgl(
-    .x = Unevaluated,
-    .y = Evaluated,
+    # Coerce pairlist to list for purrr compatibility
+    .x = as.list(Unevaluated),
+    .y = as.list(Evaluated),
     .f = function(u, e) {
-      if (is.call(u)) return(FALSE)  # Calls always differ from evaluated
+      # Calls always differ from evaluated
+      if (is.call(u)) return(FALSE)
+      # Symbols match their evaluated value
+      if (is.symbol(u)) return(identical(e, e))
+      # Direct comparison for scalars and defaults
       identical(u, e)
     })
 
-  # Names for single columns
+  # Define column names: single columns for matching values, pairs for differing
+  # ones
+  #
+  # Names for arguments with identical values
   single_cols <- arg_names[same_values]
-  # Names for orig/eval pairs
+  # Names for arguments needing _orig/_eval pairs
   diff_cols <- arg_names[!same_values]
 
-  # Construct column names
-  single_cols <- single_cols                      # e.g., "y", "z"
-  eval_cols <- paste0(diff_cols, "_eval")         # e.g., "x_eval"
-  uneval_cols <- paste0(diff_cols, "_orig")       # e.g., "x_orig"
+  # Construct column names for the tibble
 
-  # Prepare Evaluated values: keep scalars as-is, wrap complex objects in lists
+  # e.g., "y", "z" (unchanged)
+  single_cols <- single_cols
+  # e.g., "x_eval" (evaluated values)
+  eval_cols <- paste0(diff_cols, "_eval")
+  # e.g., "x_orig" (unevaluated forms)
+  uneval_cols <- paste0(diff_cols, "_orig")
+
+  # Format evaluated values: scalars as-is, complex objects (e.g., SpatRaster)
+  # wrapped in lists
   eval_values <- purrr::map(
     .x = as.list(Evaluated),
     .f = function(x) {
       if (is.vector(x) && length(x) == 1 && !is.list(x)) {
+        # Scalars remain as-is (e.g., 8, "BCD")
         return(x)
       } else {
         if (inherits(x, "SpatRaster")) {
+          # Wrap SpatRaster objects for storage
           x <- terra::wrap(x)
         }
+        # Wrap complex objects (e.g., lm, RasterLayer) in a list
         return(list(x))
       }
     })
 
-  # Prepare Unevaluated values: keep calls as-is, wrap in list, scalars stay
-  # as-is
+  # Format unevaluated values: calls as character strings, scalars as-is,
+  # complex objects in lists
   uneval_values <- purrr::map(
     .x = as.list(Unevaluated),
     .f = function(x) {
       if (is.call(x)) {
-        return(list(x))
+        # Convert calls (e.g., a + b) to strings without quotes
+        return(noquote(deparse(x)))
       } else if (is.vector(x) && length(x) == 1 && !is.list(x)) {
+        # Scalars (e.g., 2, 10) remain as-is
         return(x)
       } else {
         if (inherits(x, "SpatRaster")) {
+          # Wrap SpatRaster objects
           x <- terra::wrap(x)
         }
+        # Wrap complex objects in a list
         return(list(x))
       }
     })
 
-  # Combine into a tibble
+  # Combine all values into a named list for tibble construction
   tibble_data <- c(
+    # Unevaluated differing values
     stats::setNames(uneval_values[diff_cols], uneval_cols),
+    # Evaluated differing values
     stats::setNames(eval_values[diff_cols], eval_cols),
-    stats::setNames(eval_values[single_cols], single_cols)
-  )
+    # Single columns for matching values
+    stats::setNames(eval_values[single_cols], single_cols))
 
-  # Create tibble and reorder columns by argument order
+  # Create the tibble from the combined data
   result <- tibble::as_tibble(tibble_data)
 
-  # Define the desired column order: single columns first, then orig/eval pairs
-  desired_order <- c(
-    single_cols,
-    unlist(lapply(
-      diff_cols,
-      function(n) {
-        c(paste0(n, "_orig"), paste0(n, "_eval"))
-      }
-    ))
-  )
-
-  result <- dplyr::select(result, tidyselect::all_of(desired_order))
+  # Reorder the tibble columns according to the desired order
+  # Define the desired column order
+  desired_order <- purrr::map(
+    arg_names, ~ c(.x, paste0(.x, "_orig"), paste0(.x, "_eval"))) %>%
+    unlist()
+  result <- dplyr::select(result, tidyselect::any_of(desired_order))
 
-  # Export the tibble to a file if a path is provided
+  # Return the tibble or save it to a file based on ExportPath
   if (is.null(ExportPath)) {
+    # Return the tibble if no export path is provided
     return(result)
   } else {
+    # Save to .RData file if ExportPath is specified
     IASDT.R::SaveAs(
       InObj = result, OutObj = paste0("Args_", calling_func),
       OutPath = ExportPath)
+    # Return NULL invisibly after saving
     return(invisible(NULL))
   }
 }

R/Mod_Postprocess.R

@@ -208,6 +208,7 @@ Mod_Postprocess_1_CPU <- function(
   rm(EnvVars2Read, envir = environment())
 
   IASDT.R::RecordArgs(
+    call = match.call(), env = parent.frame(),
     ExportPath = IASDT.R::Path(Path_Model, "Args_Mod_Postprocess_1_CPU.RData"))
 
   # ****************************************************************
@@ -455,6 +456,7 @@ Mod_Prep_TF <- function(
   rm(EnvVars2Read, envir = environment())
 
   IASDT.R::RecordArgs(
+    call = match.call(), env = parent.frame(),
     ExportPath = IASDT.R::Path(Path_Model, "Args_Mod_Prep_TF.RData"))
 
   # ****************************************************************
@@ -872,6 +874,7 @@ Mod_Postprocess_2_CPU <- function(
   rm(EnvVars2Read, envir = environment())
 
   IASDT.R::RecordArgs(
+    call = match.call(), env = parent.frame(),
     ExportPath = IASDT.R::Path(Path_Model, "Args_Mod_Postprocess_2_CPU.RData"))
 
   # ****************************************************************

R/Mod_Prep4HPC.R

@@ -312,6 +312,7 @@ Mod_Prep4HPC <- function(
   }
 
   IASDT.R::RecordArgs(
+    call = match.call(), env = parent.frame(),
     ExportPath = IASDT.R::Path(Path_Model, "Args_Prep4HPC.RData"))
 
   # # ..................................................................... ###

R/Mod_PrepData.R

@@ -102,6 +102,7 @@ Mod_PrepData <- function(
   fs::dir_create(Path_Model)
 
   IASDT.R::RecordArgs(
+    call = match.call(), env = parent.frame(),
     ExportPath = IASDT.R::Path(Path_Model, "Args_PrepData.RData"))
 
   # # ..................................................................... ###