diff --git a/DESCRIPTION b/DESCRIPTION index 1a4a453..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, @@ -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/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/R/deduped.R b/R/deduped.R index 48b813d..0b8ffc6 100644 --- a/R/deduped.R +++ b/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 } } 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/R/with_deduped.R b/R/with_deduped.R index 5392447..1ba9e9a 100644 --- a/R/with_deduped.R +++ b/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) } 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 c3a163a..2726bbc 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,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) +) +``` diff --git a/README.md b/README.md index 513de71..e4bae4a 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.02 0.00 6.73 system.time({ x2 <- deduped(slow_tolower)(duplicated_vec) }) #> user system elapsed -#> 0.04 0.00 0.15 +#> 0.08 0.00 0.17 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.03 0.00 3.90 system.time({ y2 <- deduped(lapply)(duplicated_list, slow_tolower) }) #> user system elapsed #> 0.00 0.00 0.09 @@ -127,7 +128,7 @@ length(dup_paths) system.time({ y1 <- fs::path_rel(dup_paths, start=top_path) }) #> user system elapsed -#> 3.96 0.03 3.99 +#> 6.16 0.05 6.35 system.time({ y2 <- deduped(fs::path_rel)(dup_paths, start=top_path) }) #> user system elapsed #> 0.01 0.00 0.01 @@ -135,3 +136,46 @@ system.time({ y2 <- deduped(fs::path_rel)(dup_paths, start=top_path) }) 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() +``` + +### `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/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 diff --git a/man/deduped.Rd b/man/deduped.Rd index 637685d..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}. @@ -20,6 +25,15 @@ 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{ +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{ x <- sample(LETTERS, 10) 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{