From a91babd1f8a10f3dd4d53719016b81e60f8932bf Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sat, 13 Jun 2026 23:46:38 -0700 Subject: [PATCH 01/13] Add early exits to deduped when trivially short, or no duplication and improve error messaging. --- R/deduped.R | 42 ++++++++++++++++++++++++++++++------------ 1 file changed, 30 insertions(+), 12 deletions(-) diff --git a/R/deduped.R b/R/deduped.R index 48b813d..c406079 100644 --- a/R/deduped.R +++ b/R/deduped.R @@ -44,35 +44,53 @@ deduped <- function(f) { function(x, ...) { + # If x is trivially short, skip deduplication overhead. + if (length(x) <= 1L) + return(f(x, ...)) + # 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)] + 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))) { - 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." - )) + match_fn <- collapse::fmatch + } + + 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 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)) + return(f(x, ...)) + + 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. From 0a59a1923388835e5e9c17ba13b81739c70d52d9 Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sat, 13 Jun 2026 23:47:25 -0700 Subject: [PATCH 02/13] Ensure that with_deduped errors if not called on a call expression, improve swap_arg readability and add a guard for when a function without a first argument is called. --- R/with_deduped.R | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/R/with_deduped.R b/R/with_deduped.R index 5392447..c15224d 100644 --- a/R/with_deduped.R +++ b/R/with_deduped.R @@ -49,29 +49,39 @@ #' all(y1 == y2) with_deduped <- function(expr, env = parent.frame()) { 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) From acadf4d2082cf12350e55bb560cc6abd0388f38f Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:07:05 -0700 Subject: [PATCH 03/13] Make the if/else in deduped only responsible for deciding the functions --- R/deduped.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/deduped.R b/R/deduped.R index c406079..91ebf3e 100644 --- a/R/deduped.R +++ b/R/deduped.R @@ -51,7 +51,7 @@ deduped <- function(f) { # collapse::funique() and collapse::fmatch() are faster than the base # equivalents, but behave differently on lists. if (inherits(x, "list")) { - ux <- unique(x) + unique_fn <- unique match_fn <- match } @@ -59,7 +59,7 @@ deduped <- function(f) { # 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))) { - ux <- collapse::funique(x) + unique_fn <- collapse::funique match_fn <- collapse::fmatch } @@ -72,6 +72,7 @@ deduped <- function(f) { 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, From ed1e25122fe446dad7d7d6c60da0cbc6b3f8076a Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:11:46 -0700 Subject: [PATCH 04/13] Deduped now pulls names by expanding uf's names rather than from the input (in case f changes names). --- R/deduped.R | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/R/deduped.R b/R/deduped.R index 91ebf3e..81f2437 100644 --- a/R/deduped.R +++ b/R/deduped.R @@ -94,9 +94,19 @@ deduped <- function(f) { 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`. The one per-element attribute we + # know about is `names`, which must be re-expanded to match the full output + # rather than taken directly from uf (which only has names for unique values). + # 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) + attrs$names <- if (!is.null(names(uf))) { + names(uf)[match_fn(x, ux)] # re-expand per-element names + } else { + names(x) # f didn't name its output; keep input names + } attributes(out) <- attrs out From 279c48cf6e36ef827e9e58447f2fb1a455e059af Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:20:11 -0700 Subject: [PATCH 05/13] Revert taking names from expanded uf. It adds complexity and handles an uncommon edge case. --- R/deduped.R | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/R/deduped.R b/R/deduped.R index 81f2437..da30362 100644 --- a/R/deduped.R +++ b/R/deduped.R @@ -7,6 +7,13 @@ #' #' Note: This only works with functions that preserve length and order. #' +#' @details +#' Names are taken from the input `x` rather than re-expanded from `f`'s output +#' on the unique values. This means value-based renaming (e.g. +#' `setNames(x, paste0("out_", x))`) is preserved correctly, but position-based +#' renaming (e.g. `setNames(x, seq_along(x))`) will produce incorrect results +#' since `f` is called on the unique values only. If `f` renames by position, +#' call it directly rather than wrapping with `deduped()`. #' #' @param f A length-preserving, order-preserving function that accepts a vector #' or list as its first input. @@ -95,18 +102,15 @@ deduped <- function(f) { # Restore attributes from uf (what f produced), which covers whole-vector - # attributes like `class` and `levels`. The one per-element attribute we - # know about is `names`, which must be re-expanded to match the full output - # rather than taken directly from uf (which only has names for unique values). - # 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. + # attributes like `class` and `levels`. For names, we use x's original names + # rather than re-expanding uf's names: most functions either preserve or drop + # names, and position-based renaming is incompatible with deduplication + # regardless (f is called on unique values, so position-based names would be + # wrong either way). 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) - attrs$names <- if (!is.null(names(uf))) { - names(uf)[match_fn(x, ux)] # re-expand per-element names - } else { - names(x) # f didn't name its output; keep input names - } + attrs$names <- names(x) attributes(out) <- attrs out From a1e96170fde74af966df16d242e45afe6070a656 Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:21:44 -0700 Subject: [PATCH 06/13] Add comment explaining that with_deduped() should not be used in a loop. --- R/with_deduped.R | 13 +++++++++++++ README.Rmd | 20 +++++++++++++++++++- README.md | 32 ++++++++++++++++++++++++-------- 3 files changed, 56 insertions(+), 9 deletions(-) diff --git a/R/with_deduped.R b/R/with_deduped.R index c15224d..2d256ff 100644 --- a/R/with_deduped.R +++ b/R/with_deduped.R @@ -11,6 +11,19 @@ #' * 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 diff --git a/README.Rmd b/README.Rmd index c3a163a..802d116 100644 --- a/README.Rmd +++ b/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,18 @@ 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() +``` diff --git a/README.md b/README.md index 513de71..bae4482 100644 --- a/README.md +++ b/README.md @@ -65,18 +65,19 @@ length(duplicated_vec) system.time({ x1 <- slow_tolower(duplicated_vec) }) #> user system elapsed -#> 0.02 0.02 5.97 +#> 0.07 0.01 6.50 system.time({ x2 <- deduped(slow_tolower)(duplicated_vec) }) #> user system elapsed -#> 0.04 0.00 0.15 +#> 0.09 0.00 0.85 all.equal(x1, x2) #> [1] TRUE -``` -*Note: As of version 0.3.0, you could also use* -`slow_tolower(duplicated_vec) |> with_deduped()`. +# As of version 0.3.0, you can use `with_deduped()`. +all.equal(x1, slow_tolower(duplicated_vec) |> with_deduped()) +#> [1] TRUE +``` ### `deduped(lapply)(...)` @@ -99,7 +100,7 @@ length(duplicated_list) system.time({ y1 <- lapply(duplicated_list, slow_tolower) }) #> user system elapsed -#> 0.04 0.00 3.58 +#> 0.00 0.00 3.69 system.time({ y2 <- deduped(lapply)(duplicated_list, slow_tolower) }) #> user system elapsed #> 0.00 0.00 0.09 @@ -127,11 +128,26 @@ length(dup_paths) system.time({ y1 <- fs::path_rel(dup_paths, start=top_path) }) #> user system elapsed -#> 3.96 0.03 3.99 +#> 4.00 0.02 4.11 system.time({ y2 <- deduped(fs::path_rel)(dup_paths, start=top_path) }) #> user system elapsed -#> 0.01 0.00 0.01 +#> 0.00 0.00 0.02 all.equal(y1, y2) #> [1] TRUE ``` + +### 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() +``` From 36d432677368cb23029bade684d0b2655a3c817a Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:25:31 -0700 Subject: [PATCH 07/13] Update Rd files for deduped and with_deduped --- man/deduped.Rd | 8 ++++++++ man/with_deduped.Rd | 13 +++++++++++++ 2 files changed, 21 insertions(+) diff --git a/man/deduped.Rd b/man/deduped.Rd index 637685d..47bde2f 100644 --- a/man/deduped.Rd +++ b/man/deduped.Rd @@ -20,6 +20,14 @@ it is the same as if the computation was performed on all elements. Note: This only works with functions that preserve length and order. } +\details{ +Names are taken from the input \code{x} rather than re-expanded from \code{f}'s output +on the unique values. This means value-based renaming (e.g. +\code{setNames(x, paste0("out_", x))}) is preserved correctly, but position-based +renaming (e.g. \code{setNames(x, seq_along(x))}) will produce incorrect results +since \code{f} is called on the unique values only. If \code{f} renames by position, +call it directly rather than wrapping with \code{deduped()}. +} \examples{ x <- sample(LETTERS, 10) diff --git a/man/with_deduped.Rd b/man/with_deduped.Rd index d28b609..a2252dd 100644 --- a/man/with_deduped.Rd +++ b/man/with_deduped.Rd @@ -27,6 +27,19 @@ itself a function call. \verb{deduped(\\(.z) f(g(.z, g2), f2))(x)}. } } +\details{ +\code{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 \code{\link[=deduped]{deduped()}} instead: + +\if{html}{\out{
}}\preformatted{# Preferred for loops: +deduped_f <- deduped(slow_func) +for (...) deduped_f(x) + +# Rather than: +for (...) slow_func(x) |> with_deduped() +}\if{html}{\out{
}} +} \examples{ x <- sample(LETTERS, 10) From db867c07d55b9bc199e3648c1edb830b9384a5c1 Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:26:00 -0700 Subject: [PATCH 08/13] Fully remove deduped_map, tests, and purrr dependency. --- DESCRIPTION | 3 +- NAMESPACE | 1 - R/deduped_map.R | 27 -------------- man/deduped_map.Rd | 59 ------------------------------- tests/testthat/test-deduped_map.R | 10 ------ 5 files changed, 1 insertion(+), 99 deletions(-) delete mode 100644 R/deduped_map.R delete mode 100644 man/deduped_map.Rd delete mode 100644 tests/testthat/test-deduped_map.R diff --git a/DESCRIPTION b/DESCRIPTION index 1a4a453..9c4d87c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,9 +12,7 @@ Encoding: UTF-8 LazyData: true Imports: collapse, -RoxygenNote: 7.3.3 Suggests: - purrr, testthat (>= 3.0.0), withr, fs @@ -22,3 +20,4 @@ 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 diff --git a/NAMESPACE b/NAMESPACE index 52fa011..c708311 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,4 @@ # Generated by roxygen2: do not edit by hand export(deduped) -export(deduped_map) export(with_deduped) diff --git a/R/deduped_map.R b/R/deduped_map.R deleted file mode 100644 index 63babba..0000000 --- a/R/deduped_map.R +++ /dev/null @@ -1,27 +0,0 @@ -#' Apply a function to each _unique_ element -#' -#' @description -#' DEPRECATED as of deduped 0.2.0. -#' -#' Please use `deduped(lapply)()` or `deduped(purrr::map)()` instead. -#' -#' @inheritParams purrr::map -#' -#' @return -#' A list whose length is the same as the length of the input, -#' matching the output of [purrr::map()]. -#' -#' @seealso [deduped()] -#' -#' @export -deduped_map <- function(.x, .f, ..., .progress = FALSE) { - warning(paste( - "`deduped_map(...)` was deprecated in deduped 0.2.0.\n", - "\U02139 Please use `deduped(purrr::map)(...)` instead." - )) - if (!requireNamespace("purrr", quietly = TRUE)) { - stop("`purrr` must be installed to use `deduped_map()`.") - } - - deduped(purrr::map)(.x, .f, ..., .progress = .progress) -} diff --git a/man/deduped_map.Rd b/man/deduped_map.Rd deleted file mode 100644 index 56a5ff5..0000000 --- a/man/deduped_map.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deduped_map.R -\name{deduped_map} -\alias{deduped_map} -\title{Apply a function to each \emph{unique} element} -\usage{ -deduped_map(.x, .f, ..., .progress = FALSE) -} -\arguments{ -\item{.x}{A list or atomic vector.} - -\item{.f}{A function, specified in one of the following ways: -\itemize{ -\item A named function, e.g. \code{mean}. -\item An anonymous function, e.g. \verb{\\(x) x + 1} or \code{function(x) x + 1}. -\item A formula, e.g. \code{~ .x + 1}. Use \code{.x} to refer to the first -argument. No longer recommended. -\item A string, integer, or list, e.g. \code{"idx"}, \code{1}, or \code{list("idx", 1)} which -are shorthand for \verb{\\(x) pluck(x, "idx")}, \verb{\\(x) pluck(x, 1)}, and -\verb{\\(x) pluck(x, "idx", 1)} respectively. Optionally supply \code{.default} to -set a default value if the indexed element is \code{NULL} or does not exist. -} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - -Wrap a function with \code{\link[purrr:in_parallel]{in_parallel()}} to declare that it should be performed -in parallel. See \code{\link[purrr:in_parallel]{in_parallel()}} for more details. -Use of \code{...} is not permitted in this context.} - -\item{...}{Additional arguments passed on to the mapped function. - -We now generally recommend against using \code{...} to pass additional -(constant) arguments to \code{.f}. Instead use a shorthand anonymous function: - -\if{html}{\out{
}}\preformatted{# Instead of -x |> map(f, 1, 2, collapse = ",") -# do: -x |> map(\\(x) f(x, 1, 2, collapse = ",")) -}\if{html}{\out{
}} - -This makes it easier to understand which arguments belong to which -function and will tend to yield better error messages.} - -\item{.progress}{Whether to show a progress bar. Use \code{TRUE} to turn on -a basic progress bar, use a string to give it a name, or see -\link[purrr]{progress_bars} for more details.} -} -\value{ -A list whose length is the same as the length of the input, -matching the output of \code{\link[purrr:map]{purrr::map()}}. -} -\description{ -DEPRECATED as of deduped 0.2.0. - -Please use \code{deduped(lapply)()} or \code{deduped(purrr::map)()} instead. -} -\seealso{ -\code{\link[=deduped]{deduped()}} -} diff --git a/tests/testthat/test-deduped_map.R b/tests/testthat/test-deduped_map.R deleted file mode 100644 index 1e1b25a..0000000 --- a/tests/testthat/test-deduped_map.R +++ /dev/null @@ -1,10 +0,0 @@ -test_that("deduped_map warns for deprecation, but works", { - testthat::skip_if_not_installed("purrr") - - x <- list("ABC", "ABC") - expect_warning(deduped_map(x, tolower), "deprecated") - expect_equal( - suppressWarnings(deduped_map(x, tolower)), - deduped(lapply)(x, tolower) - ) -}) From 2163e292650b09698fb342e21f366d01c702737a Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:42:11 -0700 Subject: [PATCH 09/13] Fix deduped.R name behavior and bug in early exit. --- R/deduped.R | 36 +++++++++++++++++++----------------- man/deduped.Rd | 12 ++++++------ 2 files changed, 25 insertions(+), 23 deletions(-) diff --git a/R/deduped.R b/R/deduped.R index da30362..b8d96ed 100644 --- a/R/deduped.R +++ b/R/deduped.R @@ -8,12 +8,12 @@ #' Note: This only works with functions that preserve length and order. #' #' @details -#' Names are taken from the input `x` rather than re-expanded from `f`'s output -#' on the unique values. This means value-based renaming (e.g. -#' `setNames(x, paste0("out_", x))`) is preserved correctly, but position-based -#' renaming (e.g. `setNames(x, seq_along(x))`) will produce incorrect results -#' since `f` is called on the unique values only. If `f` renames by position, -#' call it directly rather than wrapping with `deduped()`. +#' Names are taken from the input `x` rather than from `f`'s output on the +#' unique values, since `funique`/`unique` may drop names before `f` is called. +#' This means input names are always preserved when present, but renaming by +#' `f` (e.g. `setNames(x, paste0("out_", x))`) will be silently ignored. +#' If `f` renames its output, call it directly rather than wrapping with +#' `deduped()`. #' #' @param f A length-preserving, order-preserving function that accepts a vector #' or list as its first input. @@ -51,10 +51,6 @@ deduped <- function(f) { function(x, ...) { - # If x is trivially short, skip deduplication overhead. - if (length(x) <= 1L) - return(f(x, ...)) - # collapse::funique() and collapse::fmatch() are faster than the base # equivalents, but behave differently on lists. if (inherits(x, "list")) { @@ -79,6 +75,12 @@ deduped <- function(f) { 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) + return(f(x, ...)) + ux <- unique_fn(x) # If there is no duplication, avoid the re-expansion overhead by calling @@ -103,14 +105,14 @@ deduped <- function(f) { # Restore attributes from uf (what f produced), which covers whole-vector # attributes like `class` and `levels`. For names, we use x's original names - # rather than re-expanding uf's names: most functions either preserve or drop - # names, and position-based renaming is incompatible with deduplication - # regardless (f is called on unique values, so position-based names would be - # wrong either way). 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. + # if x was named — we don't infer from uf's names since funique/unique may + # drop them. Position-based renaming by f is incompatible with deduplication + # regardless, since f is called on unique values only. 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) - attrs$names <- names(x) + attrs$names <- if (!is.null(names(x))) names(x) else NULL attributes(out) <- attrs out diff --git a/man/deduped.Rd b/man/deduped.Rd index 47bde2f..9f1783d 100644 --- a/man/deduped.Rd +++ b/man/deduped.Rd @@ -21,12 +21,12 @@ it is the same as if the computation was performed on all elements. Note: This only works with functions that preserve length and order. } \details{ -Names are taken from the input \code{x} rather than re-expanded from \code{f}'s output -on the unique values. This means value-based renaming (e.g. -\code{setNames(x, paste0("out_", x))}) is preserved correctly, but position-based -renaming (e.g. \code{setNames(x, seq_along(x))}) will produce incorrect results -since \code{f} is called on the unique values only. If \code{f} renames by position, -call it directly rather than wrapping with \code{deduped()}. +Names are taken from the input \code{x} rather than from \code{f}'s output on the +unique values, since \code{funique}/\code{unique} may drop names before \code{f} is called. +This means input names are always preserved when present, but renaming by +\code{f} (e.g. \code{setNames(x, paste0("out_", x))}) will be silently ignored. +If \code{f} renames its output, call it directly rather than wrapping with +\code{deduped()}. } \examples{ From 26729e4f10b85e2e3dd18e028ffeb192a11e7e41 Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 00:42:54 -0700 Subject: [PATCH 10/13] Update tests --- tests/testthat/test-deduped.R | 82 ++++++++++++++++++++++-------- tests/testthat/test-with_deduped.R | 38 +++++++++++++- 2 files changed, 98 insertions(+), 22 deletions(-) diff --git a/tests/testthat/test-deduped.R b/tests/testthat/test-deduped.R index a37a2af..ea4de3b 100644 --- a/tests/testthat/test-deduped.R +++ b/tests/testthat/test-deduped.R @@ -26,6 +26,25 @@ test_that("deduped(f) runs only on deduplicated values", { ) }) +test_that("deduped(f) early-exits on length-0 and length-1 inputs", { + n <- 0L + f <- function(x) { n <<- n + 1L; x } + + deduped(f)(character(0)) + expect_equal(n, 1L) + + deduped(f)("a") + expect_equal(n, 2L) +}) + +test_that("deduped(f) early-exits when there is no duplication", { + n <- 0L + f <- function(x) { n <<- n + 1L; x } + + deduped(f)(c("a", "b", "c")) + expect_equal(n, 1L) +}) + test_that("deduped(f) returns the data in the same order", { x <- c(1, 3, 1, 2, 2, 1) pass_through <- \(i) i @@ -40,15 +59,47 @@ test_that("deduped(f) works on lists", { ) }) -test_that("deduped(f) preserves naming in named vectors", { - x <- c(a="ABC", b="dEf", a="ABC") - expect_equal( +test_that("deduped(f) preserves names on named vectors", { + x <- c(a = "ABC", b = "dEf", a = "ABC") + expect_identical( deduped(tolower)(x), tolower(x) ) }) -test_that("deduped(f) preserves random attributes", { +test_that("deduped(f) preserves names on named lists", { + + x <- list(p = "ABC", q = "DEF", r = "ABC") + + # tolower() does not preserve names on a list. + list_tolower <- function(x) lapply(x, tolower) + + expect_identical( + deduped(list_tolower)(x), + list_tolower(x) + ) +}) + +test_that("deduped(f) preserves class from f's output", { + add_class <- function(x) structure(tolower(x), class = "my_class") + + x <- c("A", "B", "A") + expect_identical( + deduped(add_class)(x), + add_class(x) + ) +}) + +test_that("deduped(f) preserves attributes added by f, e.g. fs::path", { + skip_if_not_installed("fs") + + expect_identical( + deduped(fs::path)("x", "y"), + fs::path("x", "y") + ) +}) + +test_that("deduped(f) preserves non-name attributes on x", { x <- c("ABC", "ABC") attr(x, "test") <- TRUE expect_false(is.vector(x)) @@ -61,27 +112,18 @@ test_that("deduped(f) preserves random attributes", { test_that("deduped(f) warns on matrices or data frames", { pass_through <- \(i) i - expect_warning( - deduped(pass_through)(matrix(1:10)) - ) - - expect_warning( - deduped(pass_through)(data.frame(1:10)) - ) + expect_warning(deduped(pass_through)(matrix(1:10))) + expect_warning(deduped(pass_through)(x = data.frame(1:10))) }) test_that("deduped(f) fails on functions that change length", { expect_error( - deduped(min)(1:10) + deduped(min)(c(1:10, 1L)), + regexp = "reduced 10 unique value\\(s\\) to 1" ) -}) - -test_that("deduped(f) preserves attributes added by f, e.g. fs::path", { - skip_if_not_installed("fs") - # Checks for attributes and class types - expect_identical( - deduped(fs::path)("x", "y"), - fs::path("x", "y") + # Note: No error if the input has no duplication, due to early exit path. + expect_no_error( + deduped(min)(1:10) ) }) diff --git a/tests/testthat/test-with_deduped.R b/tests/testthat/test-with_deduped.R index c88e0a3..c7743cf 100644 --- a/tests/testthat/test-with_deduped.R +++ b/tests/testthat/test-with_deduped.R @@ -37,8 +37,8 @@ test_that("with_deduped(f(x, y)) is the same as deduped(f)(x, y) (int)", { # Named arguments expect_equal( - deduped(increment_by_n)(x, n=inc), - expect_no_warning(increment_by_n(x, n=inc) |> with_deduped()) + deduped(increment_by_n)(x, n = inc), + expect_no_warning(increment_by_n(x, n = inc) |> with_deduped()) ) }) @@ -49,3 +49,37 @@ test_that("with_deduped(f(x, y)) is the same as deduped(f)(x, y) (char)", { expect_no_warning(paste0(x, "X") |> with_deduped()) ) }) + +test_that("with_deduped errors on non-call expressions", { + x <- c("A", "A", "B") + expect_error( + with_deduped(x), + regexp = "must be a function call" + ) +}) + +test_that("with_deduped errors on calls with no first argument", { + expect_error( + with_deduped(f()), + regexp = "has no first argument" + ) +}) + +test_that("with_deduped works with nested calls", { + x <- c("a ", " b", "a ") + # with_deduped should deduplicate on the innermost first argument + expect_identical( + trimws(tolower(x)) |> with_deduped(), + trimws(tolower(x)) + ) +}) + +test_that("with_deduped resolves variables in the calling environment", { + make_result <- function(x) { + suffix <- "_test" + paste0(x, suffix) |> with_deduped() + } + + x <- c("a", "b", "a") + expect_identical(make_result(x), paste0(x, "_test")) +}) From 6401fcda54b00e72a84c5491c6a8b60d1e721b2e Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 14:49:17 -0700 Subject: [PATCH 11/13] Simplified deduped name-handling behavior, and added a `verbose` argument with messaging. Updated tests. --- R/deduped.R | 64 ++++++++++++++++++++++-------- R/with_deduped.R | 10 +++-- R/zzz.R | 5 +++ README.Rmd | 22 ++++++++++ README.md | 38 +++++++++++++++--- renv.lock | 24 ++++++----- tests/testthat/test-deduped.R | 58 ++++++++++++++++++++++++++- tests/testthat/test-with_deduped.R | 8 ++++ 8 files changed, 192 insertions(+), 37 deletions(-) create mode 100644 R/zzz.R diff --git a/R/deduped.R b/R/deduped.R index b8d96ed..0b8ffc6 100644 --- a/R/deduped.R +++ b/R/deduped.R @@ -8,15 +8,18 @@ #' Note: This only works with functions that preserve length and order. #' #' @details -#' Names are taken from the input `x` rather than from `f`'s output on the -#' unique values, since `funique`/`unique` may drop names before `f` is called. -#' This means input names are always preserved when present, but renaming by -#' `f` (e.g. `setNames(x, paste0("out_", x))`) will be silently ignored. -#' If `f` renames its output, call it directly rather than wrapping with -#' `deduped()`. +#' 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 @@ -45,11 +48,19 @@ #' }) #' #' 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. @@ -78,16 +89,25 @@ deduped <- function(f) { # 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 (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 (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, ...) @@ -104,17 +124,27 @@ deduped <- function(f) { # Restore attributes from uf (what f produced), which covers whole-vector - # attributes like `class` and `levels`. For names, we use x's original names - # if x was named — we don't infer from uf's names since funique/unique may - # drop them. Position-based renaming by f is incompatible with deduplication - # regardless, since f is called on unique values only. 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. + # 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) - attrs$names <- if (!is.null(names(x))) names(x) else NULL + + # 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 } } diff --git a/R/with_deduped.R b/R/with_deduped.R index 2d256ff..1ba9e9a 100644 --- a/R/with_deduped.R +++ b/R/with_deduped.R @@ -28,6 +28,10 @@ #' @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 @@ -60,7 +64,7 @@ #' }) #' #' all(y1 == y2) -with_deduped <- function(expr, env = parent.frame()) { +with_deduped <- function(expr, env = parent.frame(), verbose = NULL) { call_tree <- substitute(expr) if (!is.call(call_tree)) stop("`expr` must be a function call expression, e.g. `f(x) |> with_deduped()`.") @@ -96,6 +100,6 @@ with_deduped <- function(expr, env = parent.frame()) { # Evaluate the target data in the USER'S environment target_data <- eval(result$target, envir = env) - # Optimization Logic - deduped(f_wrapper)(target_data) + # Actual deduplication + deduped(f_wrapper, verbose = verbose)(target_data) } diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..3686845 --- /dev/null +++ b/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) +} diff --git a/README.Rmd b/README.Rmd index 802d116..2726bbc 100644 --- a/README.Rmd +++ b/README.Rmd @@ -137,3 +137,25 @@ 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) +) +``` diff --git a/README.md b/README.md index bae4482..e4bae4a 100644 --- a/README.md +++ b/README.md @@ -65,12 +65,12 @@ length(duplicated_vec) system.time({ x1 <- slow_tolower(duplicated_vec) }) #> user system elapsed -#> 0.07 0.01 6.50 +#> 0.02 0.00 6.73 system.time({ x2 <- deduped(slow_tolower)(duplicated_vec) }) #> user system elapsed -#> 0.09 0.00 0.85 +#> 0.08 0.00 0.17 all.equal(x1, x2) #> [1] TRUE @@ -100,7 +100,7 @@ length(duplicated_list) system.time({ y1 <- lapply(duplicated_list, slow_tolower) }) #> user system elapsed -#> 0.00 0.00 3.69 +#> 0.03 0.00 3.90 system.time({ y2 <- deduped(lapply)(duplicated_list, slow_tolower) }) #> user system elapsed #> 0.00 0.00 0.09 @@ -128,10 +128,10 @@ length(dup_paths) system.time({ y1 <- fs::path_rel(dup_paths, start=top_path) }) #> user system elapsed -#> 4.00 0.02 4.11 +#> 6.16 0.05 6.35 system.time({ y2 <- deduped(fs::path_rel)(dup_paths, start=top_path) }) #> user system elapsed -#> 0.00 0.00 0.02 +#> 0.01 0.00 0.01 all.equal(y1, y2) #> [1] TRUE @@ -151,3 +151,31 @@ 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 +head( + deduped(slow_tolower, verbose = TRUE)(duplicated_vec) +) +#> deduped: 500 value(s) reduced to 5 unique (99.0% reduction). +#> [1] "y" "a" "b" "y" "d" "d" + +# Also available in `with_deduped()`: +head( + slow_tolower(duplicated_vec) |> with_deduped(verbose = TRUE) +) +#> deduped: 500 value(s) reduced to 5 unique (99.0% reduction). +#> [1] "y" "a" "b" "y" "d" "d" + +# Use `options(deduped.verbose)` to enable for the entire session. +options(deduped.verbose = TRUE) +head( + deduped(slow_tolower)(duplicated_vec) +) +#> deduped: 500 value(s) reduced to 5 unique (99.0% reduction). +#> [1] "y" "a" "b" "y" "d" "d" +``` diff --git a/renv.lock b/renv.lock index be81291..e73baca 100644 --- a/renv.lock +++ b/renv.lock @@ -11,12 +11,15 @@ "Packages": { "Rcpp": { "Package": "Rcpp", - "Version": "1.0.14", + "Version": "1.1.1-1.1", "Source": "Repository", "Title": "Seamless R and C++ Integration", - "Date": "2025-01-11", + "Date": "2026-04-19", "Authors@R": "c(person(\"Dirk\", \"Eddelbuettel\", role = c(\"aut\", \"cre\"), email = \"edd@debian.org\", comment = c(ORCID = \"0000-0001-6419-907X\")), person(\"Romain\", \"Francois\", role = \"aut\", comment = c(ORCID = \"0000-0002-2444-4226\")), person(\"JJ\", \"Allaire\", role = \"aut\", comment = c(ORCID = \"0000-0003-0174-9868\")), person(\"Kevin\", \"Ushey\", role = \"aut\", comment = c(ORCID = \"0000-0003-2880-7407\")), person(\"Qiang\", \"Kou\", role = \"aut\", comment = c(ORCID = \"0000-0001-6786-5453\")), person(\"Nathan\", \"Russell\", role = \"aut\"), person(\"Iñaki\", \"Ucar\", role = \"aut\", comment = c(ORCID = \"0000-0001-6403-5550\")), person(\"Doug\", \"Bates\", role = \"aut\", comment = c(ORCID = \"0000-0001-8316-9503\")), person(\"John\", \"Chambers\", role = \"aut\"))", "Description": "The 'Rcpp' package provides R functions as well as C++ classes which offer a seamless integration of R and C++. Many R data types and objects can be mapped back and forth to C++ equivalents which facilitates both writing of new code as well as easier integration of third-party libraries. Documentation about 'Rcpp' is provided by several vignettes included in this package, via the 'Rcpp Gallery' site at , the paper by Eddelbuettel and Francois (2011, ), the book by Eddelbuettel (2013, ) and the paper by Eddelbuettel and Balamuta (2018, ); see 'citation(\"Rcpp\")' for details.", + "Depends": [ + "R (>= 3.5.0)" + ], "Imports": [ "methods", "utils" @@ -33,21 +36,22 @@ "MailingList": "rcpp-devel@lists.r-forge.r-project.org", "RoxygenNote": "6.1.1", "Encoding": "UTF-8", + "VignetteBuilder": "Rcpp", "NeedsCompilation": "yes", - "Author": "Dirk Eddelbuettel [aut, cre] (), Romain Francois [aut] (), JJ Allaire [aut] (), Kevin Ushey [aut] (), Qiang Kou [aut] (), Nathan Russell [aut], Iñaki Ucar [aut] (), Doug Bates [aut] (), John Chambers [aut]", + "Author": "Dirk Eddelbuettel [aut, cre] (ORCID: ), Romain Francois [aut] (ORCID: ), JJ Allaire [aut] (ORCID: ), Kevin Ushey [aut] (ORCID: ), Qiang Kou [aut] (ORCID: ), Nathan Russell [aut], Iñaki Ucar [aut] (ORCID: ), Doug Bates [aut] (ORCID: ), John Chambers [aut]", "Maintainer": "Dirk Eddelbuettel ", "Repository": "CRAN" }, "collapse": { "Package": "collapse", - "Version": "2.1.2", + "Version": "2.1.7", "Source": "Repository", "Title": "Advanced and Fast Data Transformation", - "Date": "2025-05-24", - "Authors@R": "c( person(\"Sebastian\", \"Krantz\", role = c(\"aut\", \"cre\"), email = \"sebastian.krantz@graduateinstitute.ch\", comment = c(ORCID = \"0000-0001-6212-5229\")), person(\"Matt\", \"Dowle\", role = \"ctb\"), person(\"Arun\", \"Srinivasan\", role = \"ctb\"), person(\"Morgan\", \"Jacob\", role = \"ctb\"), person(\"Dirk\", \"Eddelbuettel\", role = \"ctb\"), person(\"Laurent\", \"Berge\", role = \"ctb\"), person(\"Kevin\", \"Tappe\", role = \"ctb\"), person(\"Alina\", \"Cherkas\", role = \"ctb\"), person(\"R Core Team and contributors worldwide\", role = \"ctb\"), person(\"Martyn\", \"Plummer\", role = \"cph\"), person(\"1999-2016 The R Core Team\", role = \"cph\") )", - "Description": "A large C/C++-based package for advanced data transformation and statistical computing in R that is extremely fast, class-agnostic, robust, and programmer friendly. Core functionality includes a rich set of S3 generic grouped and weighted statistical functions for vectors, matrices and data frames, which provide efficient low-level vectorizations, OpenMP multithreading, and skip missing values by default. These are integrated with fast grouping and ordering algorithms (also callable from C), and efficient data manipulation functions. The package also provides a flexible and rigorous approach to time series and panel data in R, fast functions for data transformation and common statistical procedures, detailed (grouped, weighted) summary statistics, powerful tools to work with nested data, fast data object conversions, functions for memory efficient R programming, and helpers to effectively deal with variable labels, attributes, and missing data. It seamlessly supports base R objects/classes as well as 'units', 'integer64', 'xts'/ 'zoo', 'tibble', 'grouped_df', 'data.table', 'sf', and 'pseries'/'pdata.frame'.", - "URL": "https://sebkrantz.github.io/collapse/, https://github.com/SebKrantz/collapse", - "BugReports": "https://github.com/SebKrantz/collapse/issues", + "Date": "2026-05-17", + "Authors@R": "c( person(\"Sebastian\", \"Krantz\", role = c(\"aut\", \"cre\"), email = \"sebastian.krantz@graduateinstitute.ch\", comment = c(ORCID = \"0000-0001-6212-5229\")), person(\"Matt\", \"Dowle\", role = \"ctb\"), person(\"Arun\", \"Srinivasan\", role = \"ctb\"), person(\"Morgan\", \"Jacob\", role = \"ctb\"), person(\"Dirk\", \"Eddelbuettel\", role = \"ctb\"), person(\"Laurent\", \"Berge\", role = \"ctb\"), person(\"Kevin\", \"Tappe\", role = \"ctb\"), person(\"Alina\", \"Cherkas\", role = \"ctb\"), person(\"Ivan\", \"Krylov\", role = \"ctb\"), person(\"R Core Team and contributors worldwide\", role = \"ctb\"), person(\"Martyn\", \"Plummer\", role = \"cph\"), person(\"1999-2016 The R Core Team\", role = \"cph\") )", + "Description": "A large C/C++-based package for advanced data transformation and statistical computing in R that is extremely fast, class-agnostic, robust, and programmer friendly. Core functionality includes a rich set of S3 generic grouped and weighted statistical functions for vectors, matrices and data frames, which provide efficient low-level vectorizations, OpenMP multithreading, and skip missing values by default. These are integrated with fast grouping and ordering algorithms (also callable from C), and efficient data manipulation functions. The package also provides a flexible and rigorous approach to time series and panel data in R, fast functions for data transformation and common statistical procedures, detailed (grouped, weighted) summary statistics, powerful tools to work with nested data, fast data object conversions, functions for memory efficient R programming, and helpers to effectively deal with variable labels, attributes, and missing data. It seamlessly supports base R objects/classes as well as 'units', 'integer64', 'xts'/ 'zoo', 'tibble', 'grouped_df', 'data.table', 'sf', and 'pseries'/'pdata.frame'. For a concise overview of the package see Krantz (2026) .", + "URL": "https://fastverse.org/collapse/, https://github.com/fastverse/collapse", + "BugReports": "https://github.com/fastverse/collapse/issues", "License": "GPL (>= 2) | file LICENSE", "Encoding": "UTF-8", "LazyData": "true", @@ -86,7 +90,7 @@ ], "VignetteBuilder": "knitr", "NeedsCompilation": "yes", - "Author": "Sebastian Krantz [aut, cre] (ORCID: ), Matt Dowle [ctb], Arun Srinivasan [ctb], Morgan Jacob [ctb], Dirk Eddelbuettel [ctb], Laurent Berge [ctb], Kevin Tappe [ctb], Alina Cherkas [ctb], R Core Team and contributors worldwide [ctb], Martyn Plummer [cph], 1999-2016 The R Core Team [cph]", + "Author": "Sebastian Krantz [aut, cre] (ORCID: ), Matt Dowle [ctb], Arun Srinivasan [ctb], Morgan Jacob [ctb], Dirk Eddelbuettel [ctb], Laurent Berge [ctb], Kevin Tappe [ctb], Alina Cherkas [ctb], Ivan Krylov [ctb], R Core Team and contributors worldwide [ctb], Martyn Plummer [cph], 1999-2016 The R Core Team [cph]", "Maintainer": "Sebastian Krantz ", "Repository": "CRAN" }, diff --git a/tests/testthat/test-deduped.R b/tests/testthat/test-deduped.R index ea4de3b..29aab64 100644 --- a/tests/testthat/test-deduped.R +++ b/tests/testthat/test-deduped.R @@ -51,8 +51,8 @@ test_that("deduped(f) returns the data in the same order", { expect_equal(deduped(pass_through)(x), x) }) -test_that("deduped(f) works on lists", { - x <- list("ABC", "ABC") +test_that("deduped(f) works on unnamed lists", { + x <- list("ABC", "DEF", "ABC") expect_equal( deduped(tolower)(x), tolower(x) @@ -80,6 +80,15 @@ test_that("deduped(f) preserves names on named lists", { ) }) +test_that("deduped(f) drops names on named lists when f drops names", { + # tolower() does not preserve names on lists. + x <- list(p = "ABC", q = "DEF", p = "ABC") + expect_identical( + deduped(tolower)(x), + tolower(x) + ) +}) + test_that("deduped(f) preserves class from f's output", { add_class <- function(x) structure(tolower(x), class = "my_class") @@ -109,6 +118,7 @@ test_that("deduped(f) preserves non-name attributes on x", { ) }) + test_that("deduped(f) warns on matrices or data frames", { pass_through <- \(i) i @@ -127,3 +137,47 @@ test_that("deduped(f) fails on functions that change length", { deduped(min)(1:10) ) }) + +test_that("deduped(f, verbose=TRUE) prints reduction info", { + x <- c("A", "B", "A", "A") + expect_message( + deduped(tolower, verbose = TRUE)(x), + regexp = "4 value\\(s\\) reduced to 2 unique" + ) +}) + +test_that("deduped(f) respects deduped.verbose option", { + x <- c("A", "B", "A", "A") + withr::with_options( + list(deduped.verbose = TRUE), + expect_message( + deduped(tolower)(x), + regexp = "4 value\\(s\\) reduced to 2 unique" + ) + ) +}) + +test_that("deduped(f, verbose=FALSE) suppresses messages even when option is TRUE", { + x <- c("A", "B", "A", "A") + withr::with_options( + list(deduped.verbose = TRUE), + expect_no_message( + deduped(tolower, verbose = FALSE)(x) + ) + ) +}) + +test_that("deduped(f, verbose=TRUE) messages on all early exit paths", { + expect_message( + deduped(tolower, verbose = TRUE)(character(0)), + regexp = "1 or fewer elements" + ) + expect_message( + deduped(tolower, verbose = TRUE)("A"), + regexp = "1 or fewer elements" + ) + expect_message( + deduped(tolower, verbose = TRUE)(c("A", "B", "C")), + regexp = "no duplication found" + ) +}) diff --git a/tests/testthat/test-with_deduped.R b/tests/testthat/test-with_deduped.R index c7743cf..452b01a 100644 --- a/tests/testthat/test-with_deduped.R +++ b/tests/testthat/test-with_deduped.R @@ -83,3 +83,11 @@ test_that("with_deduped resolves variables in the calling environment", { x <- c("a", "b", "a") expect_identical(make_result(x), paste0(x, "_test")) }) + +test_that("with_deduped respects verbose argument", { + x <- c("A", "B", "A", "A") + expect_message( + tolower(x) |> with_deduped(verbose = TRUE), + regexp = "4 value\\(s\\) reduced to 2 unique" + ) +}) From 085124ce695aa22c919a0cdddc45191070ded3b8 Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 14:53:07 -0700 Subject: [PATCH 12/13] Update .Rd files --- man/deduped.Rd | 20 +++++++++++++------- man/with_deduped.Rd | 7 ++++++- 2 files changed, 19 insertions(+), 8 deletions(-) diff --git a/man/deduped.Rd b/man/deduped.Rd index 9f1783d..0751389 100644 --- a/man/deduped.Rd +++ b/man/deduped.Rd @@ -4,11 +4,16 @@ \alias{deduped} \title{Deduplicate a vectorized function to act on \emph{unique} elements} \usage{ -deduped(f) +deduped(f, verbose = NULL) } \arguments{ \item{f}{A length-preserving, order-preserving function that accepts a vector or list as its first input.} + +\item{verbose}{If \code{TRUE}, prints the number of unique values and reduction +percentage on each call. If \code{NULL} (default), reads +\code{getOption("deduped.verbose", FALSE)} at call time, so setting +\code{options(deduped.verbose = TRUE)} enables it for the entire session.} } \value{ Deduplicated version of \code{f}. @@ -21,12 +26,13 @@ it is the same as if the computation was performed on all elements. Note: This only works with functions that preserve length and order. } \details{ -Names are taken from the input \code{x} rather than from \code{f}'s output on the -unique values, since \code{funique}/\code{unique} may drop names before \code{f} is called. -This means input names are always preserved when present, but renaming by -\code{f} (e.g. \code{setNames(x, paste0("out_", x))}) will be silently ignored. -If \code{f} renames its output, call it directly rather than wrapping with -\code{deduped()}. +We make a best effort to preserve the two main cases for named inputs: +\enumerate{ +\item If \code{f()} drops names, names are dropped in the output. +\item Otherwise, we preserve the names from the input \code{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. +} } \examples{ diff --git a/man/with_deduped.Rd b/man/with_deduped.Rd index a2252dd..5ea0872 100644 --- a/man/with_deduped.Rd +++ b/man/with_deduped.Rd @@ -4,13 +4,18 @@ \alias{with_deduped} \title{Deduplicate the first argument in an expression} \usage{ -with_deduped(expr, env = parent.frame()) +with_deduped(expr, env = parent.frame(), verbose = NULL) } \arguments{ \item{expr}{The expression to evaluate.} \item{env}{The environment within which to evaluate the expression. Can be modified when calling inside other functions.} + +\item{verbose}{If \code{TRUE}, prints the number of unique values and reduction +percentage on each call. If \code{NULL} (default), reads +\code{getOption("deduped.verbose", FALSE)} at call time, so setting +\code{options(deduped.verbose = TRUE)} enables it for the entire session.} } \value{ The result of evaluating the expression. From 53360a1f7fde676e4a1eb4463bfb1077f74ac740 Mon Sep 17 00:00:00 2001 From: orgadish <48453207+orgadish@users.noreply.github.com> Date: Sun, 14 Jun 2026 20:18:58 -0700 Subject: [PATCH 13/13] Update DESCRIPTION, NEWS, cran-comments, WORDLIST --- DESCRIPTION | 2 +- NEWS.md | 23 +++++++++++++++++++++++ cran-comments.md | 31 +++++++++++++++++++++++++++++++ inst/WORDLIST | 3 +++ 4 files changed, 58 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9c4d87c..5f1d8f5 100644 --- a/DESCRIPTION +++ b/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, diff --git a/NEWS.md b/NEWS.md index 58a0076..ea4d03a 100644 --- a/NEWS.md +++ b/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. diff --git a/cran-comments.md b/cran-comments.md index 86ccbc2..9fcde81 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,3 +1,34 @@ +# Resubmission: deduped 0.5.0 + +## New 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.) +* Added more comprehensive tests for existing and new behavior. + + +## R CMD check results + +── R CMD check results ────────────────────────────────────────────────────── deduped 0.5.0 ──── +Duration: 31.3s + +0 errors ✔ | 0 warnings ✔ | 0 notes ✔ + # Resubmission: deduped 0.4.0 Updated helpers to properly maintain and handle attributes, including named vectors. Removed dependency on `fastmatch::fmatch` and replaced with `collapse::fmatch` which diff --git a/inst/WORDLIST b/inst/WORDLIST index 428d744..886d772 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -6,3 +6,6 @@ deduplicated deduplication vectorized README +benchmarking +cran +github