Version 0.5.0: Bug fixes, new verbose argument, and deprecating deduped_map

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: deduped
 Type: Package
 Title: Making "Deduplicated" Functions
-Version: 0.4.0
+Version: 0.5.0
 Authors@R:
     person("Or", "Gadish", email = "orgadish@gmail.com", role = c("aut", "cre", "cph"))
 Description: Contains one main function deduped() which speeds up slow,
@@ -12,13 +12,12 @@ Encoding: UTF-8
 LazyData: true
 Imports: 
     collapse,
-RoxygenNote: 7.3.3
 Suggests: 
-    purrr,
     testthat (>= 3.0.0),
     withr,
     fs
 Config/testthat/edition: 3
 URL: https://github.com/orgadish/deduped
 BugReports: https://github.com/orgadish/deduped/issues
 Roxygen: list(markdown = TRUE)
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -1,5 +1,4 @@
 # Generated by roxygen2: do not edit by hand
 
 export(deduped)
-export(deduped_map)
 export(with_deduped)

NEWS.md

@@ -1,3 +1,26 @@
+# deduped 0.5.0
+
+## Features
+* `deduped()` and `with_deduped()` gain a new `verbose` argument which adds
+ informative deduplication messaging if TRUE, either by passing the argument or
+ setting the new global `options(deduped.verbose = TRUE)`.
+* `deduped()` now has early exits for inputs of length <= 1 or when no 
+ duplication is found.
+
+## Bug Fixes
+* `deduped()` now drops names if `f()` drops names, but keeps input names
+ otherwise. Previously it always kept input names (#5).
+
+## Deletion of deduped_map()
+* `deduped_map()` has now been completely deleted and the "Suggests" dependence 
+ on purr has been removed. The function was deprecated with a warning in 
+ 0.2.0 and has no documented usage on github or cran.
+
+## Minor updates
+* Added checks in `with_deduped()` for malformed inputs (e.g. not a call tree,
+ or a call with no first argument to deduplicate.)
+
+
 # deduped 0.4.0
 * `deduped(f)(x)` (and `with_deduped`) check that the function maintains length
   and error if not.

R/deduped.R

@@ -7,9 +7,19 @@
 #'
 #' Note: This only works with functions that preserve length and order.
 #'
+#' @details
+#' We make a best effort to preserve the two main cases for named inputs:
+#' 1. If `f()` drops names, names are dropped in the output.
+#' 2. Otherwise, we preserve the names from the input `x`.
+#' We cannot reliably re-expand the names from the deduped output, since
+#' duplicate values would always map back to their first occurrence's name.
 #'
 #' @param f A length-preserving, order-preserving function that accepts a vector
 #'  or list as its first input.
+#' @param verbose If `TRUE`, prints the number of unique values and reduction
+#'  percentage on each call. If `NULL` (default), reads
+#'  `getOption("deduped.verbose", FALSE)` at call time, so setting
+#'  `options(deduped.verbose = TRUE)` enables it for the entire session.
 #'
 #' @return Deduplicated version of `f`.
 #' @export
@@ -38,48 +48,103 @@
 #' })
 #'
 #' all(y1 == y2)
-deduped <- function(f) {
+deduped <- function(f, verbose = NULL) {
   # Ensure f is a function.
   f <- match.fun(f)
 
   function(x, ...) {
+    # Resolve verbose at runtime of the function, not when deduped() is first
+    # called: explicit argument to deduped() takes priority,
+    # otherwise check the session option, otherwise default to FALSE.
+    .verbose <- if (!is.null(verbose)) {
+      verbose
+    } else {
+      getOption("deduped.verbose", default = FALSE)
+    }
 
     # collapse::funique() and collapse::fmatch() are faster than the base
     # equivalents, but behave differently on lists.
     if (inherits(x, "list")) {
-      ux <- unique(x)
-      uf <- f(ux, ...)
-      out <- uf[match(x, ux)]
+      unique_fn <- unique
+      match_fn <- match
     }
 
     # Deduped only works on atomic vectors or lists, but using is.vector() is
     # too restrictive since it fails on a vector with attributes. Instead we
     # just exclude matrices and arrays.
     else if (is.atomic(x) && is.null(dim(x))) {
+      unique_fn <- collapse::funique
+      match_fn <- collapse::fmatch
+    }
 
-      ux <- collapse::funique(x)
-      uf <- f(ux, ...)
-      out <- uf[collapse::fmatch(x, ux)]
-    } else {
-      warning(paste(
-        "`deduped(f)(x)` only works on atomic vectors or list inputs.",
-        "Proceeding with f(x, ...) directly."
-      ))
+    else {
+      warning(
+        "`deduped(f)(x)` only works on atomic vectors or list inputs.\n",
+        "Proceeding with f(x, ...) directly.",
+        call. = FALSE
+      )
       return(f(x, ...))
     }
 
+    # If x is trivially short, skip deduplication overhead.
+    # Check after the if/else above to prevent data.frames with one column from
+    # exiting without a warning.
+    if (length(x) <= 1L) {
+      if (isTRUE(.verbose))
+        message("deduped: input has 1 or fewer elements, called f(x) directly.")
+      return(f(x, ...))
+    }
+
+    ux <- unique_fn(x)
+
+    # If there is no duplication, avoid the re-expansion overhead by calling
+    # on the original values to minimize the case where `ux` is any different,
+    # e.g. if attributes changed.
+    if (length(ux) == length(x)) {
+      if (isTRUE(.verbose))
+        message("deduped: no duplication found, called f(x) directly.")
+      return(f(x, ...))
+    }
+
+    # Since unique may drop names, restore first-occurrence names
+    names(ux) <- names(x)[match_fn(ux, x)]  # Note: Different match than below
+
+    uf <- f(ux, ...)
+
     # Check for functions that reduce length by comparing ux/ug.
     # There are some cases that this won't catch, but uf[match(x, ux)] results
-    # in NAs which mean we can't check the length directly.
+    # in NAs which mean we can't check the final length directly.
     if(length(uf) != length(ux))
-      stop("deduped only works with functions that preserve length.")
+      stop(sprintf(
+          "deduped() requires a length-preserving function, but f reduced %d unique value(s) to %d.",
+        length(ux), length(uf)
+      ))
+
+    out <- uf[match_fn(x, ux)]
 
 
-    # Since we ensure length is the same, keep attributes.
-    attrs <- c(attributes(uf), attributes(x))  # Put uf first to keep those.
-    attrs <- attrs[!duplicated(names(attrs))]
+    # Restore attributes from uf (what f produced), which covers whole-vector
+    # attributes like `class` and `levels`. Custom per-element attributes from
+    # third-party packages can't be handled generically here — if f produces
+    # any, they will reflect only the unique values rather than the full
+    # expanded output.
+    attrs <- attributes(uf)
+
+    # For names: since we restore names to ux before calling f, names(uf)
+    # correctly reflects whether f preserves names. If f drops names we drop
+    # them too; otherwise we use x's original names since match-based
+    # re-expansion is unreliable for duplicate values.
+    attrs$names <- if (!is.null(names(uf))) names(x) else NULL
+
     attributes(out) <- attrs
 
+    if (isTRUE(.verbose)) {
+      message(sprintf(
+        "deduped: %d value(s) reduced to %d unique (%.1f%% reduction).",
+        length(x), length(ux), 100 * (1 - length(ux) / length(x))
+      ))
+    }
+
     out
   }
 }

R/with_deduped.R

@@ -11,10 +11,27 @@
 #' * With nesting: `f(g(x, g2), f2) |> with_deduped()` is equivalent to
 #'    `deduped(\(.z) f(g(.z, g2), f2))(x)`.
 #'
+#' @details
+#' `with_deduped()` reconstructs the wrapper function on every call, so it is
+#' best suited for one-off or interactive use. For repeated calls such as inside
+#' a loop, build the wrapper once with [deduped()] instead:
+#'
+#' ``` r
+#' # Preferred for loops:
+#' deduped_f <- deduped(slow_func)
+#' for (...) deduped_f(x)
+#'
+#' # Rather than:
+#' for (...) slow_func(x) |> with_deduped()
+#' ```
 #'
 #' @param expr The expression to evaluate.
 #' @param env The environment within which to evaluate the expression. Can be
 #'  modified when calling inside other functions.
+#' @param verbose If `TRUE`, prints the number of unique values and reduction
+#'  percentage on each call. If `NULL` (default), reads
+#'  `getOption("deduped.verbose", FALSE)` at call time, so setting
+#'  `options(deduped.verbose = TRUE)` enables it for the entire session.
 #'
 #' @returns The result of evaluating the expression.
 #' @export
@@ -47,32 +64,42 @@
 #' })
 #'
 #' all(y1 == y2)
-with_deduped <- function(expr, env = parent.frame()) {
+with_deduped <- function(expr, env = parent.frame(), verbose = NULL) {
   call_tree <- substitute(expr)
-  find_env <- new.env()
-  find_env$target_expr <- NULL
+  if (!is.call(call_tree))
+    stop("`expr` must be a function call expression, e.g. `f(x) |> with_deduped()`.")
 
-  # Recursive walker (same as before)
+  # Recursively walks the call tree, replacing the deepest first argument with
+  # `.x`. Returns list(node = modified_call, target = original_leaf_expression).
   swap_arg <- function(node) {
-    if (is.call(node)) {
-      node[[2]] <- swap_arg(node[[2]])
-      return(node)
-    } else {
-      find_env$target_expr <- node
-      return(quote(.x))
-    }
+    # Base case: node is a literal or symbol (not a call), so this is the
+    # deepest first argument — the data to deduplicate. Return it as the target.
+    if (!is.call(node))
+      return(list(node = quote(.x), target = node))
+
+    # Guard: a call with no first argument (e.g. f()) has nothing to deduplicate.
+    if (length(node) < 2)
+      stop(sprintf(
+        "`%s` has no first argument to deduplicate.",
+        deparse(node[[1]])
+      ))
+
+    # Recursive case: descend into the first argument and splice the result back.
+    result <- swap_arg(node[[2]])
+    node[[2]] <- result$node
+    list(node = node, target = result$target)
   }
 
-  new_body <- swap_arg(call_tree)
+  result <- swap_arg(call_tree)
 
   f_wrapper <- function(.x) {}
-  body(f_wrapper) <- new_body
+  body(f_wrapper) <- result$node
   # Set environment to the USER'S environment, passed in as 'env'
   environment(f_wrapper) <- env
 
   # Evaluate the target data in the USER'S environment
-  target_data <- eval(find_env$target_expr, envir = env)
+  target_data <- eval(result$target, envir = env)
 
-  # Optimization Logic
-  deduped(f_wrapper)(target_data)
+  # Actual deduplication
+  deduped(f_wrapper, verbose = verbose)(target_data)
 }

R/zzz.R

@@ -0,0 +1,5 @@
+.onLoad <- function(libname, pkgname) {
+  # Only set if not already defined, so user .Rprofile settings are respected.
+  if (is.null(getOption("deduped.verbose")))
+    options(deduped.verbose = FALSE)
+}

README.Rmd

@@ -76,8 +76,11 @@ system.time({  x1 <- slow_tolower(duplicated_vec)  })
 
 system.time({  x2 <- deduped(slow_tolower)(duplicated_vec)  })
 all.equal(x1, x2)
+
+# As of version 0.3.0, you can use `with_deduped()`.
+all.equal(x1, slow_tolower(duplicated_vec) |> with_deduped())
 ```
-_Note: As of version 0.3.0, you could also use_ `slow_tolower(duplicated_vec) |> with_deduped()`.
+
 
 ### `deduped(lapply)(...)`
 
@@ -119,3 +122,40 @@ system.time({  y2 <- deduped(fs::path_rel)(dup_paths, start=top_path)  })
 
 all.equal(y1, y2)
 ```
+
+### When to use `with_deduped()`
+
+`with_deduped()` is a convenience wrapper for interactive or one-off use.
+Because it reconstructs the wrapper function on every call, prefer `deduped()`
+directly when calling inside a loop:
+
+```r
+# Good: wrapper is built once
+deduped_slow_tolower <- deduped(slow_tolower)
+for (x in list_of_vecs) deduped_slow_tolower(x)
+
+# Avoid: wrapper is rebuilt on every iteration
+for (x in list_of_vecs) slow_tolower(x) |> with_deduped()
+```
+
+### `deduped(..., verbose = TRUE)`
+
+For benchmarking or debugging, pass `verbose = TRUE` to see the reduction 
+achieved.
+
+```{r example-verbose}
+head(
+  deduped(slow_tolower, verbose = TRUE)(duplicated_vec)
+)
+
+# Also available in `with_deduped()`:
+head(
+  slow_tolower(duplicated_vec) |> with_deduped(verbose = TRUE)
+)
+
+# Use `options(deduped.verbose)` to enable for the entire session.
+options(deduped.verbose = TRUE)
+head(
+  deduped(slow_tolower)(duplicated_vec)
+)
+```