purrr/ 0000755 0001762 0000144 00000000000 14465116667 011444 5 ustar ligges users purrr/NAMESPACE 0000644 0001762 0000144 00000007523 14460273713 012661 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(as_mapper,character)
S3method(as_mapper,default)
S3method(as_mapper,list)
S3method(as_mapper,numeric)
S3method(print,purrr_function_compose)
S3method(print,purrr_function_partial)
S3method(print,purrr_rate_backoff)
S3method(print,purrr_rate_delay)
S3method(rate_sleep,purrr_rate_backoff)
S3method(rate_sleep,purrr_rate_delay)
export("%>%")
export("%@%")
export("%||%")
export("pluck<-")
export(accumulate)
export(accumulate2)
export(accumulate_right)
export(array_branch)
export(array_tree)
export(as_mapper)
export(as_vector)
export(assign_in)
export(at_depth)
export(attr_getter)
export(auto_browse)
export(chuck)
export(compact)
export(compose)
export(cross)
export(cross2)
export(cross3)
export(cross_d)
export(cross_df)
export(cross_n)
export(detect)
export(detect_index)
export(discard)
export(discard_at)
export(done)
export(every)
export(exec)
export(flatten)
export(flatten_chr)
export(flatten_dbl)
export(flatten_df)
export(flatten_dfc)
export(flatten_dfr)
export(flatten_int)
export(flatten_lgl)
export(flatten_raw)
export(has_element)
export(head_while)
export(imap)
export(imap_chr)
export(imap_dbl)
export(imap_dfc)
export(imap_dfr)
export(imap_int)
export(imap_lgl)
export(imap_raw)
export(imodify)
export(insistently)
export(invoke)
export(invoke_map)
export(invoke_map_chr)
export(invoke_map_dbl)
export(invoke_map_df)
export(invoke_map_dfc)
export(invoke_map_dfr)
export(invoke_map_int)
export(invoke_map_lgl)
export(invoke_map_raw)
export(is_atomic)
export(is_bare_atomic)
export(is_bare_character)
export(is_bare_double)
export(is_bare_integer)
export(is_bare_list)
export(is_bare_logical)
export(is_bare_numeric)
export(is_bare_vector)
export(is_character)
export(is_double)
export(is_empty)
export(is_formula)
export(is_function)
export(is_integer)
export(is_list)
export(is_logical)
export(is_null)
export(is_rate)
export(is_scalar_atomic)
export(is_scalar_character)
export(is_scalar_double)
export(is_scalar_integer)
export(is_scalar_list)
export(is_scalar_logical)
export(is_scalar_vector)
export(is_vector)
export(iwalk)
export(keep)
export(keep_at)
export(lift)
export(lift_dl)
export(lift_dv)
export(lift_ld)
export(lift_lv)
export(lift_vd)
export(lift_vl)
export(list_along)
export(list_assign)
export(list_c)
export(list_cbind)
export(list_flatten)
export(list_merge)
export(list_modify)
export(list_rbind)
export(list_simplify)
export(list_transpose)
export(lmap)
export(lmap_at)
export(lmap_if)
export(map)
export(map2)
export(map2_chr)
export(map2_dbl)
export(map2_df)
export(map2_dfc)
export(map2_dfr)
export(map2_int)
export(map2_lgl)
export(map2_raw)
export(map2_vec)
export(map_at)
export(map_chr)
export(map_dbl)
export(map_depth)
export(map_df)
export(map_dfc)
export(map_dfr)
export(map_if)
export(map_int)
export(map_lgl)
export(map_raw)
export(map_vec)
export(modify)
export(modify2)
export(modify_at)
export(modify_depth)
export(modify_if)
export(modify_in)
export(modify_tree)
export(negate)
export(none)
export(partial)
export(pluck)
export(pluck_depth)
export(pluck_exists)
export(pmap)
export(pmap_chr)
export(pmap_dbl)
export(pmap_df)
export(pmap_dfc)
export(pmap_dfr)
export(pmap_int)
export(pmap_lgl)
export(pmap_raw)
export(pmap_vec)
export(possibly)
export(prepend)
export(pwalk)
export(quietly)
export(rate_backoff)
export(rate_delay)
export(rate_reset)
export(rate_sleep)
export(rbernoulli)
export(rdunif)
export(reduce)
export(reduce2)
export(reduce2_right)
export(reduce_right)
export(rep_along)
export(rerun)
export(safely)
export(set_names)
export(simplify)
export(simplify_all)
export(slowly)
export(some)
export(splice)
export(tail_while)
export(transpose)
export(update_list)
export(vec_depth)
export(walk)
export(walk2)
export(when)
export(zap)
import(rlang)
import(vctrs)
importFrom(cli,cli_progress_bar)
importFrom(lifecycle,deprecated)
importFrom(magrittr,"%>%")
useDynLib(purrr, .registration = TRUE)
purrr/LICENSE 0000644 0001762 0000144 00000000053 14304371054 012430 0 ustar ligges users YEAR: 2020
COPYRIGHT HOLDER: purrr authors
purrr/tools/ 0000755 0001762 0000144 00000000000 14330306457 012571 5 ustar ligges users purrr/tools/examples.R 0000644 0001762 0000144 00000001040 14330306457 014525 0 ustar ligges users if (getRversion() < "4.1") {
dir.create("man/macros", showWarnings = FALSE, recursive = TRUE)
cat(
paste(
"\\renewcommand{\\examples}{\\section{Examples}{",
"These examples are designed to work in R >= 4.1 so that we can take",
"advantage of modern syntax like the base pipe (\\verb{|>}) and the ",
"function shorthand (\\verb{\\(x) x + 1}). They might not work on the ",
"version of R that you're using.",
"\\preformatted{#1}}}",
collapse = ""
),
file = "man/macros/examples.Rd"
)
}
purrr/README.md 0000644 0001762 0000144 00000005015 14355574066 012723 0 ustar ligges users
# purrr
[](https://cran.r-project.org/package=purrr)
[](https://app.codecov.io/gh/tidyverse/purrr?branch=master)
[](https://github.com/tidyverse/purrr/actions)
## Overview
purrr enhances R’s functional programming (FP) toolkit by providing a
complete and consistent set of tools for working with functions and
vectors. If you’ve never heard of FP before, the best place to start is
the family of `map()` functions which allow you to replace many for
loops with code that is both more succinct and easier to read. The best
place to learn about the `map()` functions is the [iteration
chapter](https://r4ds.had.co.nz/iteration.html) in R for data science.
## Installation
``` r
# The easiest way to get purrr is to install the whole tidyverse:
install.packages("tidyverse")
# Alternatively, install just purrr:
install.packages("purrr")
# Or the the development version from GitHub:
# install.packages("remotes")
remotes::install_github("tidyverse/purrr")
```
## Cheatsheet
## Usage
The following example uses purrr to solve a fairly realistic problem:
split a data frame into pieces, fit a model to each piece, compute the
summary, then extract the R2.
``` r
library(purrr)
mtcars |>
split(mtcars$cyl) |> # from base R
map(\(df) lm(mpg ~ wt, data = df)) |>
map(summary) %>%
map_dbl("r.squared")
#> 4 6 8
#> 0.5086326 0.4645102 0.4229655
```
This example illustrates some of the advantages of purrr functions over
the equivalents in base R:
- The first argument is always the data, so purrr works naturally with
the pipe.
- All purrr functions are type-stable. They always return the advertised
output type (`map()` returns lists; `map_dbl()` returns double
vectors), or they throw an error.
- All `map()` functions accept functions (named, anonymous, and lambda),
character vector (used to extract components by name), or numeric
vectors (used to extract by position).
purrr/man/ 0000755 0001762 0000144 00000000000 14464464653 012217 5 ustar ligges users purrr/man/pmap.Rd 0000644 0001762 0000144 00000011154 14460311734 013430 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pmap.R
\name{pmap}
\alias{pmap}
\alias{pmap_lgl}
\alias{pmap_int}
\alias{pmap_dbl}
\alias{pmap_chr}
\alias{pmap_vec}
\alias{pwalk}
\title{Map over multiple input simultaneously (in "parallel")}
\usage{
pmap(.l, .f, ..., .progress = FALSE)
pmap_lgl(.l, .f, ..., .progress = FALSE)
pmap_int(.l, .f, ..., .progress = FALSE)
pmap_dbl(.l, .f, ..., .progress = FALSE)
pmap_chr(.l, .f, ..., .progress = FALSE)
pmap_vec(.l, .f, ..., .ptype = NULL, .progress = FALSE)
pwalk(.l, .f, ..., .progress = FALSE)
}
\arguments{
\item{.l}{A list of vectors. The length of \code{.l} determines the number of
arguments that \code{.f} will be called with. Arguments will be supply by
position if unnamed, and by name if named.
Vectors of length 1 will be recycled to any length; all other elements
must be have the same length.
A data frame is an important special case of \code{.l}. It will cause \code{.f}
to be called once for each row.}
\item{.f}{A function, specified in one of the following ways:
\itemize{
\item A named function.
\item An anonymous function, e.g. \verb{\\(x, y, z) x + y / z} or
\code{function(x, y, z) x + y / z}
\item A formula, e.g. \code{~ ..1 + ..2 / ..3}. This syntax is not recommended as
you can only refer to arguments by position.
}}
\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{progress_bars} for more details.}
\item{.ptype}{If \code{NULL}, the default, the output type is the common type
of the elements of the result. Otherwise, supply a "prototype" giving
the desired type of output.}
}
\value{
The output length is determined by the length of the input.
The output names are determined by the input names.
The output type is determined by the suffix:
\itemize{
\item No suffix: a list; \code{.f()} can return anything.
\item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double,
or character vector respectively; \code{.f()} must return a compatible atomic
vector of length 1.
\item \verb{_vec()} return an atomic or S3 vector, the same type that \code{.f} returns.
\code{.f} can return pretty much any type of vector, as long as its length 1.
\item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to
use in a pipe. The return value of \code{.f()} is ignored.
}
Any errors thrown by \code{.f} will be wrapped in an error with class
\link{purrr_error_indexed}.
}
\description{
These functions are variants of \code{\link[=map]{map()}} that iterate over multiple arguments
simultaneously. They are parallel in the sense that each input is processed
in parallel with the others, not in the sense of multicore computing, i.e.
they share the same notion of "parallel" as \code{\link[base:Extremes]{base::pmax()}} and \code{\link[base:Extremes]{base::pmin()}}.
}
\examples{
x <- list(1, 1, 1)
y <- list(10, 20, 30)
z <- list(100, 200, 300)
pmap(list(x, y, z), sum)
# Matching arguments by position
pmap(list(x, y, z), function(first, second, third) (first + third) * second)
# Matching arguments by name
l <- list(a = x, b = y, c = z)
pmap(l, function(c, b, a) (a + c) * b)
# Vectorizing a function over multiple arguments
df <- data.frame(
x = c("apple", "banana", "cherry"),
pattern = c("p", "n", "h"),
replacement = c("P", "N", "H"),
stringsAsFactors = FALSE
)
pmap(df, gsub)
pmap_chr(df, gsub)
# Use `...` to absorb unused components of input list .l
df <- data.frame(
x = 1:3,
y = 10:12,
z = letters[1:3]
)
plus <- function(x, y) x + y
\dontrun{
# this won't work
pmap(df, plus)
}
# but this will
plus2 <- function(x, y, ...) x + y
pmap_dbl(df, plus2)
# The "p" for "parallel" in pmap() is the same as in base::pmin()
# and base::pmax()
df <- data.frame(
x = c(1, 2, 5),
y = c(5, 4, 8)
)
# all produce the same result
pmin(df$x, df$y)
map2_dbl(df$x, df$y, min)
pmap_dbl(df, min)
}
\seealso{
Other map variants:
\code{\link{imap}()},
\code{\link{lmap}()},
\code{\link{map2}()},
\code{\link{map_depth}()},
\code{\link{map_if}()},
\code{\link{map}()},
\code{\link{modify}()}
}
\concept{map variants}
purrr/man/list_transpose.Rd 0000644 0001762 0000144 00000005713 14313364271 015551 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list-transpose.R
\name{list_transpose}
\alias{list_transpose}
\title{Transpose a list}
\usage{
list_transpose(
x,
...,
template = NULL,
simplify = NA,
ptype = NULL,
default = NULL
)
}
\arguments{
\item{x}{A list of vectors to transpose.}
\item{...}{These dots are for future extensions and must be empty.}
\item{template}{A "template" that describes the output list. Can either be
a character vector (where elements are extracted by name), or an integer
vector (where elements are extracted by position). Defaults to the names
of the first element of \code{x}, or if they're not present, the integer
indices.}
\item{simplify}{Should the result be \link[=list_simplify]{simplified}?
\itemize{
\item \code{TRUE}: simplify or die trying.
\item \code{NA}: simplify if possible.
\item \code{FALSE}: never try to simplify, always leaving as a list.
}
Alternatively, a named list specifying the simplification by output
element.}
\item{ptype}{An optional vector prototype used to control the simplification.
Alternatively, a named list specifying the prototype by output element.}
\item{default}{A default value to use if a value is absent or \code{NULL}.
Alternatively, a named list specifying the default by output element.}
}
\description{
\code{list_transpose()} turns a list-of-lists "inside-out". For instance it turns a pair of
lists into a list of pairs, or a list of pairs into a pair of lists. For
example, if you had a list of length \code{n} where each component had values \code{a}
and \code{b}, \code{list_transpose()} would make a list with elements \code{a} and
\code{b} that contained lists of length \code{n}.
It's called transpose because \code{x[["a"]][["b"]]} is equivalent to
\code{list_transpose(x)[["b"]][["a"]]}, i.e. transposing a list flips the order of
indices in a similar way to transposing a matrix.
}
\examples{
# list_transpose() is useful in conjunction with safely()
x <- list("a", 1, 2)
y <- x |> map(safely(log))
y |> str()
# Put all the errors and results together
y |> list_transpose() |> str()
# Supply a default result to further simplify
y |> list_transpose(default = list(result = NA)) |> str()
# list_transpose() will try to simplify by default:
x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6))
x |> list_transpose()
# this makes list_tranpose() not completely symmetric
x |> list_transpose() |> list_transpose()
# use simplify = FALSE to always return lists:
x |> list_transpose(simplify = FALSE) |> str()
x |>
list_transpose(simplify = FALSE) |>
list_transpose(simplify = FALSE) |> str()
# Provide an explicit template if you know which elements you want to extract
ll <- list(
list(x = 1, y = "one"),
list(z = "deux", x = 2)
)
ll |> list_transpose()
ll |> list_transpose(template = c("x", "y", "z"))
ll |> list_transpose(template = 1)
# And specify a default if you want to simplify
ll |> list_transpose(template = c("x", "y", "z"), default = NA)
}
purrr/man/array-coercion.Rd 0000644 0001762 0000144 00000003710 14311356421 015404 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/arrays.R
\name{array-coercion}
\alias{array-coercion}
\alias{array_branch}
\alias{array_tree}
\title{Coerce array to list}
\usage{
array_branch(array, margin = NULL)
array_tree(array, margin = NULL)
}
\arguments{
\item{array}{An array to coerce into a list.}
\item{margin}{A numeric vector indicating the positions of the
indices to be to be enlisted. If \code{NULL}, a full margin is
used. If \code{numeric(0)}, the array as a whole is wrapped in a
list.}
}
\description{
\code{array_branch()} and \code{array_tree()} enable arrays to be
used with purrr's functionals by turning them into lists. The
details of the coercion are controlled by the \code{margin}
argument. \code{array_tree()} creates an hierarchical list (a tree)
that has as many levels as dimensions specified in \code{margin},
while \code{array_branch()} creates a flat list (by analogy, a
branch) along all mentioned dimensions.
}
\details{
When no margin is specified, all dimensions are used by
default. When \code{margin} is a numeric vector of length zero, the
whole array is wrapped in a list.
}
\examples{
# We create an array with 3 dimensions
x <- array(1:12, c(2, 2, 3))
# A full margin for such an array would be the vector 1:3. This is
# the default if you don't specify a margin
# Creating a branch along the full margin is equivalent to
# as.list(array) and produces a list of size length(x):
array_branch(x) |> str()
# A branch along the first dimension yields a list of length 2
# with each element containing a 2x3 array:
array_branch(x, 1) |> str()
# A branch along the first and third dimensions yields a list of
# length 2x3 whose elements contain a vector of length 2:
array_branch(x, c(1, 3)) |> str()
# Creating a tree from the full margin creates a list of lists of
# lists:
array_tree(x) |> str()
# The ordering and the depth of the tree are controlled by the
# margin argument:
array_tree(x, c(3, 1)) |> str()
}
purrr/man/chuck.Rd 0000644 0001762 0000144 00000002471 14310436312 013564 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pluck.R
\name{chuck}
\alias{chuck}
\title{Get an element deep within a nested data structure, failing if it doesn't
exist}
\usage{
chuck(.x, ...)
}
\arguments{
\item{.x}{A vector or environment}
\item{...}{A list of accessors for indexing into the object. Can be
an positive integer, a negative integer (to index from the right),
a string (to index into names), or an accessor function
(except for the assignment variants which only support names and
positions). If the object being indexed is an S4 object,
accessing it by name will return the corresponding slot.
\link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if
your accessors are stored in a list, you can splice that in with
\verb{!!!}.}
}
\description{
\code{chuck()} implements a generalised form of \code{[[} that allow you to index
deeply and flexibly into data structures. If the index you are trying to
access does not exist (or is \code{NULL}), it will throw (i.e. chuck) an error.
}
\examples{
x <- list(a = 1, b = 2)
# When indexing an element that doesn't exist `[[` sometimes returns NULL:
x[["y"]]
# and sometimes errors:
try(x[[3]])
# chuck() consistently errors:
try(chuck(x, "y"))
try(chuck(x, 3))
}
\seealso{
\code{\link[=pluck]{pluck()}} for a quiet equivalent.
}
purrr/man/modify_in.Rd 0000644 0001762 0000144 00000003417 14311356421 014450 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pluck-assign.R
\name{modify_in}
\alias{modify_in}
\alias{assign_in}
\title{Modify a pluck location}
\usage{
modify_in(.x, .where, .f, ...)
assign_in(x, where, value)
}
\arguments{
\item{.x, x}{A vector or environment}
\item{.where, where}{A pluck location, as a numeric vector of
positions, a character vector of names, or a list combining both.
The location must exist in the data structure.}
\item{.f}{A function to apply at the pluck location given by \code{.where}.}
\item{...}{Arguments passed to \code{.f}.}
\item{value}{A value to replace in \code{.x} at the pluck location.
Use \code{zap()} to instead remove the element.}
}
\description{
\itemize{
\item \code{assign_in()} takes a data structure and a \link{pluck} location,
assigns a value there, and returns the modified data structure.
\item \code{modify_in()} applies a function to a pluck location, assigns the
result back to that location with \code{\link[=assign_in]{assign_in()}}, and returns the
modified data structure.
}
}
\examples{
# Recall that pluck() returns a component of a data structure that
# might be arbitrarily deep
x <- list(list(bar = 1, foo = 2))
pluck(x, 1, "foo")
# Use assign_in() to modify the pluck location:
str(assign_in(x, list(1, "foo"), 100))
# Or zap to remove it
str(assign_in(x, list(1, "foo"), zap()))
# Like pluck(), this works even when the element (or its parents) don't exist
pluck(x, 1, "baz")
str(assign_in(x, list(2, "baz"), 100))
# modify_in() applies a function to that location and update the
# element in place:
modify_in(x, list(1, "foo"), \(x) x * 200)
# Additional arguments are passed to the function in the ordinary way:
modify_in(x, list(1, "foo"), `+`, 100)
}
\seealso{
\code{\link[=pluck]{pluck()}}
}
purrr/man/rate_sleep.Rd 0000644 0001762 0000144 00000001434 14304371054 014614 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rate.R
\name{rate_sleep}
\alias{rate_sleep}
\alias{rate_reset}
\title{Wait for a given time}
\usage{
rate_sleep(rate, quiet = TRUE)
rate_reset(rate)
}
\arguments{
\item{rate}{A \link[=rate_backoff]{rate} object determining the waiting time.}
\item{quiet}{If \code{FALSE}, prints a message displaying how long until
the next request.}
}
\description{
If the rate's internal counter exceeds the maximum number of times
it is allowed to sleep, \code{rate_sleep()} throws an error of class
\code{purrr_error_rate_excess}.
}
\details{
Call \code{rate_reset()} to reset the internal rate counter to 0.
}
\seealso{
\code{\link[=rate_backoff]{rate_backoff()}}, \code{\link[=insistently]{insistently()}}
}
\keyword{internal}
purrr/man/purrr_error_indexed.Rd 0000644 0001762 0000144 00000012037 14355607172 016566 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map.R
\name{purrr_error_indexed}
\alias{purrr_error_indexed}
\title{Indexed errors (\code{purrr_error_indexed})}
\description{
The \code{purrr_error_indexed} class is thrown by \code{\link[=map]{map()}}, \code{\link[=map2]{map2()}}, \code{\link[=pmap]{pmap()}}, and friends.
It wraps errors thrown during the processing on individual elements with information about the location of the error.
}
\section{Structure}{
\code{purrr_error_indexed} has three important fields:
\itemize{
\item \code{location}: the location of the error as a single integer.
\item \code{name}: the name of the location as a string. If the element was not named, \code{name} will be \code{NULL}
\item \code{parent}: the original error thrown by \code{.f}.
}
Let's see this in action by capturing the generated condition from a very simple example:
\if{html}{\out{
}}\preformatted{f <- function(x) \{
rlang::abort("This is an error")
\}
cnd <- rlang::catch_cnd(map(c(1, 4, 2), f))
class(cnd)
#> [1] "purrr_error_indexed" "rlang_error" "error"
#> [4] "condition"
cnd$location
#> [1] 1
cnd$name
#> NULL
print(cnd$parent, backtrace = FALSE)
#>
#> Error in `.f()`:
#> ! This is an error
}\if{html}{\out{
}}
If the input vector is named, \code{name} will be non-\code{NULL}:
\if{html}{\out{
}}\preformatted{cnd <- rlang::catch_cnd(map(c(a = 1, b = 4, c = 2), f))
cnd$name
#> [1] "a"
}\if{html}{\out{
}}
}
\section{Handling errors}{
(This section assumes that you're familiar with the basics of error handling in R, as described in \href{https://adv-r.hadley.nz/conditions.html}{Advanced R}.)
This error chaining is really useful when doing interactive data analysis, but it adds some extra complexity when handling errors with \code{tryCatch()} or \code{withCallingHandlers()}.
Let's see what happens by adding a custom class to the error thrown by \code{f()}:
\if{html}{\out{
}}\preformatted{f <- function(x) \{
rlang::abort("This is an error", class = "my_error")
\}
map(c(1, 4, 2, 5, 3), f)
#> Error in `map()`:
#> i In index: 1.
#> Caused by error in `.f()`:
#> ! This is an error
}\if{html}{\out{
}}
This doesn't change the visual display, but you might be surprised if you try to catch this error with \code{tryCatch()} or \code{withCallingHandlers()}:
\if{html}{\out{
}}\preformatted{tryCatch(
map(c(1, 4, 2, 5, 3), f),
my_error = function(err) \{
# use NULL value if error
NULL
\}
)
#> Error in `map()`:
#> i In index: 1.
#> Caused by error in `.f()`:
#> ! This is an error
withCallingHandlers(
map(c(1, 4, 2, 5, 3), f),
my_error = function(err) \{
# throw a more informative error
abort("Wrapped error", parent = err)
\}
)
#> Error in `map()`:
#> i In index: 1.
#> Caused by error in `.f()`:
#> ! This is an error
}\if{html}{\out{
}}
That's because, as described above, the error that \code{map()} throws will always have class \code{purrr_error_indexed}:
\if{html}{\out{
}}\preformatted{tryCatch(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) \{
print("Hello! I am now called :)")
\}
)
#> [1] "Hello! I am now called :)"
}\if{html}{\out{
}}
In order to handle the error thrown by \code{f()}, you'll need to use \code{rlang::cnd_inherits()} on the parent error:
\if{html}{\out{
}}\preformatted{tryCatch(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) \{
if (rlang::cnd_inherits(err, "my_error")) \{
NULL
\} else \{
rlang::cnd_signal(err)
\}
\}
)
#> NULL
withCallingHandlers(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) \{
if (rlang::cnd_inherits(err, "my_error")) \{
abort("Wrapped error", parent = err)
\}
\}
)
#> Error:
#> ! Wrapped error
#> Caused by error in `map()`:
#> i In index: 1.
#> Caused by error in `.f()`:
#> ! This is an error
}\if{html}{\out{
}}
(The \code{tryCatch()} approach is suboptimal because we're no longer just handling errors, but also rethrowing them.
The rethrown errors won't work correctly with (e.g.) \code{recover()} and \code{traceback()}, but we don't currently have a better approach.
In the future we expect to \href{https://github.com/r-lib/rlang/issues/1534}{enhance \code{try_fetch()}} to make this easier to do 100\% correctly).
Finally, if you just want to get rid of purrr's wrapper error, you can resignal the parent error:
\if{html}{\out{
}}\preformatted{withCallingHandlers(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) \{
rlang::cnd_signal(err$parent)
\}
)
#> Error in `.f()`:
#> ! This is an error
}\if{html}{\out{
}}
Because we are resignalling an error, it's important to use \code{withCallingHandlers()} and not \code{tryCatch()} in order to preserve the full backtrace context.
That way \code{recover()}, \code{traceback()}, and related tools will continue to work correctly.
}
\keyword{internal}
purrr/man/reduce_right.Rd 0000644 0001762 0000144 00000004332 14314671330 015136 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/reduce.R
\name{reduce_right}
\alias{reduce_right}
\alias{reduce2_right}
\alias{accumulate_right}
\title{Reduce from the right (retired)}
\usage{
reduce_right(.x, .f, ..., .init)
reduce2_right(.x, .y, .f, ..., .init)
accumulate_right(.x, .f, ..., .init)
}
\arguments{
\item{.x}{A list or atomic vector.}
\item{.f}{For \code{reduce()}, a 2-argument function. The function will be passed
the accumulated value as the first argument and the "next" value as the
second argument.
For \code{reduce2()}, a 3-argument function. The function will be passed the
accumulated value as the first argument, the next value of \code{.x} as the
second argument, and the next value of \code{.y} as the third argument.
The reduction terminates early if \code{.f} returns a value wrapped in
a \code{\link[=done]{done()}}.}
\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{.init}{If supplied, will be used as the first value to start
the accumulation, rather than using \code{.x[[1]]}. This is useful if
you want to ensure that \code{reduce} returns a correct value when \code{.x}
is empty. If missing, and \code{.x} is empty, will throw an error.}
\item{.y}{For \code{reduce2()} and \code{accumulate2()}, an additional
argument that is passed to \code{.f}. If \code{init} is not set, \code{.y}
should be 1 element shorter than \code{.x}.}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
These functions were deprecated in purrr 0.3.0. Please use the
\code{.dir} argument of \code{\link[=reduce]{reduce()}} instead, or reverse your vectors
and use a left reduction.
}
\keyword{internal}
purrr/man/as_vector.Rd 0000644 0001762 0000144 00000002756 14330525021 014460 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/superseded-simplify.R
\name{as_vector}
\alias{as_vector}
\alias{simplify}
\alias{simplify_all}
\title{Coerce a list to a vector}
\usage{
as_vector(.x, .type = NULL)
simplify(.x, .type = NULL)
simplify_all(.x, .type = NULL)
}
\arguments{
\item{.x}{A list of vectors}
\item{.type}{Can be a vector mold specifying both the type and the
length of the vectors to be concatenated, such as \code{numeric(1)}
or \code{integer(4)}. Alternatively, it can be a string describing
the type, one of: "logical", "integer", "double", "complex",
"character" or "raw".}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}}
These functions were superseded in purrr 1.0.0 in favour of
\code{list_simplify()} which has more consistent semantics based on vctrs
principles:
\itemize{
\item \code{as_vector(x)} is now \code{list_simplify(x)}
\item \code{simplify(x)} is now \code{list_simplify(x, strict = FALSE)}
\item \code{simplify_all(x)} is \code{map(x, list_simplify, strict = FALSE)}
}
Superseded functions will not go away, but will only receive critical
bug fixes.
}
\examples{
# was
as.list(letters) |> as_vector("character")
# now
as.list(letters) |> list_simplify(ptype = character())
# was:
list(1:2, 3:4, 5:6) |> as_vector(integer(2))
# now:
list(1:2, 3:4, 5:6) |> list_c(ptype = integer())
}
\keyword{internal}
purrr/man/negate.Rd 0000644 0001762 0000144 00000002733 14311356421 013736 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-negate.R
\name{negate}
\alias{negate}
\title{Negate a predicate function so it selects what it previously rejected}
\usage{
negate(.p)
}
\arguments{
\item{.p}{A predicate function (i.e. a function that returns either \code{TRUE}
or \code{FALSE}) specified in one of the following ways:
\itemize{
\item A named function, e.g. \code{is.character}.
\item An anonymous function, e.g. \verb{\\(x) all(x < 0)} or \code{function(x) all(x < 0)}.
\item A formula, e.g. \code{~ all(.x < 0)}. You must use \code{.x} to refer to the first
argument). Only recommended if you require backward compatibility with
older versions of R.
}}
}
\value{
A new predicate function.
}
\description{
Negating a function changes \code{TRUE} to \code{FALSE} and \code{FALSE} to \code{TRUE}.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
x <- list(x = 1:10, y = rbernoulli(10), z = letters)
x |> keep(is.numeric) |> names()
x |> keep(negate(is.numeric)) |> names()
# Same as
x |> discard(is.numeric)
}
\seealso{
Other adverbs:
\code{\link{auto_browse}()},
\code{\link{compose}()},
\code{\link{insistently}()},
\code{\link{partial}()},
\code{\link{possibly}()},
\code{\link{quietly}()},
\code{\link{safely}()},
\code{\link{slowly}()}
}
\concept{adverbs}
purrr/man/list_c.Rd 0000644 0001762 0000144 00000003665 14313364271 013761 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list-combine.R
\name{list_c}
\alias{list_c}
\alias{list_cbind}
\alias{list_rbind}
\title{Combine list elements into a single data structure}
\usage{
list_c(x, ..., ptype = NULL)
list_cbind(
x,
...,
name_repair = c("unique", "universal", "check_unique"),
size = NULL
)
list_rbind(x, ..., names_to = rlang::zap(), ptype = NULL)
}
\arguments{
\item{x}{A list. For \code{list_rbind()} and \code{list_cbind()} the list must
only contain only data frames or \code{NULL}.}
\item{...}{These dots are for future extensions and must be empty.}
\item{ptype}{An optional prototype to ensure that the output type is always
the same.}
\item{name_repair}{One of \code{"unique"}, \code{"universal"}, or \code{"check_unique"}.
See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for the meaning of these options.}
\item{size}{An optional integer size to ensure that every input has the
same size (i.e. number of rows).}
\item{names_to}{By default, \code{names(x)} are lost. To keep them, supply a
string to \code{names_to} and the names will be saved into a column with that
name. If \code{names_to} is supplied and \code{x} is not named, the position of
the elements will be used instead of the names.}
}
\description{
\itemize{
\item \code{list_c()} combines elements into a vector by concatenating them together
with \code{\link[vctrs:vec_c]{vctrs::vec_c()}}.
\item \code{list_rbind()} combines elements into a data frame by row-binding them
together with \code{\link[vctrs:vec_bind]{vctrs::vec_rbind()}}.
\item \code{list_cbind()} combines elements into a data frame by column-binding them
together with \code{\link[vctrs:vec_bind]{vctrs::vec_cbind()}}.
}
}
\examples{
x1 <- list(a = 1, b = 2, c = 3)
list_c(x1)
x2 <- list(
a = data.frame(x = 1:2),
b = data.frame(y = "a")
)
list_rbind(x2)
list_rbind(x2, names_to = "id")
list_rbind(unname(x2), names_to = "id")
list_cbind(x2)
}
purrr/man/invoke.Rd 0000644 0001762 0000144 00000006524 14311356421 013770 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-invoke.R
\name{invoke}
\alias{invoke}
\alias{invoke_map}
\alias{invoke_map_lgl}
\alias{invoke_map_int}
\alias{invoke_map_dbl}
\alias{invoke_map_chr}
\alias{invoke_map_raw}
\alias{invoke_map_dfr}
\alias{invoke_map_dfc}
\alias{invoke_map_df}
\title{Invoke functions.}
\usage{
invoke(.f, .x = NULL, ..., .env = NULL)
invoke_map(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_lgl(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_int(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_dbl(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_chr(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_raw(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_dfr(.f, .x = list(NULL), ..., .env = NULL)
invoke_map_dfc(.f, .x = list(NULL), ..., .env = NULL)
}
\arguments{
\item{.f}{For \code{invoke}, a function; for \code{invoke_map} a
list of functions.}
\item{.x}{For \code{invoke}, an argument-list; for \code{invoke_map} a
list of argument-lists the same length as \code{.f} (or length 1).
The default argument, \code{list(NULL)}, will be recycled to the
same length as \code{.f}, and will call each function with no
arguments (apart from any supplied in \code{...}.}
\item{...}{Additional arguments passed to each function.}
\item{.env}{Environment in which \code{\link[=do.call]{do.call()}} should
evaluate a constructed expression. This only matters if you pass
as \code{.f} the name of a function rather than its value, or as
\code{.x} symbols of objects rather than their values.}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
These functions were superded in purrr 0.3.0 and deprecated in purrr 1.0.0.
\itemize{
\item \code{invoke()} is deprecated in favour of the simpler \code{exec()} function
reexported from rlang. \code{exec()} evaluates a function call built
from its inputs and supports \link[rlang:dyn-dots]{dynamic dots}:
\if{html}{\out{
}}\preformatted{# Before:
invoke(mean, list(na.rm = TRUE), x = 1:10)
# After
exec(mean, 1:10, !!!list(na.rm = TRUE))
}\if{html}{\out{
}}
\item \code{invoke_map()} is deprecated because it's harder to understand than the
corresponding code using \code{map()}/\code{map2()} and \code{exec()}:
\if{html}{\out{
}}
}
}
\examples{
# was
invoke(runif, list(n = 10))
invoke(runif, n = 10)
# now
exec(runif, n = 10)
# was
args <- list("01a", "01b")
invoke(paste, args, sep = "-")
# now
exec(paste, !!!args, sep = "-")
# was
funs <- list(runif, rnorm)
funs |> invoke_map(n = 5)
funs |> invoke_map(list(list(n = 10), list(n = 5)))
# now
funs |> map(exec, n = 5)
funs |> map2(list(list(n = 10), list(n = 5)), function(f, args) exec(f, !!!args))
# or use pmap + a tibble
df <- tibble::tibble(
fun = list(runif, rnorm),
args = list(list(n = 10), list(n = 5))
)
df |> pmap(function(fun, args) exec(fun, !!!args))
# was
list(m1 = mean, m2 = median) |> invoke_map(x = rcauchy(100))
# now
list(m1 = mean, m2 = median) |> map(function(f) f(rcauchy(100)))
}
\keyword{internal}
purrr/man/keep_at.Rd 0000644 0001762 0000144 00000002240 14311066210 014066 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/keep.R
\name{keep_at}
\alias{keep_at}
\alias{discard_at}
\title{Keep/discard elements based on their name/position}
\usage{
keep_at(x, at)
discard_at(x, at)
}
\arguments{
\item{x}{A list or atomic vector.}
\item{at}{A logical, integer, or character vector giving the elements
to select. Alternatively, a function that takes a vector of names,
and returns a logical, integer, or character vector of elements to select.
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is
installed, you can use \code{vars()} and tidyselect helpers to select
elements.}
}
\description{
Keep/discard elements based on their name/position
}
\examples{
x <- c(a = 1, b = 2, cat = 10, dog = 15, elephant = 5, e = 10)
x \%>\% keep_at(letters)
x \%>\% discard_at(letters)
# Can also use a function
x \%>\% keep_at(~ nchar(.x) == 3)
x \%>\% discard_at(~ nchar(.x) == 3)
}
\seealso{
\code{\link[=keep]{keep()}}/\code{\link[=discard]{discard()}} to keep/discard elements by value.
}
purrr/man/splice.Rd 0000644 0001762 0000144 00000002102 14311356421 013740 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-splice.R
\name{splice}
\alias{splice}
\title{Splice objects and lists of objects into a list}
\usage{
splice(...)
}
\arguments{
\item{...}{Objects to concatenate.}
}
\value{
A list.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 because we no longer believe that
this style of implicit/automatic splicing is a good idea; instead use
\code{rlang::list2()} + \verb{!!!} or \code{\link[=list_flatten]{list_flatten()}}.
\code{splice()} splices all arguments into a list. Non-list objects and lists
with a S3 class are encapsulated in a list before concatenation.
}
\examples{
inputs <- list(arg1 = "a", arg2 = "b")
# splice() concatenates the elements of inputs with arg3
splice(inputs, arg3 = c("c1", "c2")) |> str()
list(inputs, arg3 = c("c1", "c2")) |> str()
c(inputs, arg3 = c("c1", "c2")) |> str()
}
\keyword{internal}
purrr/man/map_raw.Rd 0000644 0001762 0000144 00000001561 14310436312 014114 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map-raw.R
\name{map_raw}
\alias{map_raw}
\alias{map2_raw}
\alias{imap_raw}
\alias{pmap_raw}
\alias{flatten_raw}
\title{Functions that return raw vectors}
\usage{
map_raw(.x, .f, ...)
map2_raw(.x, .y, .f, ...)
imap_raw(.x, .f, ...)
pmap_raw(.l, .f, ...)
flatten_raw(.x)
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
These functions were deprecated in purrr 1.0.0 because they are of limited
use and you can now use \code{map_vec()} instead. They are variants of \code{\link[=map]{map()}},
\code{\link[=map2]{map2()}}, \code{\link[=imap]{imap()}}, \code{\link[=pmap]{pmap()}}, and \code{\link[=flatten]{flatten()}} that return raw vectors.
}
\keyword{internal}
purrr/man/purrr-package.Rd 0000644 0001762 0000144 00000001551 14355607005 015240 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/package-purrr.R
\docType{package}
\name{purrr-package}
\alias{purrr}
\alias{purrr-package}
\title{purrr: Functional Programming Tools}
\description{
\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}}
A complete and consistent functional programming toolkit for R.
}
\seealso{
Useful links:
\itemize{
\item \url{https://purrr.tidyverse.org/}
\item \url{https://github.com/tidyverse/purrr}
\item Report bugs at \url{https://github.com/tidyverse/purrr/issues}
}
}
\author{
\strong{Maintainer}: Hadley Wickham \email{hadley@rstudio.com} (\href{https://orcid.org/0000-0003-4757-117X}{ORCID})
Authors:
\itemize{
\item Lionel Henry \email{lionel@rstudio.com}
}
Other contributors:
\itemize{
\item RStudio [copyright holder, funder]
}
}
\keyword{internal}
purrr/man/at_depth.Rd 0000644 0001762 0000144 00000000656 14326047453 014275 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-map.R
\name{at_depth}
\alias{at_depth}
\title{Map at depth}
\usage{
at_depth(.x, .depth, .f, ...)
}
\description{
This function is defunct and has been replaced by \code{\link[=map_depth]{map_depth()}}.
See also \code{\link[=modify_depth]{modify_depth()}} for a version that preserves the types of
the elements of the tree.
}
\keyword{internal}
purrr/man/along.Rd 0000644 0001762 0000144 00000001500 14310436312 013557 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-along.R
\name{along}
\alias{along}
\alias{list_along}
\title{Create a list of given length}
\usage{
list_along(x)
}
\arguments{
\item{x}{A vector.}
}
\value{
A list of the same length as \code{x}.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 since it's not related to the
core purpose of purrr.
It can be useful to create an empty list that you plan to fill later. This is
similar to the idea of \code{\link[=seq_along]{seq_along()}}, which creates a vector of the same
length as its input.
}
\examples{
x <- 1:5
seq_along(x)
list_along(x)
}
\keyword{internal}
purrr/man/rdunif.Rd 0000644 0001762 0000144 00000001263 14311066210 013751 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-utils.R
\name{rdunif}
\alias{rdunif}
\title{Generate random sample from a discrete uniform distribution}
\usage{
rdunif(n, b, a = 1)
}
\arguments{
\item{n}{Number of samples to draw.}
\item{a, b}{Range of the distribution (inclusive).}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 because it's not related to the
core purpose of purrr.
}
\examples{
table(rdunif(1e3, 10))
table(rdunif(1e3, 10, -5))
}
\keyword{internal}
purrr/man/map.Rd 0000644 0001762 0000144 00000013365 14460311734 013256 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map.R
\name{map}
\alias{map}
\alias{map_lgl}
\alias{map_int}
\alias{map_dbl}
\alias{map_chr}
\alias{map_vec}
\alias{walk}
\title{Apply a function to each element of a vector}
\usage{
map(.x, .f, ..., .progress = FALSE)
map_lgl(.x, .f, ..., .progress = FALSE)
map_int(.x, .f, ..., .progress = FALSE)
map_dbl(.x, .f, ..., .progress = FALSE)
map_chr(.x, .f, ..., .progress = FALSE)
map_vec(.x, .f, ..., .ptype = NULL, .progress = FALSE)
walk(.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}. You must use \code{.x} to refer to the first
argument. Only recommended if you require backward compatibility with
older versions of R.
\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.
}}
\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{progress_bars} for more details.}
\item{.ptype}{If \code{NULL}, the default, the output type is the common type
of the elements of the result. Otherwise, supply a "prototype" giving
the desired type of output.}
}
\value{
The output length is determined by the length of the input.
The output names are determined by the input names.
The output type is determined by the suffix:
\itemize{
\item No suffix: a list; \code{.f()} can return anything.
\item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double,
or character vector respectively; \code{.f()} must return a compatible atomic
vector of length 1.
\item \verb{_vec()} return an atomic or S3 vector, the same type that \code{.f} returns.
\code{.f} can return pretty much any type of vector, as long as its length 1.
\item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to
use in a pipe. The return value of \code{.f()} is ignored.
}
Any errors thrown by \code{.f} will be wrapped in an error with class
\link{purrr_error_indexed}.
}
\description{
The map functions transform their input by applying a function to
each element of a list or atomic vector and returning an object of
the same length as the input.
\itemize{
\item \code{map()} always returns a list. See the \code{\link[=modify]{modify()}} family for
versions that return an object of the same type as the input.
\item \code{map_lgl()}, \code{map_int()}, \code{map_dbl()} and \code{map_chr()} return an
atomic vector of the indicated type (or die trying). For these functions,
\code{.f} must return a length-1 vector of the appropriate type.
\item \code{map_vec()} simplifies to the common type of the output. It works with
most types of simple vectors like Date, POSIXct, factors, etc.
\item \code{walk()} calls \code{.f} for its side-effect and returns
the input \code{.x}.
}
}
\examples{
# Compute normal distributions from an atomic vector
1:10 |>
map(rnorm, n = 10)
# You can also use an anonymous function
1:10 |>
map(\(x) rnorm(10, x))
# Simplify output to a vector instead of a list by computing the mean of the distributions
1:10 |>
map(rnorm, n = 10) |> # output a list
map_dbl(mean) # output an atomic vector
# Using set_names() with character vectors is handy to keep track
# of the original inputs:
set_names(c("foo", "bar")) |> map_chr(paste0, ":suffix")
# Working with lists
favorite_desserts <- list(Sophia = "banana bread", Eliott = "pancakes", Karina = "chocolate cake")
favorite_desserts |> map_chr(\(food) paste(food, "rocks!"))
# Extract by name or position
# .default specifies value for elements that are missing or NULL
l1 <- list(list(a = 1L), list(a = NULL, b = 2L), list(b = 3L))
l1 |> map("a", .default = "???")
l1 |> map_int("b", .default = NA)
l1 |> map_int(2, .default = NA)
# Supply multiple values to index deeply into a list
l2 <- list(
list(num = 1:3, letters[1:3]),
list(num = 101:103, letters[4:6]),
list()
)
l2 |> map(c(2, 2))
# Use a list to build an extractor that mixes numeric indices and names,
# and .default to provide a default value if the element does not exist
l2 |> map(list("num", 3))
l2 |> map_int(list("num", 3), .default = NA)
# Working with data frames
# Use map_lgl(), map_dbl(), etc to return a vector instead of a list:
mtcars |> map_dbl(sum)
# A more realistic example: split a data frame into pieces, fit a
# model to each piece, summarise and extract R^2
mtcars |>
split(mtcars$cyl) |>
map(\(df) lm(mpg ~ wt, data = df)) |>
map(summary) |>
map_dbl("r.squared")
}
\seealso{
\code{\link[=map_if]{map_if()}} for applying a function to only those elements
of \code{.x} that meet a specified condition.
Other map variants:
\code{\link{imap}()},
\code{\link{lmap}()},
\code{\link{map2}()},
\code{\link{map_depth}()},
\code{\link{map_if}()},
\code{\link{modify}()},
\code{\link{pmap}()}
}
\concept{map variants}
purrr/man/every.Rd 0000644 0001762 0000144 00000003115 14311356421 013620 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/every-some-none.R
\name{every}
\alias{every}
\alias{some}
\alias{none}
\title{Do every, some, or none of the elements of a list satisfy a predicate?}
\usage{
every(.x, .p, ...)
some(.x, .p, ...)
none(.x, .p, ...)
}
\arguments{
\item{.x}{A list or vector.}
\item{.p}{A predicate function (i.e. a function that returns either \code{TRUE}
or \code{FALSE}) specified in one of the following ways:
\itemize{
\item A named function, e.g. \code{is.character}.
\item An anonymous function, e.g. \verb{\\(x) all(x < 0)} or \code{function(x) all(x < 0)}.
\item A formula, e.g. \code{~ all(.x < 0)}. You must use \code{.x} to refer to the first
argument). Only recommended if you require backward compatibility with
older versions of R.
}}
\item{...}{Additional arguments passed on to \code{.p}.}
}
\value{
A logical vector of length 1.
}
\description{
\itemize{
\item \code{some()} returns \code{TRUE} when \code{.p} is \code{TRUE} for at least one element.
\item \code{every()} returns \code{TRUE} when \code{.p} is \code{TRUE} for all elements.
\item \code{none()} returns \code{TRUE} when \code{.p} is \code{FALSE} for all elements.
}
}
\examples{
x <- list(0:10, 5.5)
x |> every(is.numeric)
x |> every(is.integer)
x |> some(is.integer)
x |> none(is.character)
# Missing values are propagated:
some(list(NA, FALSE), identity)
# If you need to use these functions in a context where missing values are
# unsafe (e.g. in `if ()` conditions), make sure to use safe predicates:
if (some(list(NA, FALSE), rlang::is_true)) "foo" else "bar"
}
purrr/man/transpose.Rd 0000644 0001762 0000144 00000005115 14330525021 014501 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/superseded-transpose.R
\name{transpose}
\alias{transpose}
\title{Transpose a list.}
\usage{
transpose(.l, .names = NULL)
}
\arguments{
\item{.l}{A list of vectors to transpose. The first element is used as the
template; you'll get a warning if a subsequent element has a different
length.}
\item{.names}{For efficiency, \code{transpose()} bases the return structure on
the first component of \code{.l} by default. Specify \code{.names} to override this.}
}
\value{
A list with indexing transposed compared to \code{.l}.
\code{transpose()} is its own inverse, much like the transpose operation on a
matrix. You can get back the original input by transposing it twice.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}}
\code{transpose()} turns a list-of-lists "inside-out"; it turns a pair of lists
into a list of pairs, or a list of pairs into pair of lists. For example,
if you had a list of length n where each component had values \code{a} and
\code{b}, \code{transpose()} would make a list with elements \code{a} and
\code{b} that contained lists of length n. It's called transpose because
\code{x[[1]][[2]]} is equivalent to \code{transpose(x)[[2]][[1]]}.
This function was superseded in purrr 1.0.0 because \code{\link[=list_transpose]{list_transpose()}}
has a better name and can automatically simplify the output, as is commonly
needed. Superseded functions will not go away, but will only receive critical
bug fixes.
}
\examples{
x <- map(1:5, \(i) list(x = runif(1), y = runif(5)))
# was
x |> transpose() |> str()
# now
x |> list_transpose(simplify = FALSE) |> str()
# transpose() is useful in conjunction with safely() & quietly()
x <- list("a", 1, 2)
y <- x |> map(safely(log))
# was
y |> transpose() |> str()
# now:
y |> list_transpose() |> str()
# Previously, output simplification required a call to another function
x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6))
x |> transpose() |> simplify_all()
# Now can take advantage of automatic simplification
x |> list_transpose()
# Provide explicit component names to prevent loss of those that don't
# appear in first component
ll <- list(
list(x = 1, y = "one"),
list(z = "deux", x = 2)
)
ll |> transpose()
nms <- ll |> map(names) |> reduce(union)
# was
ll |> transpose(.names = nms)
# now
ll |> list_transpose(template = nms)
# and can supply default value
ll |> list_transpose(template = nms, default = NA)
}
\keyword{internal}
purrr/man/rbernoulli.Rd 0000644 0001762 0000144 00000001264 14311066210 014640 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-utils.R
\name{rbernoulli}
\alias{rbernoulli}
\title{Generate random sample from a Bernoulli distribution}
\usage{
rbernoulli(n, p = 0.5)
}
\arguments{
\item{n}{Number of samples}
\item{p}{Probability of getting \code{TRUE}}
}
\value{
A logical vector
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 because it's not related to the
core purpose of purrr.
}
\examples{
rbernoulli(10)
rbernoulli(100, 0.1)
}
\keyword{internal}
purrr/man/pluck_depth.Rd 0000644 0001762 0000144 00000001365 14315046000 014766 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pluck-depth.R
\name{pluck_depth}
\alias{pluck_depth}
\alias{vec_depth}
\title{Compute the depth of a vector}
\usage{
pluck_depth(x, is_node = NULL)
}
\arguments{
\item{x}{A vector}
\item{is_node}{Optionally override the default criteria for determine an
element can be recursed within. The default matches the behaviour of
\code{pluck()} which can recurse into lists and expressions.}
}
\value{
An integer.
}
\description{
The depth of a vector is how many levels that you can index/pluck into it.
\code{pluck_depth()} was previously called \code{vec_depth()}.
}
\examples{
x <- list(
list(),
list(list()),
list(list(list(1)))
)
pluck_depth(x)
x |> map_int(pluck_depth)
}
purrr/man/when.Rd 0000644 0001762 0000144 00000003346 14355573665 013460 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-when.R
\name{when}
\alias{when}
\title{Match/validate a set of conditions for an object and continue with the action
associated with the first valid match.}
\usage{
when(., ...)
}
\arguments{
\item{.}{the value to match against}
\item{...}{formulas; each containing a condition as LHS and an action as RHS.
named arguments will define additional values.}
}
\value{
The value resulting from the action of the first valid
match/condition is returned. If no matches are found, and no default is
given, NULL will be returned.
Validity of the conditions are tested with \code{isTRUE}, or equivalently
with \code{identical(condition, TRUE)}.
In other words conditions resulting in more than one logical will never
be valid. Note that the input value is always treated as a single object,
as opposed to the \code{ifelse} function.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 because it's not related to the
core purpose of purrr. You can pull your code out of a pipe and use regular
\code{if}/\verb{else} statements instead.
\code{when()} is a flavour of pattern matching (or an if-else abstraction) in
which a value is matched against a sequence of condition-action sets. When a
valid match/condition is found the action is executed and the result of the
action is returned.
}
\examples{
1:10 \%>\%
when(
sum(.) <= 50 ~ sum(.),
sum(.) <= 100 ~ sum(.)/2,
~ 0
)
# now
x <- 1:10
if (sum(x) < 10) {
sum(x)
} else if (sum(x) < 100) {
sum(x) / 2
} else {
0
}
}
\keyword{internal}
purrr/man/get-attr.Rd 0000644 0001762 0000144 00000001252 14311066210 014207 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-utils.R
\name{get-attr}
\alias{get-attr}
\alias{\%@\%}
\title{Infix attribute accessor}
\usage{
x \%@\% name
}
\arguments{
\item{x}{Object}
\item{name}{Attribute name}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 0.3.0. Instead, lease use the \verb{\%@\%}
operator exported in rlang. It has an interface more consistent with \code{@}:
uses NSE, supports S4 fields, and has an assignment variant.
}
\keyword{internal}
purrr/man/pluck.Rd 0000644 0001762 0000144 00000007352 14347636610 013625 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pluck.R
\name{pluck}
\alias{pluck}
\alias{pluck<-}
\alias{pluck_exists}
\title{Safely get or set an element deep within a nested data structure}
\usage{
pluck(.x, ..., .default = NULL)
pluck(.x, ...) <- value
pluck_exists(.x, ...)
}
\arguments{
\item{.x, x}{A vector or environment}
\item{...}{A list of accessors for indexing into the object. Can be
an positive integer, a negative integer (to index from the right),
a string (to index into names), or an accessor function
(except for the assignment variants which only support names and
positions). If the object being indexed is an S4 object,
accessing it by name will return the corresponding slot.
\link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if
your accessors are stored in a list, you can splice that in with
\verb{!!!}.}
\item{.default}{Value to use if target is \code{NULL} or absent.}
\item{value}{A value to replace in \code{.x} at the pluck location.
Use \code{zap()} to instead remove the element.}
}
\description{
\code{pluck()} implements a generalised form of \code{[[} that allow you to index
deeply and flexibly into data structures. It always succeeds, returning
\code{.default} if the index you are trying to access does not exist or is \code{NULL}.
\verb{pluck<-()} is the assignment equivalent, allowing you to modify an object
deep within a nested data structure.
\code{pluck_exists()} tells you whether or not an object exists using the
same rules as pluck (i.e. a \code{NULL} element is equivalent to an absent
element).
}
\details{
\itemize{
\item You can pluck or chuck with standard accessors like integer
positions and string names, and also accepts arbitrary accessor
functions, i.e. functions that take an object and return some
internal piece.
This is often more readable than a mix of operators and accessors
because it reads linearly and is free of syntactic
cruft. Compare: \code{accessor(x[[1]])$foo} to \code{pluck(x, 1, accessor, "foo")}.
\item These accessors never partial-match. This is unlike \code{$} which
will select the \code{disp} object if you write \code{mtcars$di}.
}
}
\examples{
# Let's create a list of data structures:
obj1 <- list("a", list(1, elt = "foo"))
obj2 <- list("b", list(2, elt = "bar"))
x <- list(obj1, obj2)
# pluck() provides a way of retrieving objects from such data
# structures using a combination of numeric positions, vector or
# list names, and accessor functions.
# Numeric positions index into the list by position, just like `[[`:
pluck(x, 1)
# same as x[[1]]
# Index from the back
pluck(x, -1)
# same as x[[2]]
pluck(x, 1, 2)
# same as x[[1]][[2]]
# Supply names to index into named vectors:
pluck(x, 1, 2, "elt")
# same as x[[1]][[2]][["elt"]]
# By default, pluck() consistently returns `NULL` when an element
# does not exist:
pluck(x, 10)
try(x[[10]])
# You can also supply a default value for non-existing elements:
pluck(x, 10, .default = NA)
# The map() functions use pluck() by default to retrieve multiple
# values from a list:
map_chr(x, 1)
map_int(x, c(2, 1))
# pluck() also supports accessor functions:
my_element <- function(x) x[[2]]$elt
pluck(x, 1, my_element)
pluck(x, 2, my_element)
# Even for this simple data structure, this is more readable than
# the alternative form because it requires you to read both from
# right-to-left and from left-to-right in different parts of the
# expression:
my_element(x[[1]])
# If you have a list of accessors, you can splice those in with `!!!`:
idx <- list(1, my_element)
pluck(x, !!!idx)
}
\seealso{
\code{\link[=attr_getter]{attr_getter()}} for creating attribute getters suitable
for use with \code{pluck()} and \code{chuck()}. \code{\link[=modify_in]{modify_in()}} for
applying a function to a pluck location.
}
purrr/man/update_list.Rd 0000644 0001762 0000144 00000002301 14310436312 014774 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list-modify.R
\name{update_list}
\alias{update_list}
\title{Update a list with formulas}
\usage{
update_list(.x, ...)
}
\arguments{
\item{.x}{List to modify.}
\item{...}{New values of a list. Use \code{zap()} to remove values.
These values should be either all named or all unnamed. When
inputs are all named, they are matched to \code{.x} by name. When they
are all unnamed, they are matched by position.
\link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your
replacement values are stored in a list, you can splice that in with
\verb{!!!}.}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
\code{update_list()} was deprecated in purrr 1.0.0, because we no longer believe
that functions that use NSE are a good fit for purrr.
\code{update_list()} handles formulas and quosures that can refer to
values existing within the input list. This function is deprecated
because we no longer believe that functions that use tidy evaluation are
a good fit for purrr.
}
\keyword{internal}
purrr/man/has_element.Rd 0000644 0001762 0000144 00000000623 14311356421 014753 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/detect.R
\name{has_element}
\alias{has_element}
\title{Does a list contain an object?}
\usage{
has_element(.x, .y)
}
\arguments{
\item{.x}{A list or atomic vector.}
\item{.y}{Object to test for}
}
\description{
Does a list contain an object?
}
\examples{
x <- list(1:10, 5, 9.9)
x |> has_element(1:10)
x |> has_element(3)
}
purrr/man/list_flatten.Rd 0000644 0001762 0000144 00000003476 14313364271 015174 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list-flatten.R
\name{list_flatten}
\alias{list_flatten}
\title{Flatten a list}
\usage{
list_flatten(
x,
...,
name_spec = "{outer}_{inner}",
name_repair = c("minimal", "unique", "check_unique", "universal")
)
}
\arguments{
\item{x}{A list.}
\item{...}{These dots are for future extensions and must be empty.}
\item{name_spec}{If both inner and outer names are present, control
how they are combined. Should be a glue specification that uses
variables \code{inner} and \code{outer}.}
\item{name_repair}{One of \code{"minimal"}, \code{"unique"}, \code{"universal"}, or
\code{"check_unique"}. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for the meaning of these
options.}
}
\value{
A list of the same type as \code{x}. The list might be shorter
if \code{x} contains empty lists, the same length if it contains lists
of length 1 or no sub-lists, or longer if it contains lists of
length > 1.
}
\description{
Flattening a list removes a single layer of internal hierarchy,
i.e. it inlines elements that are lists leaving non-lists alone.
}
\examples{
x <- list(1, list(2, 3), list(4, list(5)))
x |> list_flatten() |> str()
x |> list_flatten() |> list_flatten() |> str()
# Flat lists are left as is
list(1, 2, 3, 4, 5) |> list_flatten() |> str()
# Empty lists will disappear
list(1, list(), 2, list(3)) |> list_flatten() |> str()
# Another way to see this is that it reduces the depth of the list
x <- list(
list(),
list(list())
)
x |> pluck_depth()
x |> list_flatten() |> pluck_depth()
# Use name_spec to control how inner and outer names are combined
x <- list(x = list(a = 1, b = 2), y = list(c = 1, d = 2))
x |> list_flatten() |> names()
x |> list_flatten(name_spec = "{outer}") |> names()
x |> list_flatten(name_spec = "{inner}") |> names()
}
purrr/man/compose.Rd 0000644 0001762 0000144 00000003322 14311356421 014133 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-compose.R
\name{compose}
\alias{compose}
\title{Compose multiple functions together to create a new function}
\usage{
compose(..., .dir = c("backward", "forward"))
}
\arguments{
\item{...}{Functions to apply in order (from right to left by
default). Formulas are converted to functions in the usual way.
\link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if
your functions are stored in a list, you can splice that in with
\verb{!!!}.}
\item{.dir}{If \code{"backward"} (the default), the functions are called
in the reverse order, from right to left, as is conventional in
mathematics. If \code{"forward"}, they are called from left to right.}
}
\value{
A function
}
\description{
Create a new function that is the composition of multiple functions,
i.e. \code{compose(f, g)} is equivalent to \code{function(...) f(g(...))}.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
not_null <- compose(`!`, is.null)
not_null(4)
not_null(NULL)
add1 <- function(x) x + 1
compose(add1, add1)(8)
fn <- compose(\(x) paste(x, "foo"), \(x) paste(x, "bar"))
fn("input")
# Lists of functions can be spliced with !!!
fns <- list(
function(x) paste(x, "foo"),
\(x) paste(x, "bar")
)
fn <- compose(!!!fns)
fn("input")
}
\seealso{
Other adverbs:
\code{\link{auto_browse}()},
\code{\link{insistently}()},
\code{\link{negate}()},
\code{\link{partial}()},
\code{\link{possibly}()},
\code{\link{quietly}()},
\code{\link{safely}()},
\code{\link{slowly}()}
}
\concept{adverbs}
purrr/man/lmap.Rd 0000644 0001762 0000144 00000006471 14314671330 013431 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/lmap.R
\name{lmap}
\alias{lmap}
\alias{lmap_if}
\alias{lmap_at}
\title{Apply a function to list-elements of a list}
\usage{
lmap(.x, .f, ...)
lmap_if(.x, .p, .f, ..., .else = NULL)
lmap_at(.x, .at, .f, ...)
}
\arguments{
\item{.x}{A list or data frame.}
\item{.f}{A function that takes a length-1 list and returns a list (of any
length.)}
\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{.p}{A single predicate function, a formula describing such a
predicate function, or a logical vector of the same length as \code{.x}.
Alternatively, if the elements of \code{.x} are themselves lists of
objects, a string indicating the name of a logical element in the
inner lists. Only those elements where \code{.p} evaluates to
\code{TRUE} will be modified.}
\item{.else}{A function applied to elements of \code{.x} for which \code{.p}
returns \code{FALSE}.}
\item{.at}{A logical, integer, or character vector giving the elements
to select. Alternatively, a function that takes a vector of names,
and returns a logical, integer, or character vector of elements to select.
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is
installed, you can use \code{vars()} and tidyselect helpers to select
elements.}
}
\value{
A list or data frame, matching \code{.x}. There are no guarantees about
the length.
}
\description{
\code{lmap()}, \code{lmap_at()} and \code{lmap_if()} are similar to \code{map()}, \code{map_at()} and
\code{map_if()}, except instead of mapping over \code{.x[[i]]}, they instead map over
\code{.x[i]}.
This has several advantages:
\itemize{
\item It makes it possible to work with functions that exclusively take a list.
\item It allows \code{.f} to access the attributes of the encapsulating list,
like \code{\link[=names]{names()}}.
\item It allows \code{.f} to return a larger or small list than it receives
changing the size of the output.
}
}
\examples{
set.seed(1014)
# Let's write a function that returns a larger list or an empty list
# depending on some condition. It also uses the input name to name the
# output
maybe_rep <- function(x) {
n <- rpois(1, 2)
set_names(rep_len(x, n), paste0(names(x), seq_len(n)))
}
# The output size varies each time we map f()
x <- list(a = 1:4, b = letters[5:7], c = 8:9, d = letters[10])
x |> lmap(maybe_rep) |> str()
# We can apply f() on a selected subset of x
x |> lmap_at(c("a", "d"), maybe_rep) |> str()
# Or only where a condition is satisfied
x |> lmap_if(is.character, maybe_rep) |> str()
}
\seealso{
Other map variants:
\code{\link{imap}()},
\code{\link{map2}()},
\code{\link{map_depth}()},
\code{\link{map_if}()},
\code{\link{map}()},
\code{\link{modify}()},
\code{\link{pmap}()}
}
\concept{map variants}
purrr/man/map_dfr.Rd 0000644 0001762 0000144 00000005421 14330525021 014073 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/superseded-map-df.R
\name{map_dfr}
\alias{map_dfr}
\alias{map_df}
\alias{map_dfc}
\alias{imap_dfr}
\alias{imap_dfc}
\alias{map2_dfr}
\alias{map2_dfc}
\alias{map2_df}
\alias{pmap_dfr}
\alias{pmap_dfc}
\alias{pmap_df}
\title{Functions that return data frames}
\usage{
map_dfr(.x, .f, ..., .id = NULL)
map_dfc(.x, .f, ...)
imap_dfr(.x, .f, ..., .id = NULL)
imap_dfc(.x, .f, ...)
map2_dfr(.x, .y, .f, ..., .id = NULL)
map2_dfc(.x, .y, .f, ...)
pmap_dfr(.l, .f, ..., .id = NULL)
pmap_dfc(.l, .f, ...)
}
\arguments{
\item{.id}{Either a string or \code{NULL}. If a string, the output will contain
a variable with that name, storing either the name (if \code{.x} is named) or
the index (if \code{.x} is unnamed) of the input. If \code{NULL}, the default, no
variable will be created.
Only applies to \verb{_dfr} variant.}
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}}
These \code{\link[=map]{map()}}, \code{\link[=map2]{map2()}}, \code{\link[=imap]{imap()}}, and \code{\link[=pmap]{pmap()}} variants return data
frames by row-binding or column-binding the outputs together.
The functions were superseded in purrr 1.0.0 because their names
suggest they work like \verb{_lgl()}, \verb{_int()}, etc which require length
1 outputs, but actually they return results of any size because the results
are combined without any size checks. Additionally, they use
\code{dplyr::bind_rows()} and \code{dplyr::bind_cols()} which require dplyr to be
installed and have confusing semantics with edge cases. Superseded
functions will not go away, but will only receive critical bug fixes.
Instead, we recommend using \code{map()}, \code{map2()}, etc with \code{\link[=list_rbind]{list_rbind()}} and
\code{\link[=list_cbind]{list_cbind()}}. These use \code{\link[vctrs:vec_bind]{vctrs::vec_rbind()}} and \code{\link[vctrs:vec_bind]{vctrs::vec_cbind()}}
under the hood, and have names that more clearly reflect their semantics.
}
\examples{
# map ---------------------------------------------
# Was:
mtcars |>
split(mtcars$cyl) |>
map(\(df) lm(mpg ~ wt, data = df)) |>
map_dfr(\(mod) as.data.frame(t(as.matrix(coef(mod)))))
# Now:
mtcars |>
split(mtcars$cyl) |>
map(\(df) lm(mpg ~ wt, data = df)) |>
map(\(mod) as.data.frame(t(as.matrix(coef(mod))))) |>
list_rbind()
# map2 ---------------------------------------------
ex_fun <- function(arg1, arg2){
col <- arg1 + arg2
x <- as.data.frame(col)
}
arg1 <- 1:4
arg2 <- 10:13
# was
map2_dfr(arg1, arg2, ex_fun)
# now
map2(arg1, arg2, ex_fun) |> list_rbind()
# was
map2_dfc(arg1, arg2, ex_fun)
# now
map2(arg1, arg2, ex_fun) |> list_cbind()
}
\keyword{internal}
purrr/man/safely.Rd 0000644 0001762 0000144 00000003767 14355342401 013767 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-safely.R
\name{safely}
\alias{safely}
\title{Wrap a function to capture errors}
\usage{
safely(.f, otherwise = NULL, quiet = TRUE)
}
\arguments{
\item{.f}{A function to modify, 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}. Only recommended if you require backward
compatibility with older versions of R.
}}
\item{otherwise}{Default value to use when an error occurs.}
\item{quiet}{Hide errors (\code{TRUE}, the default), or display them
as they occur?}
}
\value{
A function that takes the same arguments as \code{.f}, but returns
a different value, as described above.
}
\description{
Creates a modified version of \code{.f} that always succeeds. It returns a list
with components \code{result} and \code{error}. If the function succeeds, \code{result}
contains the returned value and \code{error} is \code{NULL}. If an error occurred,
\code{error} is an \code{error} object and \code{result} is either \code{NULL} or \code{otherwise}.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
safe_log <- safely(log)
safe_log(10)
safe_log("a")
list("a", 10, 100) |>
map(safe_log) |>
transpose()
# This is a bit easier to work with if you supply a default value
# of the same type and use the simplify argument to transpose():
safe_log <- safely(log, otherwise = NA_real_)
list("a", 10, 100) |>
map(safe_log) |>
transpose() |>
simplify_all()
}
\seealso{
Other adverbs:
\code{\link{auto_browse}()},
\code{\link{compose}()},
\code{\link{insistently}()},
\code{\link{negate}()},
\code{\link{partial}()},
\code{\link{possibly}()},
\code{\link{quietly}()},
\code{\link{slowly}()}
}
\concept{adverbs}
purrr/man/map_if.Rd 0000644 0001762 0000144 00000007463 14460311734 013736 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map-if-at.R
\name{map_if}
\alias{map_if}
\alias{map_at}
\title{Apply a function to each element of a vector conditionally}
\usage{
map_if(.x, .p, .f, ..., .else = NULL)
map_at(.x, .at, .f, ..., .progress = FALSE)
}
\arguments{
\item{.x}{A list or atomic vector.}
\item{.p}{A single predicate function, a formula describing such a
predicate function, or a logical vector of the same length as \code{.x}.
Alternatively, if the elements of \code{.x} are themselves lists of
objects, a string indicating the name of a logical element in the
inner lists. Only those elements where \code{.p} evaluates to
\code{TRUE} will be modified.}
\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}. You must use \code{.x} to refer to the first
argument. Only recommended if you require backward compatibility with
older versions of R.
\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.
}}
\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{.else}{A function applied to elements of \code{.x} for which \code{.p}
returns \code{FALSE}.}
\item{.at}{A logical, integer, or character vector giving the elements
to select. Alternatively, a function that takes a vector of names,
and returns a logical, integer, or character vector of elements to select.
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is
installed, you can use \code{vars()} and tidyselect helpers to select
elements.}
\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{progress_bars} for more details.}
}
\description{
The functions \code{map_if()} and \code{map_at()} take \code{.x} as input, apply
the function \code{.f} to some of the elements of \code{.x}, and return a
list of the same length as the input.
\itemize{
\item \code{map_if()} takes a predicate function \code{.p} as input to determine
which elements of \code{.x} are transformed with \code{.f}.
\item \code{map_at()} takes a vector of names or positions \code{.at} to specify
which elements of \code{.x} are transformed with \code{.f}.
}
}
\examples{
# Use a predicate function to decide whether to map a function:
iris |> map_if(is.factor, as.character) |> str()
# Specify an alternative with the `.else` argument:
iris |> map_if(is.factor, as.character, .else = as.integer) |> str()
# Use numeric vector of positions select elements to change:
iris |> map_at(c(4, 5), is.numeric) |> str()
# Use vector of names to specify which elements to change:
iris |> map_at("Species", toupper) |> str()
}
\seealso{
Other map variants:
\code{\link{imap}()},
\code{\link{lmap}()},
\code{\link{map2}()},
\code{\link{map_depth}()},
\code{\link{map}()},
\code{\link{modify}()},
\code{\link{pmap}()}
}
\concept{map variants}
purrr/man/reduce.Rd 0000644 0001762 0000144 00000013011 14314671330 013733 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/reduce.R
\name{reduce}
\alias{reduce}
\alias{reduce2}
\title{Reduce a list to a single value by iteratively applying a binary function}
\usage{
reduce(.x, .f, ..., .init, .dir = c("forward", "backward"))
reduce2(.x, .y, .f, ..., .init)
}
\arguments{
\item{.x}{A list or atomic vector.}
\item{.f}{For \code{reduce()}, a 2-argument function. The function will be passed
the accumulated value as the first argument and the "next" value as the
second argument.
For \code{reduce2()}, a 3-argument function. The function will be passed the
accumulated value as the first argument, the next value of \code{.x} as the
second argument, and the next value of \code{.y} as the third argument.
The reduction terminates early if \code{.f} returns a value wrapped in
a \code{\link[=done]{done()}}.}
\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{.init}{If supplied, will be used as the first value to start
the accumulation, rather than using \code{.x[[1]]}. This is useful if
you want to ensure that \code{reduce} returns a correct value when \code{.x}
is empty. If missing, and \code{.x} is empty, will throw an error.}
\item{.dir}{The direction of reduction as a string, one of
\code{"forward"} (the default) or \code{"backward"}. See the section about
direction below.}
\item{.y}{For \code{reduce2()} and \code{accumulate2()}, an additional
argument that is passed to \code{.f}. If \code{init} is not set, \code{.y}
should be 1 element shorter than \code{.x}.}
}
\description{
\code{reduce()} is an operation that combines the elements of a vector
into a single value. The combination is driven by \code{.f}, a binary
function that takes two values and returns a single value: reducing
\code{f} over \code{1:3} computes the value \code{f(f(1, 2), 3)}.
}
\section{Direction}{
When \code{.f} is an associative operation like \code{+} or \code{c()}, the
direction of reduction does not matter. For instance, reducing the
vector \code{1:3} with the binary function \code{+} computes the sum \code{((1 + 2) + 3)} from the left, and the same sum \code{(1 + (2 + 3))} from the
right.
In other cases, the direction has important consequences on the
reduced value. For instance, reducing a vector with \code{list()} from
the left produces a left-leaning nested list (or tree), while
reducing \code{list()} from the right produces a right-leaning list.
}
\section{Life cycle}{
\code{reduce_right()} is soft-deprecated as of purrr 0.3.0. Please use
the \code{.dir} argument of \code{reduce()} instead. Note that the algorithm
has changed. Whereas \code{reduce_right()} computed \code{f(f(3, 2), 1)},
\verb{reduce(.dir = \\"backward\\")} computes \code{f(1, f(2, 3))}. This is the
standard way of reducing from the right.
To update your code with the same reduction as \code{reduce_right()},
simply reverse your vector and use a left reduction:
\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{.init}{If supplied, will be used as the first value to start
the accumulation, rather than using \code{.x[[1]]}. This is useful if
you want to ensure that \code{reduce} returns a correct value when \code{.x}
is empty. If missing, and \code{.x} is empty, will throw an error.}
\item{.dir}{The direction of accumulation as a string, one of
\code{"forward"} (the default) or \code{"backward"}. See the section about
direction below.}
\item{.simplify}{If \code{NA}, the default, the accumulated list of
results is simplified to an atomic vector if possible.
If \code{TRUE}, the result is simplified, erroring if not possible.
If \code{FALSE}, the result is not simplified, always returning a list.}
\item{.ptype}{If \code{simplify} is \code{NA} or \code{TRUE}, optionally supply a vector
prototype to enforce the output type.}
\item{.y}{For \code{accumulate2()} \code{.y} is the second argument of the pair. It
needs to be 1 element shorter than the vector to be accumulated (\code{.x}).
If \code{.init} is set, \code{.y} needs to be one element shorted than the
concatenation of the initial value and \code{.x}.}
}
\value{
A vector the same length of \code{.x} with the same names as \code{.x}.
If \code{.init} is supplied, the length is extended by 1. If \code{.x} has
names, the initial value is given the name \code{".init"}, otherwise
the returned vector is kept unnamed.
If \code{.dir} is \code{"forward"} (the default), the first element is the
initial value (\code{.init} if supplied, or the first element of \code{.x})
and the last element is the final reduced value. In case of a
right accumulation, this order is reversed.
The accumulation terminates early if \code{.f} returns a value wrapped
in a \code{\link[=done]{done()}}. If the done box is empty, the last value is
used instead and the result is one element shorter (but always
includes the initial value, even when terminating at the first
iteration).
}
\description{
\code{accumulate()} sequentially applies a 2-argument function to elements of a
vector. Each application of the function uses the initial value or result
of the previous application as the first argument. The second argument is
the next value of the vector. The results of each application are
returned in a list. The accumulation can optionally terminate before
processing the whole vector in response to a \code{done()} signal returned by
the accumulation function.
By contrast to \code{accumulate()}, \code{reduce()} applies a 2-argument function in
the same way, but discards all results except that of the final function
application.
\code{accumulate2()} sequentially applies a function to elements of two lists, \code{.x} and \code{.y}.
}
\section{Life cycle}{
\code{accumulate_right()} is soft-deprecated in favour of the \code{.dir}
argument as of rlang 0.3.0. Note that the algorithm has
slightly changed: the accumulated value is passed to the right
rather than the left, which is consistent with a right reduction.
}
\section{Direction}{
When \code{.f} is an associative operation like \code{+} or \code{c()}, the
direction of reduction does not matter. For instance, reducing the
vector \code{1:3} with the binary function \code{+} computes the sum \code{((1 + 2) + 3)} from the left, and the same sum \code{(1 + (2 + 3))} from the
right.
In other cases, the direction has important consequences on the
reduced value. For instance, reducing a vector with \code{list()} from
the left produces a left-leaning nested list (or tree), while
reducing \code{list()} from the right produces a right-leaning list.
}
\examples{
# With an associative operation, the final value is always the
# same, no matter the direction. You'll find it in the first element for a
# backward (left) accumulation, and in the last element for forward
# (right) one:
1:5 |> accumulate(`+`)
1:5 |> accumulate(`+`, .dir = "backward")
# The final value is always equal to the equivalent reduction:
1:5 |> reduce(`+`)
# It is easier to understand the details of the reduction with
# `paste()`.
accumulate(letters[1:5], paste, sep = ".")
# Note how the intermediary reduced values are passed to the left
# with a left reduction, and to the right otherwise:
accumulate(letters[1:5], paste, sep = ".", .dir = "backward")
# By ignoring the input vector (nxt), you can turn output of one step into
# the input for the next. This code takes 10 steps of a random walk:
accumulate(1:10, \(acc, nxt) acc + rnorm(1), .init = 0)
# `accumulate2()` is a version of `accumulate()` that works with
# 3-argument functions and one additional vector:
paste2 <- function(acc, nxt, sep = ".") paste(acc, nxt, sep = sep)
letters[1:4] |> accumulate(paste2)
letters[1:4] |> accumulate2(c("-", ".", "-"), paste2)
# You can shortcircuit an accumulation and terminate it early by
# returning a value wrapped in a done(). In the following example
# we return early if the result-so-far, which is passed on the LHS,
# meets a condition:
paste3 <- function(out, input, sep = ".") {
if (nchar(out) > 4) {
return(done(out))
}
paste(out, input, sep = sep)
}
letters |> accumulate(paste3)
# Note how we get twice the same value in the accumulation. That's
# because we have returned it twice. To prevent this, return an empty
# done box to signal to accumulate() that it should terminate with the
# value of the last iteration:
paste3 <- function(out, input, sep = ".") {
if (nchar(out) > 4) {
return(done())
}
paste(out, input, sep = sep)
}
letters |> accumulate(paste3)
# Here the early return branch checks the incoming inputs passed on
# the RHS:
paste4 <- function(out, input, sep = ".") {
if (input == "f") {
return(done())
}
paste(out, input, sep = sep)
}
letters |> accumulate(paste4)
# Simulating stochastic processes with drift
\dontrun{
library(dplyr)
library(ggplot2)
map(1:5, \(i) rnorm(100)) |>
set_names(paste0("sim", 1:5)) |>
map(\(l) accumulate(l, \(acc, nxt) .05 + acc + nxt)) |>
map(\(x) tibble(value = x, step = 1:100)) |>
list_rbind(id = "simulation") |>
ggplot(aes(x = step, y = value)) +
geom_line(aes(color = simulation)) +
ggtitle("Simulations of a random walk with drift")
}
}
\seealso{
\code{\link[=reduce]{reduce()}} when you only need the final reduced value.
}
purrr/man/reexports.Rd 0000644 0001762 0000144 00000005034 14310436312 014520 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/reexport-rlang.R
\docType{import}
\name{reexports}
\alias{reexports}
\alias{set_names}
\alias{exec}
\alias{zap}
\alias{\%||\%}
\alias{done}
\alias{rep_along}
\alias{is_bare_list}
\alias{is_bare_atomic}
\alias{is_bare_vector}
\alias{is_bare_double}
\alias{is_bare_integer}
\alias{is_bare_numeric}
\alias{is_bare_character}
\alias{is_bare_logical}
\alias{is_list}
\alias{is_atomic}
\alias{is_vector}
\alias{is_integer}
\alias{is_double}
\alias{is_character}
\alias{is_logical}
\alias{is_null}
\alias{is_function}
\alias{is_scalar_list}
\alias{is_scalar_atomic}
\alias{is_scalar_vector}
\alias{is_scalar_double}
\alias{is_scalar_character}
\alias{is_scalar_logical}
\alias{is_scalar_integer}
\alias{is_empty}
\alias{is_formula}
\title{Objects exported from other packages}
\keyword{internal}
\description{
These objects are imported from other packages. Follow the links
below to see their documentation.
\describe{
\item{rlang}{\code{\link[rlang:op-null-default]{\%||\%}}, \code{\link[rlang]{done}}, \code{\link[rlang]{exec}}, \code{\link[rlang:type-predicates]{is_atomic}}, \code{\link[rlang:bare-type-predicates]{is_bare_atomic}}, \code{\link[rlang:bare-type-predicates]{is_bare_character}}, \code{\link[rlang:bare-type-predicates]{is_bare_double}}, \code{\link[rlang:bare-type-predicates]{is_bare_integer}}, \code{\link[rlang:bare-type-predicates]{is_bare_list}}, \code{\link[rlang:bare-type-predicates]{is_bare_logical}}, \code{\link[rlang:bare-type-predicates]{is_bare_numeric}}, \code{\link[rlang:bare-type-predicates]{is_bare_vector}}, \code{\link[rlang:type-predicates]{is_character}}, \code{\link[rlang:type-predicates]{is_double}}, \code{\link[rlang]{is_empty}}, \code{\link[rlang]{is_formula}}, \code{\link[rlang]{is_function}}, \code{\link[rlang:type-predicates]{is_integer}}, \code{\link[rlang:type-predicates]{is_list}}, \code{\link[rlang:type-predicates]{is_logical}}, \code{\link[rlang:type-predicates]{is_null}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_atomic}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_character}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_double}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_integer}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_list}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_logical}}, \code{\link[rlang:scalar-type-predicates]{is_scalar_vector}}, \code{\link[rlang:type-predicates]{is_vector}}, \code{\link[rlang]{rep_along}}, \code{\link[rlang]{set_names}}, \code{\link[rlang]{zap}}}
}}
purrr/man/map2.Rd 0000644 0001762 0000144 00000006652 14460311734 013341 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map2.R
\name{map2}
\alias{map2}
\alias{map2_lgl}
\alias{map2_int}
\alias{map2_dbl}
\alias{map2_chr}
\alias{map2_vec}
\alias{walk2}
\title{Map over two inputs}
\usage{
map2(.x, .y, .f, ..., .progress = FALSE)
map2_lgl(.x, .y, .f, ..., .progress = FALSE)
map2_int(.x, .y, .f, ..., .progress = FALSE)
map2_dbl(.x, .y, .f, ..., .progress = FALSE)
map2_chr(.x, .y, .f, ..., .progress = FALSE)
map2_vec(.x, .y, .f, ..., .ptype = NULL, .progress = FALSE)
walk2(.x, .y, .f, ..., .progress = FALSE)
}
\arguments{
\item{.x, .y}{A pair of vectors, usually the same length. If not, a vector
of length 1 will be recycled to the length of the other.}
\item{.f}{A function, specified in one of the following ways:
\itemize{
\item A named function.
\item An anonymous function, e.g. \verb{\\(x, y) x + y} or \code{function(x, y) x + y}.
\item A formula, e.g. \code{~ .x + .y}. You must use \code{.x} to refer to the current
element of \code{x} and \code{.y} to refer to the current element of \code{y}. Only
recommended if you require backward compatibility with older versions
of R.
}}
\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{progress_bars} for more details.}
\item{.ptype}{If \code{NULL}, the default, the output type is the common type
of the elements of the result. Otherwise, supply a "prototype" giving
the desired type of output.}
}
\value{
The output length is determined by the length of the input.
The output names are determined by the input names.
The output type is determined by the suffix:
\itemize{
\item No suffix: a list; \code{.f()} can return anything.
\item \verb{_lgl()}, \verb{_int()}, \verb{_dbl()}, \verb{_chr()} return a logical, integer, double,
or character vector respectively; \code{.f()} must return a compatible atomic
vector of length 1.
\item \verb{_vec()} return an atomic or S3 vector, the same type that \code{.f} returns.
\code{.f} can return pretty much any type of vector, as long as its length 1.
\item \code{walk()} returns the input \code{.x} (invisibly). This makes it easy to
use in a pipe. The return value of \code{.f()} is ignored.
}
Any errors thrown by \code{.f} will be wrapped in an error with class
\link{purrr_error_indexed}.
}
\description{
These functions are variants of \code{\link[=map]{map()}} that iterate over two arguments at
a time.
}
\examples{
x <- list(1, 1, 1)
y <- list(10, 20, 30)
map2(x, y, \(x, y) x + y)
# Or just
map2(x, y, `+`)
# Split into pieces, fit model to each piece, then predict
by_cyl <- mtcars |> split(mtcars$cyl)
mods <- by_cyl |> map(\(df) lm(mpg ~ wt, data = df))
map2(mods, by_cyl, predict)
}
\seealso{
Other map variants:
\code{\link{imap}()},
\code{\link{lmap}()},
\code{\link{map_depth}()},
\code{\link{map_if}()},
\code{\link{map}()},
\code{\link{modify}()},
\code{\link{pmap}()}
}
\concept{map variants}
purrr/man/faq-adverbs-export.Rd 0000644 0001762 0000144 00000002477 14304371054 016213 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/faq.R
\name{faq-adverbs-export}
\alias{faq-adverbs-export}
\title{Best practices for exporting adverb-wrapped functions}
\description{
Exporting functions created with purrr adverbs in your package
requires some precautions because the functions will contain internal
purrr code. This means that creating them once and for all when
the package is built may cause problems when purrr is updated, because
a function that the adverb uses might no longer exist.
Instead, either create the modified function once per session on package
load or wrap the call within another function every time you use it:
\itemize{
\item Using the \code{\link[=.onLoad]{.onLoad()}} hook:
\if{html}{\out{
}}
\item Using a wrapper function:
\if{html}{\out{
}}\preformatted{my_function <- function(...) \{
# Implementation
\}
#' My function
#' @export
insist_my_function <- function(...) \{
purrr::insistently(my_function)(...)
\}
}\if{html}{\out{
}}
}
}
\keyword{internal}
purrr/man/possibly.Rd 0000644 0001762 0000144 00000003236 14355342401 014337 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-possibly.R
\name{possibly}
\alias{possibly}
\title{Wrap a function to return a value instead of an error}
\usage{
possibly(.f, otherwise = NULL, quiet = TRUE)
}
\arguments{
\item{.f}{A function to modify, 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}. Only recommended if you require backward
compatibility with older versions of R.
}}
\item{otherwise}{Default value to use when an error occurs.}
\item{quiet}{Hide errors (\code{TRUE}, the default), or display them
as they occur?}
}
\value{
A function that takes the same arguments as \code{.f}, but returns
a different value, as described above.
}
\description{
Create a modified version of \code{.f} that return a default value (\code{otherwise})
whenever an error occurs.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
# To replace errors with a default value, use possibly().
list("a", 10, 100) |>
map_dbl(possibly(log, NA_real_))
# The default, NULL, will be discarded with `list_c()`
list("a", 10, 100) |>
map(possibly(log)) |>
list_c()
}
\seealso{
Other adverbs:
\code{\link{auto_browse}()},
\code{\link{compose}()},
\code{\link{insistently}()},
\code{\link{negate}()},
\code{\link{partial}()},
\code{\link{quietly}()},
\code{\link{safely}()},
\code{\link{slowly}()}
}
\concept{adverbs}
purrr/man/list_simplify.Rd 0000644 0001762 0000144 00000002574 14313364271 015371 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list-simplify.R
\name{list_simplify}
\alias{list_simplify}
\title{Simplify a list to an atomic or S3 vector}
\usage{
list_simplify(x, ..., strict = TRUE, ptype = NULL)
}
\arguments{
\item{x}{A list.}
\item{...}{These dots are for future extensions and must be empty.}
\item{strict}{What should happen if simplification fails? If \code{TRUE},
it will error. If \code{FALSE} and \code{ptype} is not supplied, it will return \code{x}
unchanged.}
\item{ptype}{An optional prototype to ensure that the output type is always
the same.}
}
\value{
A vector the same length as \code{x}.
}
\description{
Simplification maintains a one-to-one correspondence between the input
and output, implying that each element of \code{x} must contain a one element
vector or a one-row data frame. If you don't want to maintain this
correspondence, then you probably want either \code{\link[=list_c]{list_c()}}/\code{\link[=list_rbind]{list_rbind()}} or
\code{\link[=list_flatten]{list_flatten()}}.
}
\examples{
list_simplify(list(1, 2, 3))
# Only works when vectors are length one and have compatible types:
try(list_simplify(list(1, 2, 1:3)))
try(list_simplify(list(1, 2, "x")))
# Unless you strict = FALSE, in which case you get the input back:
list_simplify(list(1, 2, 1:3), strict = FALSE)
list_simplify(list(1, 2, "x"), strict = FALSE)
}
purrr/man/list_assign.Rd 0000644 0001762 0000144 00000004176 14350157731 015023 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/list-modify.R
\name{list_assign}
\alias{list_assign}
\alias{list_modify}
\alias{list_merge}
\title{Modify a list}
\usage{
list_assign(.x, ..., .is_node = NULL)
list_modify(.x, ..., .is_node = NULL)
list_merge(.x, ..., .is_node = NULL)
}
\arguments{
\item{.x}{List to modify.}
\item{...}{New values of a list. Use \code{zap()} to remove values.
These values should be either all named or all unnamed. When
inputs are all named, they are matched to \code{.x} by name. When they
are all unnamed, they are matched by position.
\link[rlang:dyn-dots]{Dynamic dots} are supported. In particular, if your
replacement values are stored in a list, you can splice that in with
\verb{!!!}.}
\item{.is_node}{A predicate function that determines whether an element is
a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The
default value, \code{NULL}, treats simple lists as nodes and everything else
(including richer objects like data frames and linear models) as leaves,
using \code{\link[vctrs:vec_is_list]{vctrs::vec_is_list()}}. To recurse into all objects built on lists
use \code{\link[=is.list]{is.list()}}.}
}
\description{
\itemize{
\item \code{list_assign()} modifies the elements of a list by name or position.
\item \code{list_modify()} modifies the elements of a list recursively.
\item \code{list_merge()} merges the elements of a list recursively.
}
\code{list_modify()} is inspired by \code{\link[utils:modifyList]{utils::modifyList()}}.
}
\examples{
x <- list(x = 1:10, y = 4, z = list(a = 1, b = 2))
str(x)
# Update values
str(list_assign(x, a = 1))
# Replace values
str(list_assign(x, z = 5))
str(list_assign(x, z = NULL))
str(list_assign(x, z = list(a = 1:5)))
# replace recursively, leaving the other elements of z alone
str(list_modify(x, z = list(a = 1:5)))
# Remove values
str(list_assign(x, z = zap()))
# Combine values with list_merge()
str(list_merge(x, x = 11, z = list(a = 2:5, c = 3)))
# All these functions support dynamic dots features. Use !!! to splice
# a list of arguments:
l <- list(new = 1, y = zap(), z = 5)
str(list_assign(x, !!!l))
}
purrr/man/prepend.Rd 0000644 0001762 0000144 00000002222 14311356421 014121 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-prepend.R
\name{prepend}
\alias{prepend}
\title{Prepend a vector}
\usage{
prepend(x, values, before = NULL)
}
\arguments{
\item{x}{the vector to be modified.}
\item{values}{to be included in the modified vector.}
\item{before}{a subscript, before which the values are to be appended. If
\code{NULL}, values will be appended at the beginning even for \code{x} of length 0.}
}
\value{
A merged vector.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 because it's not related to the
core purpose of purrr.
This is a companion to \code{\link[=append]{append()}} to help merging two
lists or atomic vectors. \code{prepend()} is a clearer semantic
signal than \code{c()} that a vector is to be merged at the beginning of
another, especially in a pipe chain.
}
\examples{
x <- as.list(1:3)
x |> append("a")
x |> prepend("a")
x |> prepend(list("a", "b"), before = 3)
prepend(list(), x)
}
\keyword{internal}
purrr/man/pipe.Rd 0000644 0001762 0000144 00000000330 14311066210 013411 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/reexport-pipe.R
\name{\%>\%}
\alias{\%>\%}
\title{Pipe operator}
\usage{
lhs \%>\% rhs
}
\description{
Pipe operator
}
\keyword{internal}
purrr/man/imap.Rd 0000644 0001762 0000144 00000004065 14314671330 013423 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/imap.R
\name{imap}
\alias{imap}
\alias{imap_lgl}
\alias{imap_chr}
\alias{imap_int}
\alias{imap_dbl}
\alias{iwalk}
\title{Apply a function to each element of a vector, and its index}
\usage{
imap(.x, .f, ...)
imap_lgl(.x, .f, ...)
imap_chr(.x, .f, ...)
imap_int(.x, .f, ...)
imap_dbl(.x, .f, ...)
iwalk(.x, .f, ...)
}
\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{paste}.
\item An anonymous function, e.g. \verb{\\(x, idx) x + idx} or
\code{function(x, idx) x + idx}.
\item A formula, e.g. \code{~ .x + .y}. You must use \code{.x} to refer to the
current element and \code{.y} to refer to the current index. Only recommended
if you require backward compatibility with older versions of R.
}}
\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.}
}
\value{
A vector the same length as \code{.x}.
}
\description{
\code{imap(x, ...)}, an indexed map, is short hand for
\code{map2(x, names(x), ...)} if \code{x} has names, or \code{map2(x, seq_along(x), ...)}
if it does not. This is useful if you need to compute on both the value
and the position of an element.
}
\examples{
imap_chr(sample(10), paste)
imap_chr(sample(10), \(x, idx) paste0(idx, ": ", x))
iwalk(mtcars, \(x, idx) cat(idx, ": ", median(x), "\n", sep = ""))
}
\seealso{
Other map variants:
\code{\link{lmap}()},
\code{\link{map2}()},
\code{\link{map_depth}()},
\code{\link{map_if}()},
\code{\link{map}()},
\code{\link{modify}()},
\code{\link{pmap}()}
}
\concept{map variants}
purrr/man/progress_bars.Rd 0000644 0001762 0000144 00000005000 14355342401 015335 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/progress-bars.R
\name{progress_bars}
\alias{progress_bars}
\title{Progress bars in purrr}
\description{
purrr's map functions have a \code{.progress} argument that you can use to
create a progress bar. \code{.progress} can be:
\itemize{
\item \code{FALSE}, the default: does not create a progress bar.
\item \code{TRUE}: creates a basic unnamed progress bar.
\item A string: creates a basic progress bar with the given name.
\item A named list of progress bar parameters, as described below.
}
It's good practice to name your progress bars, to make it clear what
calculation or process they belong to. We recommend keeping the names
under 20 characters, so the whole progress bar fits comfortably even on
on narrower displays.
\subsection{Progress bar parameters}{
\itemize{
\item \code{clear}: whether to remove the progress bar from the screen after
termination. Defaults to \code{TRUE}.
\item \code{format}: format string. This overrides the default format string of
the progress bar type. It must be given for the \code{custom} type.
Format strings may contain R expressions to evaluate in braces.
They support cli \link[cli:pluralization]{pluralization}, and
\link[=inline-markup]{styling} and they can contain special
\link[cli:progress-variables]{progress variables}.
\item \code{format_done}: format string for successful termination. By default
the same as \code{format}.
\item \code{format_failed}: format string for unsuccessful termination.
By default the same as \code{format}.
\item \code{name}: progress bar name. This is by default the empty string and it
is displayed at the beginning of the progress bar.
\item \code{show_after}: numeric scalar. Only show the progress bar after this
number of seconds. It overrides the \code{cli.progress_show_after}
global option.
\item \code{type}: progress bar type. Currently supported types are:
\itemize{
\item \code{iterator}: the default, a for loop or a mapping function,
\item \code{tasks}: a (typically small) number of tasks,
\item \code{download}: download of one file,
\item \code{custom}: custom type, \code{format} must not be \code{NULL} for this type.
The default display is different for each progress bar type.
}
}
}
\subsection{Further documentation}{
purrr's progress bars are powered by cli, so see
\href{https://cli.r-lib.org/articles/progress.html}{Introduction to progress bars in cli}
and \href{https://cli.r-lib.org/articles/progress-advanced.html}{Advanced cli progress bars}
for more details.
}
}
purrr/man/map_depth.Rd 0000644 0001762 0000144 00000012124 14315046000 014420 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map-depth.R
\name{map_depth}
\alias{map_depth}
\alias{modify_depth}
\title{Map/modify elements at given depth}
\usage{
map_depth(.x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL)
modify_depth(.x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL)
}
\arguments{
\item{.x}{A list or atomic vector.}
\item{.depth}{Level of \code{.x} to map on. Use a negative value to
count up from the lowest level of the list.
\itemize{
\item \code{map_depth(x, 0, fun)} is equivalent to \code{fun(x)}.
\item \code{map_depth(x, 1, fun)} is equivalent to \code{x <- map(x, fun)}
\item \code{map_depth(x, 2, fun)} is equivalent to \verb{x <- map(x, \\(y) map(y, fun))}
}}
\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}. You must use \code{.x} to refer to the first
argument. Only recommended if you require backward compatibility with
older versions of R.
\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.
}}
\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{.ragged}{If \code{TRUE}, will apply to leaves, even if they're not
at depth \code{.depth}. If \code{FALSE}, will throw an error if there are
no elements at depth \code{.depth}.}
\item{.is_node}{A predicate function that determines whether an element is
a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The
default value, \code{NULL}, treats simple lists as nodes and everything else
(including richer objects like data frames and linear models) as leaves,
using \code{\link[vctrs:vec_is_list]{vctrs::vec_is_list()}}. To recurse into all objects built on lists
use \code{\link[=is.list]{is.list()}}.}
}
\description{
\code{map_depth()} calls \code{map(.y, .f)} on all \code{.y} at the specified \code{.depth} in
\code{.x}. \code{modify_depth()} calls \code{modify(.y, .f)} on \code{.y} at the specified
\code{.depth} in \code{.x}.
}
\examples{
# map_depth() -------------------------------------------------
# Use `map_depth()` to recursively traverse nested vectors and map
# a function at a certain depth:
x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6))
x |> str()
x |> map_depth(2, \(y) paste(y, collapse = "/")) |> str()
# Equivalent to:
x |> map(\(y) map(y, \(z) paste(z, collapse = "/"))) |> str()
# When ragged is TRUE, `.f()` will also be passed leaves at depth < `.depth`
x <- list(1, list(1, list(1, list(1, 1))))
x |> str()
x |> map_depth(4, \(x) length(unlist(x)), .ragged = TRUE) |> str()
x |> map_depth(3, \(x) length(unlist(x)), .ragged = TRUE) |> str()
x |> map_depth(2, \(x) length(unlist(x)), .ragged = TRUE) |> str()
x |> map_depth(1, \(x) length(unlist(x)), .ragged = TRUE) |> str()
x |> map_depth(0, \(x) length(unlist(x)), .ragged = TRUE) |> str()
# modify_depth() -------------------------------------------------
l1 <- list(
obj1 = list(
prop1 = list(param1 = 1:2, param2 = 3:4),
prop2 = list(param1 = 5:6, param2 = 7:8)
),
obj2 = list(
prop1 = list(param1 = 9:10, param2 = 11:12),
prop2 = list(param1 = 12:14, param2 = 15:17)
)
)
# In the above list, "obj" is level 1, "prop" is level 2 and "param"
# is level 3. To apply sum() on all params, we map it at depth 3:
l1 |> modify_depth(3, sum) |> str()
# modify() lets us pluck the elements prop1/param2 in obj1 and obj2:
l1 |> modify(c("prop1", "param2")) |> str()
# But what if we want to pluck all param2 elements? Then we need to
# act at a lower level:
l1 |> modify_depth(2, "param2") |> str()
# modify_depth() can be with other purrr functions to make them operate at
# a lower level. Here we ask pmap() to map paste() simultaneously over all
# elements of the objects at the second level. paste() is effectively
# mapped at level 3.
l1 |> modify_depth(2, \(x) pmap(x, paste, sep = " / ")) |> str()
}
\seealso{
\code{\link[=modify_tree]{modify_tree()}} for a recursive version of \code{modify_depth()} that
allows you to apply a function to every leaf or every node.
Other map variants:
\code{\link{imap}()},
\code{\link{lmap}()},
\code{\link{map2}()},
\code{\link{map_if}()},
\code{\link{map}()},
\code{\link{modify}()},
\code{\link{pmap}()}
Other modify variants:
\code{\link{modify_tree}()},
\code{\link{modify}()}
}
\concept{map variants}
\concept{modify variants}
purrr/man/as_mapper.Rd 0000644 0001762 0000144 00000004523 14311356421 014441 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/map-mapper.R
\name{as_mapper}
\alias{as_mapper}
\alias{as_mapper.character}
\alias{as_mapper.numeric}
\alias{as_mapper.list}
\title{Convert an object into a mapper function}
\usage{
as_mapper(.f, ...)
\method{as_mapper}{character}(.f, ..., .null, .default = NULL)
\method{as_mapper}{numeric}(.f, ..., .null, .default = NULL)
\method{as_mapper}{list}(.f, ..., .null, .default = NULL)
}
\arguments{
\item{.f}{A function, formula, or vector (not necessarily atomic).
If a \strong{function}, it is used as is.
If a \strong{formula}, e.g. \code{~ .x + 2}, it is converted to a function. There
are three ways to refer to the arguments:
\itemize{
\item For a single argument function, use \code{.}
\item For a two argument function, use \code{.x} and \code{.y}
\item For more arguments, use \code{..1}, \code{..2}, \code{..3} etc
}
This syntax allows you to create very compact anonymous
functions. Note that formula functions conceptually take dots
(that's why you can use \code{..1} etc). They silently ignore
additional arguments that are not used in the formula expression.
If \strong{character vector}, \strong{numeric vector}, or \strong{list}, it is
converted to an extractor function. Character vectors index by
name and numeric vectors index by position; use a list to index
by position and name at different levels. If a component is not
present, the value of \code{.default} will be returned.}
\item{...}{Additional arguments passed on to methods.}
\item{.default, .null}{Optional additional argument for extractor functions
(i.e. when \code{.f} is character, integer, or list). Returned when
value is absent (does not exist) or empty (has length 0).
\code{.null} is deprecated; please use \code{.default} instead.}
}
\description{
\code{as_mapper} is the powerhouse behind the varied function
specifications that most purrr functions allow. It is an S3
generic. The default method forwards its arguments to
\code{\link[rlang:as_function]{rlang::as_function()}}.
}
\examples{
as_mapper(\(x) x + 1)
as_mapper(1)
as_mapper(c("a", "b", "c"))
# Equivalent to function(x) x[["a"]][["b"]][["c"]]
as_mapper(list(1, "a", 2))
# Equivalent to function(x) x[[1]][["a"]][[2]]
as_mapper(list(1, attr_getter("a")))
# Equivalent to function(x) attr(x[[1]], "a")
as_mapper(c("a", "b", "c"), .default = NA)
}
purrr/man/modify_tree.Rd 0000644 0001762 0000144 00000003243 14315046000 014767 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/modify-tree.R
\name{modify_tree}
\alias{modify_tree}
\title{Recursively modify a list}
\usage{
modify_tree(
x,
...,
leaf = identity,
is_node = NULL,
pre = identity,
post = identity
)
}
\arguments{
\item{x}{A list.}
\item{...}{Reserved for future use. Must be empty}
\item{leaf}{A function applied to each leaf.}
\item{is_node}{A predicate function that determines whether an element is
a node (by returning \code{TRUE}) or a leaf (by returning \code{FALSE}). The
default value, \code{NULL}, treats simple lists as nodes and everything else
(including richer objects like data frames and linear models) as leaves,
using \code{\link[vctrs:vec_is_list]{vctrs::vec_is_list()}}. To recurse into all objects built on lists
use \code{\link[=is.list]{is.list()}}.}
\item{pre, post}{Functions applied to each node. \code{pre} is applied on the
way "down", i.e. before the leaves are transformed with \code{leaf}, while
\code{post} is applied on the way "up", i.e. after the leaves are transformed.}
}
\description{
\code{modify_tree()} allows you to recursively modify a list, supplying functions
that either modify each leaf or each node (or both).
}
\examples{
x <- list(list(a = 2:1, c = list(b1 = 2), b = list(c2 = 3, c1 = 4)))
x |> str()
# Transform each leaf
x |> modify_tree(leaf = \(x) x + 100) |> str()
# Recursively sort the nodes
sort_named <- function(x) {
nms <- names(x)
if (!is.null(nms)) {
x[order(nms)]
} else {
x
}
}
x |> modify_tree(post = sort_named) |> str()
}
\seealso{
Other modify variants:
\code{\link{map_depth}()},
\code{\link{modify}()}
}
\concept{modify variants}
purrr/man/flatten.Rd 0000644 0001762 0000144 00000003755 14330525021 014130 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/superseded-flatten.R
\name{flatten}
\alias{flatten}
\alias{flatten_lgl}
\alias{flatten_int}
\alias{flatten_dbl}
\alias{flatten_chr}
\alias{flatten_dfr}
\alias{flatten_dfc}
\alias{flatten_df}
\title{Flatten a list of lists into a simple vector}
\usage{
flatten(.x)
flatten_lgl(.x)
flatten_int(.x)
flatten_dbl(.x)
flatten_chr(.x)
flatten_dfr(.x, .id = NULL)
flatten_dfc(.x)
}
\arguments{
\item{.x}{A list to flatten. The contents of the list can be anything for
\code{flatten()} (as a list is returned), but the contents must match the
type for the other functions.}
}
\value{
\code{flatten()} returns a list, \code{flatten_lgl()} a logical
vector, \code{flatten_int()} an integer vector, \code{flatten_dbl()} a
double vector, and \code{flatten_chr()} a character vector.
\code{flatten_dfr()} and \code{flatten_dfc()} return data frames created by
row-binding and column-binding respectively. They require dplyr to
be installed.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}}
These functions were superseded in purrr 1.0.0 because their behaviour was
inconsistent. Superseded functions will not go away, but will only receive
critical bug fixes.
\itemize{
\item \code{flatten()} has been superseded by \code{\link[=list_flatten]{list_flatten()}}.
\item \code{flatten_lgl()}, \code{flatten_int()}, \code{flatten_dbl()}, and \code{flatten_chr()}
have been superseded by \code{\link[=list_c]{list_c()}}.
\item \code{flatten_dfr()} and \code{flatten_dfc()} have been superseded by \code{\link[=list_rbind]{list_rbind()}}
and \code{\link[=list_cbind]{list_cbind()}} respectively.
}
}
\examples{
x <- map(1:3, \(i) sample(4))
x
# was
x |> flatten_int() |> str()
# now
x |> list_c() |> str()
x <- list(list(1, 2), list(3, 4))
# was
x |> flatten() |> str()
# now
x |> list_flatten() |> str()
}
\keyword{internal}
purrr/man/rate-helpers.Rd 0000644 0001762 0000144 00000003005 14307362233 015062 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/rate.R
\name{rate-helpers}
\alias{rate-helpers}
\alias{rate_delay}
\alias{rate_backoff}
\alias{is_rate}
\title{Create delaying rate settings}
\usage{
rate_delay(pause = 1, max_times = Inf)
rate_backoff(
pause_base = 1,
pause_cap = 60,
pause_min = 1,
max_times = 3,
jitter = TRUE
)
is_rate(x)
}
\arguments{
\item{pause}{Delay between attempts in seconds.}
\item{max_times}{Maximum number of requests to attempt.}
\item{pause_base, pause_cap}{\code{rate_backoff()} uses an exponential
back-off so that each request waits \code{pause_base * 2^i} seconds,
up to a maximum of \code{pause_cap} seconds.}
\item{pause_min}{Minimum time to wait in the backoff; generally
only necessary if you need pauses less than one second (which may
not be kind to the server, use with caution!).}
\item{jitter}{Whether to introduce a random jitter in the waiting time.}
\item{x}{An object to test.}
}
\description{
These helpers create rate settings that you can pass to \code{\link[=insistently]{insistently()}} and
\code{\link[=slowly]{slowly()}}. You can also use them in your own functions with \code{\link[=rate_sleep]{rate_sleep()}}.
}
\examples{
# A delay rate waits the same amount of time:
rate <- rate_delay(0.02)
for (i in 1:3) rate_sleep(rate, quiet = FALSE)
# A backoff rate waits exponentially longer each time, with random
# jitter by default:
rate <- rate_backoff(pause_base = 0.2, pause_min = 0.005)
for (i in 1:3) rate_sleep(rate, quiet = FALSE)
}
purrr/man/keep.Rd 0000644 0001762 0000144 00000004036 14311356421 013415 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/keep.R
\name{keep}
\alias{keep}
\alias{discard}
\alias{compact}
\title{Keep/discard elements based on their values}
\usage{
keep(.x, .p, ...)
discard(.x, .p, ...)
compact(.x, .p = identity)
}
\arguments{
\item{.x}{A list or vector.}
\item{.p}{A predicate function (i.e. a function that returns either \code{TRUE}
or \code{FALSE}) specified in one of the following ways:
\itemize{
\item A named function, e.g. \code{is.character}.
\item An anonymous function, e.g. \verb{\\(x) all(x < 0)} or \code{function(x) all(x < 0)}.
\item A formula, e.g. \code{~ all(.x < 0)}. You must use \code{.x} to refer to the first
argument). Only recommended if you require backward compatibility with
older versions of R.
}}
\item{...}{Additional arguments passed on to \code{.p}.}
}
\description{
\code{keep()} selects all elements where \code{.p} evaluates to \code{TRUE};
\code{discard()} selects all elements where \code{.p} evaluates to \code{FALSE}.
\code{compact()} discards elements where \code{.p} evaluates to an empty vector.
}
\details{
In other languages, \code{keep()} and \code{discard()} are often called \code{select()}/
\code{filter()} and \code{reject()}/ \code{drop()}, but those names are already taken
in R. \code{keep()} is similar to \code{\link[=Filter]{Filter()}}, but the argument order is more
convenient, and the evaluation of the predicate function \code{.p} is stricter.
}
\examples{
rep(10, 10) |>
map(sample, 5) |>
keep(function(x) mean(x) > 6)
# Or use a formula
rep(10, 10) |>
map(sample, 5) |>
keep(\(x) mean(x) > 6)
# Using a string instead of a function will select all list elements
# where that subelement is TRUE
x <- rerun(5, a = rbernoulli(1), b = sample(10))
x
x |> keep("a")
x |> discard("a")
# compact() discards elements that are NULL or that have length zero
list(a = "a", b = NULL, c = integer(0), d = NA, e = list()) |>
compact()
}
\seealso{
\code{\link[=keep_at]{keep_at()}}/\code{\link[=discard_at]{discard_at()}} to keep/discard elements by name.
}
purrr/man/quietly.Rd 0000644 0001762 0000144 00000002734 14355342401 014171 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-quietly.R
\name{quietly}
\alias{quietly}
\title{Wrap a function to capture side-effects}
\usage{
quietly(.f)
}
\arguments{
\item{.f}{A function to modify, 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}. Only recommended if you require backward
compatibility with older versions of R.
}}
}
\value{
A function that takes the same arguments as \code{.f}, but returns
a different value, as described above.
}
\description{
Create a modified version of \code{.f} that captures side-effects along with
the return value of the function and returns a list containing
the \code{result}, \code{output}, \code{messages} and \code{warnings}.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
f <- function() {
print("Hi!")
message("Hello")
warning("How are ya?")
"Gidday"
}
f()
f_quiet <- quietly(f)
str(f_quiet())
}
\seealso{
Other adverbs:
\code{\link{auto_browse}()},
\code{\link{compose}()},
\code{\link{insistently}()},
\code{\link{negate}()},
\code{\link{partial}()},
\code{\link{possibly}()},
\code{\link{safely}()},
\code{\link{slowly}()}
}
\concept{adverbs}
purrr/man/cross.Rd 0000644 0001762 0000144 00000011607 14355363321 013631 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-cross.R
\name{cross}
\alias{cross}
\alias{cross2}
\alias{cross3}
\alias{cross_df}
\alias{cross_n}
\alias{cross_d}
\title{Produce all combinations of list elements}
\usage{
cross(.l, .filter = NULL)
cross2(.x, .y, .filter = NULL)
cross3(.x, .y, .z, .filter = NULL)
cross_df(.l, .filter = NULL)
}
\arguments{
\item{.l}{A list of lists or atomic vectors. Alternatively, a data
frame. \code{cross_df()} requires all elements to be named.}
\item{.filter}{A predicate function that takes the same number of
arguments as the number of variables to be combined.}
\item{.x, .y, .z}{Lists or atomic vectors.}
}
\value{
\code{cross2()}, \code{cross3()} and \code{cross()}
always return a list. \code{cross_df()} always returns a data
frame. \code{cross()} returns a list where each element is one
combination so that the list can be directly mapped
over. \code{cross_df()} returns a data frame where each row is one
combination.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
These functions were deprecated in purrr 1.0.0 because they
are slow and buggy, and we no longer think they are the right
approach to solving this problem. Please use \code{tidyr::expand_grid()}
instead.
Here is an example of equivalent usages for \code{cross()} and
\code{expand_grid()}:
\if{html}{\out{
}}
}
\details{
\code{cross2()} returns the product set of the elements of
\code{.x} and \code{.y}. \code{cross3()} takes an additional
\code{.z} argument. \code{cross()} takes a list \code{.l} and
returns the cartesian product of all its elements in a list, with
one combination by element. \code{cross_df()} is like
\code{cross()} but returns a data frame, with one combination by
row.
\code{cross()}, \code{cross2()} and \code{cross3()} return the
cartesian product is returned in wide format. This makes it more
amenable to mapping operations. \code{cross_df()} returns the output
in long format just as \code{expand.grid()} does. This is adapted
to rowwise operations.
When the number of combinations is large and the individual
elements are heavy memory-wise, it is often useful to filter
unwanted combinations on the fly with \code{.filter}. It must be
a predicate function that takes the same number of arguments as the
number of crossed objects (2 for \code{cross2()}, 3 for
\code{cross3()}, \code{length(.l)} for \code{cross()}) and
returns \code{TRUE} or \code{FALSE}. The combinations where the
predicate function returns \code{TRUE} will be removed from the
result.
}
\examples{
# We build all combinations of names, greetings and separators from our
# list of data and pass each one to paste()
data <- list(
id = c("John", "Jane"),
greeting = c("Hello.", "Bonjour."),
sep = c("! ", "... ")
)
data |>
cross() |>
map(lift(paste))
# cross() returns the combinations in long format: many elements,
# each representing one combination. With cross_df() we'll get a
# data frame in long format: crossing three objects produces a data
# frame of three columns with each row being a particular
# combination. This is the same format that expand.grid() returns.
args <- data |> cross_df()
# In case you need a list in long format (and not a data frame)
# just run as.list() after cross_df()
args |> as.list()
# This format is often less practical for functional programming
# because applying a function to the combinations requires a loop
out <- vector("character", length = nrow(args))
for (i in seq_along(out))
out[[i]] <- invoke("paste", map(args, i))
out
# It's easier to transpose and then use invoke_map()
args |> transpose() |> map_chr(\(x) exec(paste, !!!x))
# Unwanted combinations can be filtered out with a predicate function
filter <- function(x, y) x >= y
cross2(1:5, 1:5, .filter = filter) |> str()
# To give names to the components of the combinations, we map
# setNames() on the product:
x <- seq_len(3)
cross2(x, x, .filter = `==`) |>
map(setNames, c("x", "y"))
# Alternatively we can encapsulate the arguments in a named list
# before crossing to get named components:
list(x = x, y = x) |>
cross(.filter = `==`)
}
\seealso{
\code{\link[=expand.grid]{expand.grid()}}
}
\keyword{internal}
purrr/man/rerun.Rd 0000644 0001762 0000144 00000002540 14311356421 013622 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/deprec-rerun.R
\name{rerun}
\alias{rerun}
\title{Re-run expressions multiple times}
\usage{
rerun(.n, ...)
}
\arguments{
\item{.n}{Number of times to run expressions}
\item{...}{Expressions to re-run.}
}
\value{
A list of length \code{.n}. Each element of \code{...} will be
re-run once for each \code{.n}.
There is one special case: if there's a single unnamed input, the second
level list will be dropped. In this case, \code{rerun(n, x)} behaves like
\code{replicate(n, x, simplify = FALSE)}.
}
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}
This function was deprecated in purrr 1.0.0 because we believe that NSE
functions are not a good fit for purrr. Also, \code{rerun(n, x)} can just as
easily be expressed as \verb{map(1:n, \\(i) x)}
\code{rerun()} is a convenient way of generating sample data. It works similarly to
\code{\link{replicate}(..., simplify = FALSE)}.
}
\examples{
# old
5 |> rerun(rnorm(5)) |> str()
# new
1:5 |> map(\(i) rnorm(5)) |> str()
# old
5 |>
rerun(x = rnorm(5), y = rnorm(5)) |>
map_dbl(\(l) cor(l$x, l$y))
# new
1:5 |>
map(\(i) list(x = rnorm(5), y = rnorm(5))) |>
map_dbl(\(l) cor(l$x, l$y))
}
\keyword{internal}
purrr/man/slowly.Rd 0000644 0001762 0000144 00000003312 14355342401 014017 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-slowly.R
\name{slowly}
\alias{slowly}
\title{Wrap a function to wait between executions}
\usage{
slowly(f, rate = rate_delay(), quiet = TRUE)
}
\arguments{
\item{f}{A function to modify, 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}. Only recommended if you require backward
compatibility with older versions of R.
}}
\item{rate}{A \link[=rate-helpers]{rate} object. Defaults to a constant delay.}
\item{quiet}{Hide errors (\code{TRUE}, the default), or display them
as they occur?}
}
\value{
A function that takes the same arguments as \code{.f}, but returns
a different value, as described above.
}
\description{
\code{slowly()} takes a function and modifies it to wait a given
amount of time between each call.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
# For these example, we first create a custom rate
# with a low waiting time between attempts:
rate <- rate_delay(0.1)
# slowly() causes a function to sleep for a given time between calls:
slow_runif <- slowly(\(x) runif(1), rate = rate, quiet = FALSE)
out <- map(1:5, slow_runif)
}
\seealso{
Other adverbs:
\code{\link{auto_browse}()},
\code{\link{compose}()},
\code{\link{insistently}()},
\code{\link{negate}()},
\code{\link{partial}()},
\code{\link{possibly}()},
\code{\link{quietly}()},
\code{\link{safely}()}
}
\concept{adverbs}
purrr/man/rmd/ 0000755 0001762 0000144 00000000000 14355573666 013005 5 ustar ligges users purrr/man/rmd/indexed-error.Rmd 0000644 0001762 0000144 00000006743 14355607167 016224 0 ustar ligges users The `purrr_error_indexed` class is thrown by [map()], [map2()], [pmap()], and friends.
It wraps errors thrown during the processing on individual elements with information about the location of the error.
# Structure
`purrr_error_indexed` has three important fields:
- `location`: the location of the error as a single integer.
- `name`: the name of the location as a string. If the element was not named, `name` will be `NULL`
- `parent`: the original error thrown by `.f`.
Let's see this in action by capturing the generated condition from a very simple example:
```{r}
f <- function(x) {
rlang::abort("This is an error")
}
cnd <- rlang::catch_cnd(map(c(1, 4, 2), f))
class(cnd)
cnd$location
cnd$name
print(cnd$parent, backtrace = FALSE)
```
If the input vector is named, `name` will be non-`NULL`:
```{r}
cnd <- rlang::catch_cnd(map(c(a = 1, b = 4, c = 2), f))
cnd$name
```
# Handling errors
(This section assumes that you're familiar with the basics of error handling in R, as described in [Advanced R](https://adv-r.hadley.nz/conditions.html).)
This error chaining is really useful when doing interactive data analysis, but it adds some extra complexity when handling errors with `tryCatch()` or `withCallingHandlers()`.
Let's see what happens by adding a custom class to the error thrown by `f()`:
```{r}
#| error: true
f <- function(x) {
rlang::abort("This is an error", class = "my_error")
}
map(c(1, 4, 2, 5, 3), f)
```
This doesn't change the visual display, but you might be surprised if you try to catch this error with `tryCatch()` or `withCallingHandlers()`:
```{r}
#| error: true
tryCatch(
map(c(1, 4, 2, 5, 3), f),
my_error = function(err) {
# use NULL value if error
NULL
}
)
withCallingHandlers(
map(c(1, 4, 2, 5, 3), f),
my_error = function(err) {
# throw a more informative error
abort("Wrapped error", parent = err)
}
)
```
That's because, as described above, the error that `map()` throws will always have class `purrr_error_indexed`:
```{r}
tryCatch(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) {
print("Hello! I am now called :)")
}
)
```
In order to handle the error thrown by `f()`, you'll need to use `rlang::cnd_inherits()` on the parent error:
```{r}
#| error: true
tryCatch(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) {
if (rlang::cnd_inherits(err, "my_error")) {
NULL
} else {
rlang::cnd_signal(err)
}
}
)
withCallingHandlers(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) {
if (rlang::cnd_inherits(err, "my_error")) {
abort("Wrapped error", parent = err)
}
}
)
```
(The `tryCatch()` approach is suboptimal because we're no longer just handling errors, but also rethrowing them.
The rethrown errors won't work correctly with (e.g.) `recover()` and `traceback()`, but we don't currently have a better approach.
In the future we expect to [enhance `try_fetch()`](https://github.com/r-lib/rlang/issues/1534) to make this easier to do 100% correctly).
Finally, if you just want to get rid of purrr's wrapper error, you can resignal the parent error:
```{r}
#| error: true
withCallingHandlers(
map(c(1, 4, 2, 5, 3), f),
purrr_error_indexed = function(err) {
rlang::cnd_signal(err$parent)
}
)
```
Because we are resignalling an error, it's important to use `withCallingHandlers()` and not `tryCatch()` in order to preserve the full backtrace context.
That way `recover()`, `traceback()`, and related tools will continue to work correctly.
purrr/man/auto_browse.Rd 0000644 0001762 0000144 00000003112 14355342401 015015 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adverb-auto-browse.R
\name{auto_browse}
\alias{auto_browse}
\title{Wrap a function so it will automatically \code{browse()} on error}
\usage{
auto_browse(.f)
}
\arguments{
\item{.f}{A function to modify, 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}. Only recommended if you require backward
compatibility with older versions of R.
}}
}
\value{
A function that takes the same arguments as \code{.f}, but returns
a different value, as described above.
}
\description{
A function wrapped with \code{auto_browse()} will automatically enter an
interactive debugger using \code{\link[=browser]{browser()}} when ever it encounters an error.
}
\section{Adverbs}{
This function is called an adverb because it modifies the effect of a
function (a verb). If you'd like to include a function created an adverb
in a package, be sure to read \link{faq-adverbs-export}.
}
\examples{
# For interactive usage, auto_browse() is useful because it automatically
# starts a browser() in the right place.
f <- function(x) {
y <- 20
if (x > 5) {
stop("!")
} else {
x
}
}
if (interactive()) {
map(1:6, auto_browse(f))
}
}
\seealso{
Other adverbs:
\code{\link{compose}()},
\code{\link{insistently}()},
\code{\link{negate}()},
\code{\link{partial}()},
\code{\link{possibly}()},
\code{\link{quietly}()},
\code{\link{safely}()},
\code{\link{slowly}()}
}
\concept{adverbs}
purrr/man/modify.Rd 0000644 0001762 0000144 00000011744 14314671330 013766 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/modify.R
\name{modify}
\alias{modify}
\alias{modify_if}
\alias{modify_at}
\alias{modify2}
\alias{imodify}
\title{Modify elements selectively}
\usage{
modify(.x, .f, ...)
modify_if(.x, .p, .f, ..., .else = NULL)
modify_at(.x, .at, .f, ...)
modify2(.x, .y, .f, ...)
imodify(.x, .f, ...)
}
\arguments{
\item{.x}{A vector.}
\item{.f}{A function specified in the same way as the corresponding map
function.}
\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{.p}{A single predicate function, a formula describing such a
predicate function, or a logical vector of the same length as \code{.x}.
Alternatively, if the elements of \code{.x} are themselves lists of
objects, a string indicating the name of a logical element in the
inner lists. Only those elements where \code{.p} evaluates to
\code{TRUE} will be modified.}
\item{.else}{A function applied to elements of \code{.x} for which \code{.p}
returns \code{FALSE}.}
\item{.at}{A logical, integer, or character vector giving the elements
to select. Alternatively, a function that takes a vector of names,
and returns a logical, integer, or character vector of elements to select.
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}: if the tidyselect package is
installed, you can use \code{vars()} and tidyselect helpers to select
elements.}
\item{.y}{A vector, usually the same length as \code{.x}.}
}
\value{
An object the same class as \code{.x}
}
\description{
Unlike \code{\link[=map]{map()}} and its variants which always return a fixed object
type (list for \code{map()}, integer vector for \code{map_int()}, etc), the
\code{modify()} family always returns the same type as the input object.
\itemize{
\item \code{modify()} is a shortcut for \verb{x[[i]] <- f(x[[i]]); return(x)}.
\item \code{modify_if()} only modifies the elements of \code{x} that satisfy a
predicate and leaves the others unchanged. \code{modify_at()} only
modifies elements given by names or positions.
\item \code{modify2()} modifies the elements of \code{.x} but also passes the
elements of \code{.y} to \code{.f}, just like \code{\link[=map2]{map2()}}. \code{imodify()} passes
the names or the indices to \code{.f} like \code{\link[=imap]{imap()}} does.
\item \code{\link[=modify_in]{modify_in()}} modifies a single element in a \code{\link[=pluck]{pluck()}} location.
}
}
\details{
Since the transformation can alter the structure of the input; it's
your responsibility to ensure that the transformation produces a
valid output. For example, if you're modifying a data frame, \code{.f}
must preserve the length of the input.
}
\section{Genericity}{
\code{modify()} and variants are generic over classes that implement
\code{length()}, \code{[[} and \verb{[[<-} methods. If the default implementation
is not compatible for your class, you can override them with your
own methods.
If you implement your own \code{modify()} method, make sure it satisfies
the following invariants:
\if{html}{\out{
}}
These invariants are known as the \href{https://wiki.haskell.org/Functor#Functor_Laws}{functor laws} in computer
science.
}
\examples{
# Convert factors to characters
iris |>
modify_if(is.factor, as.character) |>
str()
# Specify which columns to map with a numeric vector of positions:
mtcars |> modify_at(c(1, 4, 5), as.character) |> str()
# Or with a vector of names:
mtcars |> modify_at(c("cyl", "am"), as.character) |> str()
list(x = sample(c(TRUE, FALSE), 100, replace = TRUE), y = 1:100) |>
list_transpose(simplify = FALSE) |>
modify_if("x", \(l) list(x = l$x, y = l$y * 100)) |>
list_transpose()
# Use modify2() to map over two vectors and preserve the type of
# the first one:
x <- c(foo = 1L, bar = 2L)
y <- c(TRUE, FALSE)
modify2(x, y, \(x, cond) if (cond) x else 0L)
# Use a predicate function to decide whether to map a function:
modify_if(iris, is.factor, as.character)
# Specify an alternative with the `.else` argument:
modify_if(iris, is.factor, as.character, .else = as.integer)
}
\seealso{
Other map variants:
\code{\link{imap}()},
\code{\link{lmap}()},
\code{\link{map2}()},
\code{\link{map_depth}()},
\code{\link{map_if}()},
\code{\link{map}()},
\code{\link{pmap}()}
Other modify variants:
\code{\link{map_depth}()},
\code{\link{modify_tree}()}
}
\concept{map variants}
\concept{modify variants}
purrr/man/head_while.Rd 0000644 0001762 0000144 00000002700 14314671330 014560 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/head-tail.R
\name{head_while}
\alias{head_while}
\alias{tail_while}
\title{Find head/tail that all satisfies a predicate.}
\usage{
head_while(.x, .p, ...)
tail_while(.x, .p, ...)
}
\arguments{
\item{.x}{A list or atomic vector.}
\item{.p}{A single predicate function, a formula describing such a
predicate function, or a logical vector of the same length as \code{.x}.
Alternatively, if the elements of \code{.x} are themselves lists of
objects, a string indicating the name of a logical element in the
inner lists. Only those elements where \code{.p} evaluates to
\code{TRUE} will be modified.}
\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.}
}
\value{
A vector the same type as \code{.x}.
}
\description{
Find head/tail that all satisfies a predicate.
}
\examples{
pos <- function(x) x >= 0
head_while(5:-5, pos)
tail_while(5:-5, negate(pos))
big <- function(x) x > 100
head_while(0:10, big)
tail_while(0:10, big)
}
purrr/man/detect.Rd 0000644 0001762 0000144 00000005013 14311356421 013735 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/detect.R
\name{detect}
\alias{detect}
\alias{detect_index}
\title{Find the value or position of the first match}
\usage{
detect(
.x,
.f,
...,
.dir = c("forward", "backward"),
.right = NULL,
.default = NULL
)
detect_index(.x, .f, ..., .dir = c("forward", "backward"), .right = NULL)
}
\arguments{
\item{.x}{A list or 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}. You must use \code{.x} to refer to the first
argument. Only recommended if you require backward compatibility with
older versions of R.
\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.
}}
\item{...}{Additional arguments passed on to \code{.p}.}
\item{.dir}{If \code{"forward"}, the default, starts at the beginning of
the vector and move towards the end; if \code{"backward"}, starts at
the end of the vector and moves towards the beginning.}
\item{.right}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use \code{.dir} instead.}
\item{.default}{The value returned when nothing is detected.}
}
\value{
\code{detect} the value of the first item that matches the
predicate; \code{detect_index} the position of the matching item.
If not found, \code{detect} returns \code{NULL} and \code{detect_index}
returns 0.
}
\description{
Find the value or position of the first match
}
\examples{
is_even <- function(x) x \%\% 2 == 0
3:10 |> detect(is_even)
3:10 |> detect_index(is_even)
3:10 |> detect(is_even, .dir = "backward")
3:10 |> detect_index(is_even, .dir = "backward")
# Since `.f` is passed to as_mapper(), you can supply a
# lambda-formula or a pluck object:
x <- list(
list(1, foo = FALSE),
list(2, foo = TRUE),
list(3, foo = TRUE)
)
detect(x, "foo")
detect_index(x, "foo")
# If you need to find all values, use keep():
keep(x, "foo")
# If you need to find all positions, use map_lgl():
which(map_lgl(x, "foo"))
}
\seealso{
\code{\link[=keep]{keep()}} for keeping all matching values.
}
purrr/DESCRIPTION 0000644 0001762 0000144 00000002401 14465116667 013147 0 ustar ligges users Package: purrr
Title: Functional Programming Tools
Version: 1.0.2
Authors@R: c(
person("Hadley", "Wickham", , "hadley@rstudio.com", role = c("aut", "cre"),
comment = c(ORCID = "0000-0003-4757-117X")),
person("Lionel", "Henry", , "lionel@rstudio.com", role = "aut"),
person("RStudio", role = c("cph", "fnd"))
)
Description: A complete and consistent functional programming toolkit for
R.
License: MIT + file LICENSE
URL: https://purrr.tidyverse.org/, https://github.com/tidyverse/purrr
BugReports: https://github.com/tidyverse/purrr/issues
Depends: R (>= 3.5.0)
Imports: cli (>= 3.6.1), lifecycle (>= 1.0.3), magrittr (>= 1.5.0),
rlang (>= 1.1.1), vctrs (>= 0.6.3)
Suggests: covr, dplyr (>= 0.7.8), httr, knitr, lubridate, rmarkdown,
testthat (>= 3.0.0), tibble, tidyselect
LinkingTo: cli
VignetteBuilder: knitr
Biarch: true
Config/Needs/website: tidyverse/tidytemplate, tidyr
Config/testthat/edition: 3
Encoding: UTF-8
RoxygenNote: 7.2.3
NeedsCompilation: yes
Packaged: 2023-08-08 16:13:31 UTC; hadleywickham
Author: Hadley Wickham [aut, cre] (),
Lionel Henry [aut],
RStudio [cph, fnd]
Maintainer: Hadley Wickham
Repository: CRAN
Date/Publication: 2023-08-10 08:20:07 UTC
purrr/build/ 0000755 0001762 0000144 00000000000 14464464653 012543 5 ustar ligges users purrr/build/vignette.rds 0000644 0001762 0000144 00000000375 14464464653 015107 0 ustar ligges users uPj0Į[J]{|饄 zƪ#H2!|y\IB v5ݝA C>mlBjt
vx
Gٚ@OW]&.ou/)tZ`%L0=< ,
~P#k ^*fIy*"Tgm yK;*OJ;<*:UI;0 сIhb~:t? purrr/tests/ 0000755 0001762 0000144 00000000000 13630736102 012567 5 ustar ligges users purrr/tests/testthat/ 0000755 0001762 0000144 00000000000 14465116667 014446 5 ustar ligges users purrr/tests/testthat/test-list-combine.R 0000644 0001762 0000144 00000005341 14344666512 020131 0 ustar ligges users test_that("list_c() concatenates vctrs of compatible types", {
expect_identical(list_c(list(1L, 2:3)), c(1L, 2L, 3L))
expect_identical(list_c(list(1, 2:3)), c(1, 2, 3))
expect_snapshot(error = TRUE,
list_c(list("a", 1))
)
})
test_that("list_c() can enforce ptype", {
expect_snapshot(error = TRUE,
list_c(list("a"), ptype = integer())
)
})
test_that("list_c() strips outer names and preserves inner names (#997)", {
expect_equal(list_c(list(x = 1:2, y = 3:4)), 1:4)
expect_equal(list_c(list(c(a = 1), c(b = 2))), c(a = 1, b =2))
})
test_that("list_cbind() column-binds compatible data frames",{
df1 <- data.frame(x = 1:2)
df2 <- data.frame(y = 1:2)
df3 <- data.frame(z = 1:3)
expect_equal(list_cbind(list(df1, df2)), data.frame(x = 1:2, y = 1:2))
expect_snapshot(error = TRUE, {
list_cbind(list(df1, df3))
})
})
test_that("list_cbind() can enforce size", {
df1 <- data.frame(x = 1:2)
expect_snapshot(error = TRUE, {
list_cbind(list(df1), size = 3)
})
})
test_that("list_rbind() row-binds compatible data.frames", {
df1 <- data.frame(x = 1)
df2 <- data.frame(x = 2, y = 1)
df3 <- data.frame(x = "a", stringsAsFactors = FALSE)
expect_equal(list_rbind(list(df1, df2)), data.frame(x = 1:2, y = c(NA, 1)))
# and names don't make a difference unless `names_to` is set
out <- list_rbind(list(a = df1, b = df2))
expect_equal(out, data.frame(x = c(1, 2), y = c(NA, 1)))
expect_snapshot(error = TRUE, {
list_rbind(list(df1, df3))
})
})
test_that("list_rbind() can enforce ptype", {
df1 <- data.frame(x = 1)
expect_snapshot(error = TRUE, {
ptype <- data.frame(x = character(), stringsAsFactors = FALSE)
list_rbind(list(df1), ptype = ptype)
})
})
test_that("NULLs are ignored", {
df1 <- data.frame(x = 1)
df2 <- data.frame(y = 1)
expect_equal(list_c(list(1, NULL, 2)), c(1, 2))
expect_equal(list_rbind(list(df1, NULL, df1)), vec_rbind(df1, df1))
expect_equal(list_cbind(list(df1, NULL, df2)), vec_cbind(df1, df2))
})
test_that("empty inputs return expected output", {
expect_equal(list_c(list()), NULL)
expect_equal(list_c(list(NULL)), NULL)
expect_equal(list_rbind(list()), data.frame())
expect_equal(list_rbind(list(NULL)), data.frame())
expect_equal(list_cbind(list()), data.frame())
expect_equal(list_cbind(list(NULL)), data.frame())
})
test_that("assert input is a list", {
expect_snapshot(error = TRUE, {
list_c(1)
list_rbind(1)
list_cbind(1)
})
# and not just built on a list
expect_snapshot(error = TRUE, {
list_c(mtcars)
list_rbind(mtcars)
list_cbind(mtcars)
})
})
test_that("assert input is list of data frames", {
expect_snapshot(error = TRUE, {
list_rbind(list(1, mtcars, 3))
list_cbind(list(1, mtcars, 3))
})
})
purrr/tests/testthat/test-adverb-negate.R 0000644 0001762 0000144 00000001111 14304371054 020225 0 ustar ligges users test_that("negate works with both functions and vectors", {
true <- function(...) TRUE
expect_equal(negate(true)(), FALSE)
expect_equal(negate("x")(list(x = TRUE)), FALSE)
expect_equal(negate(is.null)(TRUE), TRUE)
expect_equal(negate(is.null)(NULL), FALSE)
})
test_that("negate() works with early returns", {
expect_false(negate(~ return(TRUE))())
})
test_that("negate() works with generic functions and local methods", {
is_foobar <- function(x) UseMethod("is_foobar")
local({
is_foobar.default <- function(x) TRUE
expect_false(negate(is_foobar)())
})
})
purrr/tests/testthat/test-map.R 0000644 0001762 0000144 00000010516 14355573666 016332 0 ustar ligges users test_that("preserves names", {
out <- map(list(x = 1, y = 2), identity)
expect_equal(names(out), c("x", "y"))
})
test_that("creates simple call", {
out <- map(1, function(x) sys.call())[[1]]
expect_equal(out, quote(.f(.x[[i]], ...)))
})
test_that("fails on non-vectors", {
expect_snapshot(map(environment(), identity), error = TRUE)
expect_snapshot(map(quote(a), identity), error = TRUE)
})
test_that("works with vctrs records (#963)", {
x <- new_rcrd(list(x = c(1, 2), y = c("a", "b")))
out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b")))
expect_identical(map(x, identity), out)
})
test_that("works with matrices/arrays (#970)", {
expect_identical(
map_int(matrix(1:4, nrow = 2), identity),
1:4
)
})
test_that("all inform about location of problem", {
fail_at_3 <- function(x, bad) {
if (x == 3) bad else x
}
expect_snapshot(error = TRUE, {
map_int(1:3, ~ fail_at_3(.x, 2:1))
map_int(1:3, ~ fail_at_3(.x, "x"))
map(1:3, ~ fail_at_3(.x, stop("Doesn't work")))
})
cnd <- catch_cnd(map(1:3, ~ fail_at_3(.x, stop("Doesn't work"))))
expect_s3_class(cnd, "purrr_error_indexed")
expect_equal(cnd$location, 3)
expect_equal(cnd$name, NULL)
})
test_that("error location uses name if present", {
fail_at_3 <- function(x, bad) {
if (x == 3) bad else x
}
expect_snapshot(error = TRUE, {
map_int(c(a = 1, b = 2, c = 3), ~ fail_at_3(.x, stop("Error")))
map_int(c(a = 1, b = 2, 3), ~ fail_at_3(.x, stop("Error")))
})
cnd <- catch_cnd(map(c(1, 2, c = 3), ~ fail_at_3(.x, stop("Doesn't work"))))
expect_s3_class(cnd, "purrr_error_indexed")
expect_equal(cnd$location, 3)
expect_equal(cnd$name, "c")
})
test_that("0 length input gives 0 length output", {
expect_equal(map(list(), identity), list())
expect_equal(map(NULL, identity), list())
expect_equal(map_lgl(NULL, identity), logical())
})
test_that("map() always returns a list", {
expect_bare(map(mtcars, mean), "list")
})
test_that("types automatically coerced correctly", {
expect_identical(map_lgl(c(NA, 0, 1), identity), c(NA, FALSE, TRUE))
expect_identical(map_int(c(NA, FALSE, TRUE), identity), c(NA, 0L, 1L))
expect_identical(map_int(c(NA, 1, 2), identity), c(NA, 1L, 2L))
expect_identical(map_dbl(c(NA, FALSE, TRUE), identity), c(NA, 0, 1))
expect_identical(map_dbl(c(NA, 1L, 2L), identity), c(NA, 1, 2))
expect_identical(map_chr(NA, identity), NA_character_)
})
test_that("logical and integer NA become correct double NA", {
expect_identical(
map_dbl(list(NA, NA_integer_), identity),
c(NA_real_, NA_real_)
)
})
test_that("map forces arguments in same way as base R", {
f_map <- map(1:2, function(i) function(x) x + i)
f_base <- lapply(1:2, function(i) function(x) x + i)
expect_equal(f_map[[1]](0), f_base[[1]](0))
expect_equal(f_map[[2]](0), f_base[[2]](0))
})
test_that("walk is used for side-effects", {
expect_output(walk(1:3, str))
})
test_that("primitive dispatch correctly", {
local_bindings(.env = global_env(),
as.character.test_class = function(x) "dispatched!"
)
x <- structure(list(), class = "test_class")
expect_identical(map(list(x, x), as.character), list("dispatched!", "dispatched!"))
})
test_that("map() with empty input copies names", {
named_list <- named(list())
expect_identical( map(named_list, identity), named(list()))
expect_identical(map_lgl(named_list, identity), named(lgl()))
expect_identical(map_int(named_list, identity), named(int()))
expect_identical(map_dbl(named_list, identity), named(dbl()))
expect_identical(map_chr(named_list, identity), named(chr()))
})
# map_vec -----------------------------------------------------------------
test_that("still iterates using [[", {
df <- data.frame(x = 1, y = 2, z = 3)
expect_equal(map_vec(df, length), c(x = 1, y = 1, z = 1))
})
test_that("requires output be length 1 and have common type", {
expect_snapshot(error = TRUE, {
map_vec(1:2, ~ rep(1, .x))
map_vec(1:2, ~ if (.x == 1) factor("x") else 1)
})
})
test_that("row-binds data frame output", {
out <- map_vec(1:2, ~ data.frame(x = .x))
expect_equal(out, data.frame(x = 1:2))
})
test_that("concatenates list output", {
out <- map_vec(1:2, ~ list(.x))
expect_equal(out, list(1, 2))
})
test_that("can enforce .ptype", {
expect_snapshot(error = TRUE, {
map_vec(1:2, ~ factor("x"), .ptype = integer())
})
})
purrr/tests/testthat/test-head-tail.R 0000644 0001762 0000144 00000001114 14310436312 017350 0 ustar ligges users y <- 1:100
test_that("head_while works", {
expect_length(head_while(y, function(x) x <= 15), 15)
})
test_that("tail_while works", {
expect_length(tail_while(y, function(x) x >= 86), 15)
})
test_that("original vector returned if predicate satisfied by all elements", {
expect_identical(head_while(y, function(x) x <= 100), y)
expect_identical(tail_while(y, function(x) x >= 0), y)
})
test_that("head_while and tail_while require predicate function", {
expect_snapshot(head_while(1:3, ~ NA), error = TRUE)
expect_snapshot(tail_while(1:3, ~ c(TRUE, FALSE)), error = TRUE)
})
purrr/tests/testthat/test-pluck.R 0000644 0001762 0000144 00000016553 14311066210 016650 0 ustar ligges users test_that("can pluck/chuck from NULL", {
expect_equal(pluck(NULL, 1), NULL)
expect_snapshot(chuck(NULL, 1), error = TRUE)
})
test_that("can pluck vector types ", {
x <- list(
lgl = c(TRUE, FALSE),
int = 1:2,
dbl = c(1, 2.5),
chr = c("a", "b"),
cpx = c(1 + 1i, 2 + 2i),
raw = charToRaw("ab"),
lst = list(1, 2)
)
expect_equal(pluck(x, "lgl", 2), FALSE)
expect_identical(pluck(x, "int", 2), 2L)
expect_equal(pluck(x, "dbl", 2), 2.5)
expect_equal(pluck(x, "chr", 2), "b")
expect_equal(pluck(x, "cpx", 2), 2 + 2i)
expect_equal(pluck(x, "raw", 2), charToRaw("b"))
expect_equal(pluck(x, "lst", 2), 2)
})
test_that("unsupported types have useful error", {
expect_snapshot(error = TRUE, {
pluck(quote(x), 1)
pluck(quote(f(x, 1)), 1)
pluck(expression(1), 1)
})
})
test_that("dots must be unnamed", {
expect_snapshot(pluck(1, a = 1), error = TRUE)
expect_snapshot(chuck(1, a = 1), error = TRUE)
})
test_that("can pluck by position (positive and negative)", {
x <- list("a", "b", "c")
expect_equal(pluck(x, 1), "a")
expect_equal(pluck(x, -1), "c")
expect_equal(pluck(x, 0), NULL)
expect_equal(pluck(x, 4), NULL)
expect_equal(pluck(x, -4), NULL)
expect_equal(pluck(x, -5), NULL)
expect_snapshot(chuck(x, 0), error = TRUE)
expect_snapshot(chuck(x, 4), error = TRUE)
expect_snapshot(chuck(x, -4), error = TRUE)
expect_snapshot(chuck(x, -5), error = TRUE)
})
test_that("special numbers don't match", {
x <- list()
expect_equal(pluck(x, NA_integer_), NULL)
expect_equal(pluck(x, NA_real_), NULL)
expect_equal(pluck(x, NaN), NULL)
expect_equal(pluck(x, Inf), NULL)
expect_equal(pluck(x, -Inf), NULL)
expect_snapshot(chuck(x, NA_integer_), error = TRUE)
expect_snapshot(chuck(x, NA_real_), error = TRUE)
expect_snapshot(chuck(x, NaN), error = TRUE)
expect_snapshot(chuck(x, Inf), error = TRUE)
expect_snapshot(chuck(x, -Inf), error = TRUE)
})
test_that("can pluck by name", {
x <- list(a = "a")
expect_equal(pluck(x, "a"), "a")
expect_equal(pluck(x, "b"), NULL)
expect_equal(pluck(x, NA_character_), NULL)
expect_equal(pluck(x, ""), NULL)
expect_snapshot(chuck(x, "b"), error = TRUE)
expect_snapshot(chuck(x, NA_character_), error = TRUE)
expect_snapshot(chuck(x, ""), error = TRUE)
})
test_that("even if names don't exist", {
x <- list("a")
expect_equal(pluck(x, "a"), NULL)
expect_snapshot(chuck(x, "a"), error = TRUE)
})
test_that("matches first name if duplicated", {
x <- list(1, 2, 3, 4, 5)
names(x) <- c("a", "a", NA, "", "b")
expect_equal(pluck(x, "a"), 1)
})
test_that("empty and NA names never match", {
x <- list(1, 2, 3)
names(x) <- c("", NA, "x")
expect_equal(pluck(x, "x"), 3)
expect_equal(pluck(x, ""), NULL)
expect_equal(pluck(x, NA_character_), NULL)
expect_snapshot(chuck(x, ""), error = TRUE)
expect_snapshot(chuck(x, NA_character_), error = TRUE)
})
test_that("require length 1 character/double vectors", {
expect_snapshot(error = TRUE, {
pluck(1, 1:2)
pluck(1, integer())
pluck(1, NULL)
pluck(1, TRUE)
})
})
test_that("validate index even when indexing NULL", {
expect_snapshot(error = TRUE, {
pluck(NULL, 1:2)
pluck(NULL, TRUE)
})
})
test_that("can pluck 0-length object", {
expect_equal(pluck(list(integer()), 1), integer())
})
test_that("supports splicing", {
x <- list(list(bar = 1, foo = 2))
idx <- list(1, "foo")
expect_identical(pluck(x, !!!idx), 2)
})
# functions ---------------------------------------------------------------
test_that("can pluck attributes", {
x <- structure(
list(
structure(
list(),
x = 1
)
),
y = 2
)
expect_equal(pluck(x, attr_getter("y")), 2)
expect_equal(pluck(x, 1, attr_getter("x")), 1)
})
test_that("attr_getter() uses exact (non-partial) matching", {
x <- 1
attr(x, "labels") <- "foo"
expect_identical(attr_getter("labels")(x), "foo")
expect_identical(attr_getter("label")(x), NULL)
})
test_that("attr_getter() evaluates eagerly", {
getters <- new_list(2)
attrs <- c("foo", "bar")
for (i in seq_along(attrs)) {
getters[[i]] <- attr_getter(attrs[[i]])
}
x <- structure(list(), foo = "foo", bar = "bar")
expect_identical(getters[[1]](x), "foo")
})
test_that("accessors throw correct errors", {
expect_snapshot(error = TRUE, {
pluck(1:3, function() NULL)
pluck(1:3, function(x, y) y)
})
})
test_that("pluck() functions dispatch on base getters", {
expect_identical(pluck(iris, "Species", levels), levels(iris$Species))
})
test_that("pluck() supports primitive and built-in functions (#404)", {
x <- list(1:2)
expect_equal(pluck(x, 1, as.character), c("1", "2"))
expect_equal(pluck(x, 1, sum), 3)
})
# environments ------------------------------------------------------------
test_that("can pluck/chuck environment by name", {
x <- new_environment(list(x = 10))
expect_equal(pluck(x, "x"), 10)
expect_equal(pluck(x, "y"), NULL)
expect_equal(pluck(x, NA_character_), NULL)
expect_snapshot(chuck(x, "y"), error = TRUE)
expect_snapshot(chuck(x, NA_character_), error = TRUE)
})
test_that("environments error with invalid indices", {
expect_snapshot(pluck(environment(), 1), error = TRUE)
expect_snapshot(pluck(environment(), letters), error = TRUE)
})
# S4 ----------------------------------------------------------------------
newA <- methods::setClass("A", list(a = "numeric"))
test_that("can pluck/chuck from S4 objects", {
A <- newA(a = 1)
expect_equal(pluck(A, "a"), 1)
expect_equal(pluck(A, "b"), NULL)
expect_equal(pluck(A, NA_character_), NULL)
expect_snapshot(chuck(A, "b"), error = TRUE)
expect_snapshot(chuck(A, NA_character_), error = TRUE)
})
test_that("S4 objects error with invalid indices", {
A <- newA(a = 1)
expect_snapshot(pluck(A, 1), error = TRUE)
expect_snapshot(pluck(A, letters), error = TRUE)
})
# S3 ----------------------------------------------------------------------
test_that("pluck() dispatches on vector methods", {
new_test_pluck <- function(x) {
structure(list(x), class = "test_pluck")
}
inner <- list(a = "foo", b = list("bar"))
x <- list(new_test_pluck(inner))
with_bindings(.env = global_env(),
`[[.test_pluck` = function(x, i) .subset2(x, 1)[[i]],
names.test_pluck = function(x) names(.subset2(x, 1)),
length.test_pluck = function(x) length(.subset2(x, 1)),
{
expect_identical(pluck(x, 1, 1), "foo")
expect_identical(pluck(x, 1, "b", 1), "bar")
expect_identical(chuck(x, 1, 1), "foo")
expect_identical(chuck(x, 1, "b", 1), "bar")
}
)
# With faulty length() method
with_bindings(.env = global_env(),
`[[.test_pluck` = function(x, i) .subset2(x, 1)[[i]],
length.test_pluck = function(x) NA,
{
expect_null(pluck(x, 1, 1))
expect_error(chuck(x, 1, 1), "Length of S3 object must be a scalar integer")
}
)
# With faulty names() method
with_bindings(.env = global_env(),
`[[.test_pluck` = function(x, i) .subset2(x, 1)[[i]],
names.test_pluck = function(x) NA,
length.test_pluck = function(x) length(.subset2(x, 1)),
{
expect_null(pluck(x, 1, "b", 1))
expect_error(chuck(x, 1, "b", 1), "unnamed vector")
}
)
})
# Setting -----------------------------------------------------------------
test_that("pluck<- is an alias for assign_in()", {
x <- list(list(bar = 1, foo = 2))
pluck(x, 1, "foo") <- 30
expect_identical(x, list(list(bar = 1, foo = 30)))
})
purrr/tests/testthat/test-deprec-when.R 0000644 0001762 0000144 00000002416 14310436312 017727 0 ustar ligges users test_that("when is deprecated", {
expect_snapshot({
. <- when(1:5 < 3 ~ 1, ~ 0)
})
})
test_that("when chooses the correct action", {
local_options(lifecycle_verbosity = "quiet")
x <-
1:5 %>%
when(
sum(.) <= 50 ~ sum(.),
sum(.) <= 100 ~ sum(.) / 2,
~ 0
)
expect_equal(x, 15)
y <-
1:10 %>%
when(
sum(.) <= 50 ~ sum(.),
sum(.) <= 100 ~ sum(.) / 2,
~ 0
)
expect_equal(y, sum(1:10) / 2)
z <-
1:100 %>%
when(
sum(.) <= 50 ~ sum(.),
sum(.) <= 100 ~ sum(.) / 2,
~ 0
)
expect_equal(z, 0)
})
test_that("named arguments work with when", {
local_options(lifecycle_verbosity = "quiet")
x <-
1:10 %>%
when(
sum(.) <= x ~ sum(.) * x,
sum(.) <= 2 * x ~ sum(.) * x / 2,
~ 0,
x = 60
)
expect_equal(x, sum(1:10) * 60)
})
test_that("default values work without a formula", {
local_options(lifecycle_verbosity = "quiet")
x <- iris %>%
subset(Sepal.Length > 10) %>%
when(
nrow(.) > 0 ~ .,
head(iris, 10)
)
expect_equal(x, head(iris, 10))
})
test_that("error when named arguments have no matching conditions", {
local_options(lifecycle_verbosity = "quiet")
expect_error(1:5 %>% when(a = sum(.) < 5 ~ 3))
})
purrr/tests/testthat/test-deprec-rerun.R 0000644 0001762 0000144 00000001401 14310436312 020112 0 ustar ligges users test_that("is deprecated", {
expect_snapshot({
. <- rerun(5, rnorm(1))
. <- rerun(5, rnorm(1), rnorm(2))
})
})
test_that("single unnamed arg doesn't get extra list", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(rerun(2, 1), list(1, 1))
})
test_that("single named arg gets extra list", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(rerun(2, a = 1), list(list(a = 1), list(a = 1)))
})
test_that("every run is different", {
local_options(lifecycle_verbosity = "quiet")
x <- rerun(2, runif(1))
expect_true(x[[1]] != x[[2]])
})
test_that("rerun uses scope of expression", {
local_options(lifecycle_verbosity = "quiet")
f <- function(n) {
rerun(1, x = seq_len(n))
}
expect_equal(f(10)[[1]]$x, 1:10)
})
purrr/tests/testthat/test-map2.R 0000644 0001762 0000144 00000004250 14317567435 016405 0 ustar ligges users test_that("x and y mapped to first and second argument", {
expect_equal(map2(1, 2, function(x, y) x), list(1))
expect_equal(map2(1, 2, function(x, y) y), list(2))
})
test_that("variants return expected types", {
x <- list(1, 2, 3)
expect_true(is_bare_list(map2(x, 0, ~ 1)))
expect_true(is_bare_logical(map2_lgl(x, 0, ~ TRUE)))
expect_true(is_bare_integer(map2_int(x, 0, ~ 1)))
expect_true(is_bare_double(map2_dbl(x, 0, ~ 1.5)))
expect_true(is_bare_character(map2_chr(x, 0, ~ "x")))
expect_equal(walk2(x, 0, ~ "x"), x)
x <- list(FALSE, 1L, 1)
expect_true(is_bare_double(map2_vec(x, 0, ~ .x)))
})
test_that("0 length input gives 0 length output", {
expect_equal(map2(list(), list(), identity), list())
expect_equal(map2(NULL, NULL, identity), list())
expect_equal(map2_lgl(NULL, NULL, identity), logical())
})
test_that("verifies result types and length", {
expect_snapshot(error = TRUE, {
map2_int(1, 1, ~ "x")
map2_int(1, 1, ~ 1:2)
map2_vec(1, 1, ~ 1, .ptype = character())
})
})
test_that("works with vctrs records (#963)", {
x <- new_rcrd(list(x = c(1, 2), y = c("a", "b")))
out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b")))
expect_identical(map2(x, 1, ~ .x), out)
})
test_that("requires vector inputs", {
expect_snapshot(error = TRUE, {
map2(environment(), "a", identity)
map2("a", environment(), "a", identity)
})
})
test_that("recycles inputs", {
expect_equal(map2(1:2, 1, `+`), list(2, 3))
expect_equal(map2(integer(), 1, `+`), list())
expect_equal(map2(NULL, 1, `+`), list())
expect_snapshot(error = TRUE, {
map2(1:2, 1:3, `+`)
map2(1:2, integer(), `+`)
})
})
test_that("only takes names from x", {
x1 <- 1:2
x2 <- set_names(x1, letters[1:2])
x3 <- set_names(x1, "")
expect_named(map2(x1, 1, `+`), NULL)
expect_named(map2(x2, 1, `+`), c("a", "b"))
expect_named(map2(x3, 1, `+`), c("", ""))
# recycling them if needed (#779)
x4 <- c(a = 1)
expect_named(map2(x4, 1:2, `+`), c("a", "a"))
})
test_that("don't evaluate symbolic objects (#428)", {
map2(exprs(1 + 2), NA, ~ expect_identical(.x, quote(1 + 2)))
walk2(exprs(1 + 2), NA, ~ expect_identical(.x, quote(1 + 2)))
})
purrr/tests/testthat/test-map-if-at.R 0000644 0001762 0000144 00000002077 14310436312 017304 0 ustar ligges users test_that("map_if() and map_at() always return a list", {
skip_if_not_installed("tibble")
df <- tibble::tibble(x = 1, y = "a")
expect_identical(map_if(df, is.character, ~"out"), list(x = 1, y = "out"))
expect_identical(map_at(df, 1, ~"out"), list(x = "out", y = "a"))
})
test_that("map_at() works with tidyselect", {
skip_if_not_installed("tidyselect")
local_options(lifecycle_verbosity = "quiet")
x <- list(a = "b", b = "c", aa = "bb")
one <- map_at(x, vars(a), toupper)
expect_identical(one$a, "B")
expect_identical(one$aa, "bb")
two <- map_at(x, vars(tidyselect::contains("a")), toupper)
expect_identical(two$a, "B")
expect_identical(two$aa, "BB")
})
test_that("negative .at omits locations", {
x <- c(1, 2, 3)
out <- map_at(x, -1, ~ .x * 2)
expect_equal(out, list(1, 4, 6))
})
test_that("map_if requires predicate functions", {
expect_snapshot(map_if(1:3, ~ NA, ~ "foo"), error = TRUE)
})
test_that("`.else` maps false elements", {
expect_identical(map_if(-1:1, ~ .x > 0, paste, .else = ~ "bar", "suffix"), list("bar", "bar", "1 suffix"))
})
purrr/tests/testthat/test-imap.R 0000644 0001762 0000144 00000001076 14313073574 016467 0 ustar ligges users x <- 1:3 %>% set_names()
test_that("imap is special case of map2", {
expect_identical(imap(x, paste), map2(x, names(x), paste))
})
test_that("imap always returns a list", {
expect_bare(imap(x, paste), "list")
})
test_that("atomic vector imap works", {
expect_true(all(imap_lgl(x, `==`)))
expect_length(imap_chr(x, paste), 3)
expect_equal(imap_int(x, ~ .x + as.integer(.y)), x * 2)
expect_equal(imap_dbl(x, ~ .x + as.numeric(.y)), x * 2)
})
test_that("iwalk returns invisibly", {
expect_output(iwalk(mtcars, ~ cat(.y, ": ", median(.x), "\n", sep = "")))
})
purrr/tests/testthat/test-map-mapper.R 0000644 0001762 0000144 00000004001 14311066210 017552 0 ustar ligges users # formulas ----------------------------------------------------------------
test_that("can refer to first argument in three ways", {
expect_equal(map_dbl(1, ~ . + 1), 2)
expect_equal(map_dbl(1, ~ .x + 1), 2)
expect_equal(map_dbl(1, ~ ..1 + 1), 2)
})
test_that("can refer to second arg in two ways", {
expect_equal(map2_dbl(1, 2, ~ .x + .y + 1), 4)
expect_equal(map2_dbl(1, 2, ~ ..1 + ..2 + 1), 4)
})
# vectors --------------------------------------------------------------
# test_that(".null generates warning", {
# expect_warning(map(1, 2, .null = NA), "`.null` is deprecated")
# })
test_that(".default replaces absent values", {
x <- list(
list(a = 1, b = 2, c = 3),
list(a = 1, c = 2),
NULL
)
expect_equal(map_dbl(x, 3, .default = NA), c(3, NA, NA))
expect_equal(map_dbl(x, "b", .default = NA), c(2, NA, NA))
})
test_that(".default only replaces NULL elements", {
x <- list(
list(a = 1),
list(a = numeric()),
list(a = NULL),
list()
)
expect_equal(map(x, "a", .default = NA), list(1, numeric(), NA, NA))
})
test_that("Additional arguments are ignored", {
expect_equal(as_mapper(function() NULL, foo = "bar", foobar), function() NULL)
})
test_that("can supply length > 1 vectors", {
expect_identical(as_mapper(1:2)(list(list("a", "b"))), "b")
expect_identical(as_mapper(c("a", "b"))(list(a = list("a", b = "b"))), "b")
})
# primitive functions --------------------------------------------------
test_that("primitive functions are wrapped", {
expect_identical(as_mapper(`-`)(.y = 10, .x = 5), -5)
expect_identical(as_mapper(`c`)(1, 3, 5), c(1, 3, 5))
})
test_that("syntactic primitives are wrapped", {
expect_identical(as_mapper(`[[`)(mtcars, "cyl"), mtcars$cyl)
expect_identical(as_mapper(`$`)(mtcars, cyl), mtcars$cyl)
})
# lists ------------------------------------------------------------------
test_that("lists are wrapped", {
mapper_list <- as_mapper(list("mpg", 5))(mtcars)
base_list <- mtcars[["mpg"]][[5]]
expect_identical(mapper_list, base_list)
})
purrr/tests/testthat/test-arrays.R 0000644 0001762 0000144 00000002106 14310436312 017023 0 ustar ligges users x <- array(1:12, c(2, 2, 3), dimnames = list(letters[1:2], LETTERS[1:2], NULL))
test_that("array_branch creates a flat list when no margin specified", {
expect_length(array_branch(x), 12)
})
test_that("array_branch wraps array in list when margin has length 0", {
expect_identical(array_branch(x, numeric(0)), list(x))
})
test_that("array_branch works on vectors", {
expect_identical(array_branch(1:3), list(1L, 2L, 3L))
expect_identical(array_branch(1:3, 1), list(1L, 2L, 3L))
})
test_that("array_branch throws an error for wrong margins on a vector", {
expect_snapshot(array_branch(1:3, 2), error = TRUE)
})
test_that("length depends on whether list is flattened or not", {
m1 <- c(3, 1)
m2 <- 3
expect_length(array_branch(x, m1), prod(dim(x)[m1]))
expect_length(array_tree(x, m1), prod(dim(x)[m2]))
})
test_that("array_branch retains dimnames when going over one dimension", {
expect_identical(names(array_branch(x, 1)), letters[1:2])
expect_identical(names(array_branch(x, 2)), LETTERS[1:2])
expect_identical(names(array_branch(x, 2:3)[[1]]), letters[1:2])
})
purrr/tests/testthat/test-map-depth.R 0000644 0001762 0000144 00000006005 14315046000 017377 0 ustar ligges users # map_depth ------------------------------------------------------------
test_that("map_depth modifies values at specified depth", {
x1 <- list(list(list(1:3, 4:6)))
expect_equal(map_depth(x1, 0, length), 1)
expect_equal(map_depth(x1, 1, length), list(1))
expect_equal(map_depth(x1, 2, length), list(list(2)))
expect_equal(map_depth(x1, 3, length), list(list(list(3, 3))))
expect_equal(map_depth(x1, -1, length), list(list(list(3, 3))))
expect_snapshot(map_depth(x1, 6, length), error = TRUE)
expect_snapshot(map_depth(x1, -5, length), error = TRUE)
})
test_that("default doesn't recurse into data frames, but can customise", {
x <- list(data.frame(x = 1), data.frame(y = 2))
expect_error(map_depth(x, 2, class), "not deep enough")
x <- list(data.frame(x = 1), data.frame(y = 1))
expect_equal(
map_depth(x, 2, class, .is_node = is.list),
list(list(x = "numeric"), list(y = "numeric"))
)
})
test_that("map_depth() with .ragged = TRUE operates on leaves", {
x1 <- list(
list(1),
list(list(2))
)
exp <- list(
list(list(2)),
list(list(3))
)
expect_equal(map_depth(x1, 3, ~ . + 1, .ragged = TRUE), exp)
expect_equal(map_depth(x1, -1, ~ . + 1, .ragged = TRUE), exp)
# .ragged should be TRUE is .depth < 0
expect_equal(map_depth(x1, -1, ~ . + 1), exp)
})
# modify_depth ------------------------------------------------------------
test_that("modify_depth modifies values at specified depth", {
x1 <- list(list(list(1:3, 4:6)))
expect_equal(modify_depth(x1, 0, length), list(1))
expect_equal(modify_depth(x1, 1, length), list(1))
expect_equal(modify_depth(x1, 2, length), list(list(2)))
expect_equal(modify_depth(x1, 3, length), list(list(list(3, 3))))
expect_equal(modify_depth(x1, -1, length), list(list(list(3, 3))))
expect_snapshot(modify_depth(x1, 5, length), error = TRUE)
expect_snapshot(modify_depth(x1, -5, length), error = TRUE)
})
test_that(".ragged = TRUE operates on leaves", {
x1 <- list(
list(1),
list(list(2))
)
x2 <- list(
list(2),
list(list(3))
)
expect_equal(modify_depth(x1, 3, ~ . + 1, .ragged = TRUE), x2)
expect_equal(modify_depth(x1, -1, ~ . + 1, .ragged = TRUE), x2)
# .ragged should be TRUE is .depth < 0
expect_equal(modify_depth(x1, -1, ~ . + 1), x2)
})
test_that("vectorised operations on the recursive and atomic levels yield same results", {
x <- list(list(list(1:3, 4:6)))
exp <- list(list(list(11:13, 14:16)))
expect_identical(modify_depth(x, 3, `+`, 10L), exp)
expect_error(modify_depth(x, 5, `+`, 10L), "not deep enough")
})
test_that("modify_depth() treats NULLs correctly", {
ll <- list(a = NULL, b = list(b1 = NULL, b2 = "hello"))
expect_equal(modify_depth(ll, .depth = 2, identity, .ragged = TRUE), ll)
expect_equal(
modify_depth(ll, .depth = 2, is.character, .ragged = TRUE),
list(a = NULL, b = list(b1 = FALSE, b2 = TRUE))
)
})
# check_depth -------------------------------------------------------------
test_that("validates depth", {
expect_snapshot(check_depth(mean), error = TRUE)
})
purrr/tests/testthat/setup.R 0000644 0001762 0000144 00000000042 14304371054 015706 0 ustar ligges users Sys.setlocale("LC_MESSAGES", "C")
purrr/tests/testthat/test-adverb-partial.R 0000644 0001762 0000144 00000015166 14310436312 020431 0 ustar ligges users test_that("dots are correctly placed in the signature", {
out <- partialised_body(partial(runif, n = rpois(1, 5)))
exp <- expr(runif(n = rpois(1, 5), ...))
expect_identical(out, exp)
})
test_that("no lazy evaluation means arguments aren't repeatedly evaluated", {
counter <- env(n = 0)
lazy <- partial(list, n = { counter$n <- counter$n + 1; NULL })
walk(1:10, ~lazy())
expect_identical(counter$n, 10)
counter <- env(n = 0)
qq <- partial(list, n = !!{ counter$n <- counter$n + 1; NULL })
walk(1:10, ~qq())
expect_identical(counter$n, 1)
})
test_that("partial() still works with functions using `missing()`", {
fn <- function(x) missing(x)
expect_false(partial(fn, x = 3)())
fn <- function(x, y) missing(y)
expect_true(partial(fn)())
expect_true(partial(fn, x = 1)())
expect_false(partial(fn, x = 1, y = 2)())
})
test_that("partialised arguments are evaluated in their environments", {
n <- 0
partialised <- local({
n <- 10
partial(list, n = n)
})
expect_identical(partialised(), list(n = 10))
})
test_that("partialised function is evaluated in its environment", {
fn <- function(...) stop("tilt")
partialised <- local({
fn <- function(x) x
partial(fn, x = "foo")
})
expect_identical(partialised(), "foo")
})
test_that("partial() matches argument with primitives", {
minus <- partial(`-`, .y = 5)
expect_identical(minus(1), -4)
minus <- partial(`-`, e2 = 5)
expect_identical(minus(1), -4)
})
test_that("partial() squashes quosures before printing", {
foo <- function(x, y) y
foo <- partial(foo, y = 3)
# Reproducible environment tag
environment(foo) <- global_env()
expect_snapshot(foo)
})
test_that("partial() handles primitives with named arguments after `...`", {
expect_identical(partial(min, na.rm = TRUE)(1, NA), 1)
expect_true(is_na(partial(min, na.rm = FALSE)(1, NA)))
})
test_that("partialised function does not infloop when given the same name (#387)", {
fn <- function(...) "foo"
fn <- partial(fn)
expect_identical(fn(), "foo")
})
test_that("partial() handles `... =` arguments", {
fn <- function(...) list(...)
default <- partial(fn, "partial")
expect_identical(default(1), list("partial", 1))
after <- partial(fn, "partial", ... = )
expect_identical(after(1), list("partial", 1))
before <- partial(fn, ... = , "partial")
expect_identical(before(1), list(1, "partial"))
})
test_that("partial() supports substituted arguments", {
fn <- function(x) substitute(x)
fn <- partial(fn, letters)
expect_identical(fn(), quote(letters))
})
test_that("partial() supports generics (#647)", {
expect_identical(partial(mean, na.rm = TRUE)(1), 1)
foo <- TRUE
expect_identical(partial(mean, na.rm = foo)(1), 1)
})
test_that("partial() supports lexically defined methods in the def env", {
local({
mean.purrr__foobar <- function(...) TRUE
foobar <- structure(list(), class = "purrr__foobar")
expect_true(partial(mean, na.rm = TRUE)(foobar))
expect_true(partial(mean, trim = letters, na.rm = TRUE)(foobar))
})
})
test_that("substitute() works for both partialised and non-partialised arguments", {
fn <- function(x, y) list(substitute(x), substitute(y))
expect_identical(partial(fn, foo)(y = bar), alist(foo, bar))
})
test_that("partial() still supports quosures and multiple environments", {
arg <- local({
n <- 0
quo({ n <<- n + 1; n})
})
x <- "foo"
fn <- partial(list, !!arg, x = x)
expect_identical(fn(), list(1, x = "foo"))
expect_identical(fn(), list(2, x = "foo"))
})
test_that("partial() preserves visibility when arguments are from the same environment (#656)", {
fn <- partial(identity, 1)
expect_identical(withVisible(fn()), list(value = 1, visible = TRUE))
fn <- function(x) invisible(x)
fn <- partial(fn, 1)
expect_identical(withVisible(fn()), list(value = 1, visible = FALSE))
})
# Life cycle --------------------------------------------------------------
test_that("`.lazy`, `.env`, and `.first` are soft-deprecated", {
expect_snapshot({
. <- partial(list, "foo", .lazy = TRUE)
. <- partial(list, "foo", .env = env())
. <- partial(list, "foo", .first = TRUE)
})
})
test_that("`.lazy` still works", {
local_options(lifecycle_verbosity = "quiet")
counter <- env(n = 0)
eager <- partial(list, n = { counter$n <- counter$n + 1; NULL }, .lazy = FALSE)
walk(1:10, ~eager())
expect_identical(counter$n, 1)
})
test_that("`.first` still works", {
local_options(lifecycle_verbosity = "quiet")
out <- partialised_body(partial(runif, n = rpois(1, 5), .first = FALSE))
exp <- expr(runif(..., n = rpois(1, 5)))
expect_identical(out, exp)
# partial() also works without partialised arguments
expect_identical(partialised_body(partial(runif, .first = TRUE)), expr(runif(...)))
expect_identical(partialised_body(partial(runif, .first = FALSE)), expr(runif(...)))
})
test_that("checks inputs", {
expect_snapshot(partial(1), error = TRUE)
})
# helpers -----------------------------------------------------------------
test_that("quo_invert() inverts quosured arguments", {
call <- expr(list(!!quo(foo), !!quo(bar)))
expect_identical(quo_invert(call), quo(list(foo, bar)))
call <- expr(list(foo, !!quo(bar)))
expect_identical(quo_invert(call), quo(list(foo, bar)))
call <- expr(list(!!quo(foo), bar))
expect_identical(quo_invert(call), quo(list(foo, bar)))
})
test_that("quo_invert() detects local quosures", {
foo <- local(quo(foo))
call <- expr(list(!!foo, !!quo(bar)))
expect_identical(quo_invert(call), new_quosure(expr(list(foo, !!quo(bar))), quo_get_env(foo)))
bar <- local(quo(bar))
call <- expr(list(!!quo(foo), !!bar))
expect_identical(quo_invert(call), quo(list(foo, !!bar)))
})
test_that("quo_invert() supports quosures in function position", {
call <- expr((!!quo(list))(!!quo(foo), !!quo(bar)))
expect_identical(quo_invert(call), quo(list(foo, bar)))
fn <- local(quo(list))
env <- quo_get_env(fn)
call <- expr((!!fn)(!!quo(foo), !!new_quosure(quote(bar), env)))
expect_identical(quo_invert(call), new_quosure(expr(list(!!quo(foo), bar)), env))
})
test_that("quo_invert() supports quosures", {
bar <- local(quo(bar))
call <- quo(list(!!quo(foo), !!bar))
expect_identical(quo_invert(call), quo(list(foo, !!bar)))
foo <- quo(foo)
call <- local(quo(list(!!foo, !!bar)))
expect_identical(quo_invert(call), new_quosure(expr(list(!!foo, !!bar)), quo_get_env(call)))
})
test_that("quo_invert() unwraps constants", {
call <- expr(foo(!!quo(NULL)))
expect_identical(quo_invert(call), quote(foo(NULL)))
foo <- local(quo(foo))
call <- expr(foo(!!foo, !!quo(NULL)))
expect_identical(quo_invert(call), new_quosure(quote(foo(foo, NULL)), quo_get_env(foo)))
})
purrr/tests/testthat/test-deprec-cross.R 0000644 0001762 0000144 00000002102 14310436312 020107 0 ustar ligges users test_that("long format corresponds to expand.grid output", {
skip_if_not_installed("tibble")
local_options(lifecycle_verbosity = "quiet")
x <- list(a = 1:3, b = 4:9)
out1 <- cross_df(x)
out2 <- expand.grid(x, KEEP.OUT.ATTRS = FALSE) %>% tibble::as_tibble()
expect_equal(out1, out2)
})
test_that("filtering works", {
local_options(lifecycle_verbosity = "quiet")
filter <- function(x, y) x >= y
out <- cross2(1:3, 1:3, .filter = filter)
expect_equal(out, list(list(1, 2), list(1, 3), list(2, 3)))
})
test_that("filtering requires a predicate function", {
local_options(lifecycle_verbosity = "quiet")
expect_snapshot(cross2(1:3, 1:3, .filter = ~ c(TRUE, TRUE)), error = TRUE)
})
test_that("filtering fails when filter function doesn't return a logical", {
local_options(lifecycle_verbosity = "quiet")
filter <- function(x, y, z) x + y + z
expect_error(cross3(1:3, 1:3, 1:3, .filter = filter))
})
test_that("works with empty input", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(cross(list()), list())
expect_equal(cross(NULL), NULL)
})
purrr/tests/testthat/test-superseded-simplify.R 0000644 0001762 0000144 00000001710 14330525021 021515 0 ustar ligges users test_that("can_simplify() understands vector molds", {
x <- as.list(1:3)
x2 <- c(x, list(1:3))
expect_true(can_simplify(x, integer(1)))
expect_false(can_simplify(x, character(1)))
expect_false(can_simplify(x2, integer(1)))
x3 <- list(1:2, 3:4, 5:6)
expect_true(can_simplify(x3, integer(2)))
expect_false(can_simplify(x, integer(2)))
})
test_that("can_simplify() understands types as strings", {
x <- as.list(1:3)
expect_true(can_simplify(x, "integer"))
expect_false(can_simplify(x, "character"))
})
test_that("integer is coercible to double", {
x <- list(1L, 2L)
expect_true(can_simplify(x, "numeric"))
expect_true(can_simplify(x, numeric(1)))
expect_true(can_simplify(x, "double"))
expect_true(can_simplify(x, double(1)))
})
test_that("numeric is an alias for double", {
expect_true(can_simplify(list(1, 2), "numeric"))
})
test_that("double is not coercible to integer", {
expect_false(can_simplify(list(1, 2), "integer"))
})
purrr/tests/testthat/test-superseded-flatten.R 0000644 0001762 0000144 00000005125 14330525021 021322 0 ustar ligges users test_that("input must be a list", {
local_options(lifecycle_verbosity = "quiet")
expect_snapshot(flatten(1), error = TRUE)
expect_snapshot(flatten_dbl(1), error = TRUE)
})
test_that("contents of list must be supported types", {
local_options(lifecycle_verbosity = "quiet")
expect_snapshot(flatten(list(quote(a))), error = TRUE)
expect_snapshot(flatten(list(expression(a))), error = TRUE)
})
test_that("each second level element becomes first level element", {
expect_equal(flatten(list(1:2)), list(1, 2))
expect_equal(flatten(list(1, 2)), list(1, 2))
})
test_that("can flatten all atomic vectors", {
expect_equal(flatten(list(F)), list(F))
expect_equal(flatten(list(1L)), list(1L))
expect_equal(flatten(list(1)), list(1))
expect_equal(flatten(list("a")), list("a"))
expect_equal(flatten(list(as.raw(1))), list(as.raw(1)))
expect_equal(flatten(list(1i)), list(1i))
})
test_that("NULLs are silently dropped", {
expect_equal(flatten(list(NULL, NULL)), list())
expect_equal(flatten(list(NULL, 1)), list(1))
expect_equal(flatten(list(1, NULL)), list(1))
})
test_that("names are preserved", {
expect_equal(flatten(list(list(x = 1), list(y = 1))), list(x = 1, y = 1))
expect_equal(flatten(list(list(a = 1, b = 2), 3)), list(a = 1, b = 2, 3))
})
test_that("names of 'scalar' elements are preserved", {
out <- flatten(list(a = list(1), b = list(2)))
expect_equal(out, list(a = 1, b = 2))
out <- flatten(list(a = list(1), b = 2:3))
expect_equal(out, list(a = 1, 2, 3))
out <- flatten(list(list(a = 1, b = 2), c = 3))
expect_equal(out, list(a = 1, b = 2, c = 3))
})
test_that("child names beat parent names", {
out <- flatten(list(a = list(x = 1), b = list(y = 2)))
expect_equal(out, list(x = 1, y = 2))
})
# atomic flatten ----------------------------------------------------------
test_that("must be a list", {
local_options(lifecycle_verbosity = "quiet")
expect_snapshot(flatten_lgl(1), error = TRUE)
})
test_that("can flatten all atomic vectors", {
expect_equal(flatten_lgl(list(F)), F)
expect_equal(flatten_int(list(1L)), 1L)
expect_equal(flatten_dbl(list(1)), 1)
expect_equal(flatten_chr(list("a")), "a")
})
test_that("preserves inner names", {
expect_equal(
flatten_dbl(list(c(a = 1), c(b = 2))),
c(a = 1, b = 2)
)
})
# data frame flatten ------------------------------------------------------
test_that("can flatten to a data frame with named lists", {
skip_if_not_installed("dplyr")
dfs <- list(c(a = 1), c(b = 2))
expect_equal(flatten_dfr(dfs), tibble::tibble(a = 1, b = 2))
expect_equal(flatten_dfc(dfs), tibble::tibble(a = 1, b = 2))
})
purrr/tests/testthat/test-pmap.R 0000644 0001762 0000144 00000006366 14331250746 016503 0 ustar ligges users test_that(".f called with named arguments", {
x <- list(x = 1, 2, y = 3)
expect_equal(pmap(x, list), list(x))
})
test_that("... are passed after varying argumetns", {
out <- pmap(list(x = 1:2), list, n = 1:2)
expect_equal(out, list(
list(x = 1, n = 1:2),
list(x = 2, n = 1:2)
))
})
test_that("variants return expected types", {
l <- list(list(1, 2, 3))
expect_true(is_bare_list(pmap(l, ~ 1)))
expect_true(is_bare_logical(pmap_lgl(l, ~ TRUE)))
expect_true(is_bare_integer(pmap_int(l, ~ 1)))
expect_true(is_bare_double(pmap_dbl(l, ~ 1.5)))
expect_true(is_bare_character(pmap_chr(l, ~ "x")))
expect_equal(pwalk(l, ~ "x"), l)
l <- list(list(FALSE, 1L, 1))
expect_true(is_bare_double(pmap_vec(l, ~ .x)))
})
test_that("verifies result types and length", {
expect_snapshot(error = TRUE, {
pmap_int(list(1), ~ "x")
pmap_int(list(1), ~ 1:2)
pmap_vec(list(1), ~ 1, .ptype = character())
})
})
test_that("0 length input gives 0 length output", {
expect_equal(pmap(list(list(), list()), identity), list())
expect_equal(pmap(list(NULL, NULL), identity), list())
expect_equal(pmap(list(), identity), list())
expect_equal(pmap(NULL, identity), list())
expect_equal(pmap_lgl(NULL, identity), logical())
})
test_that("requires list of vectors", {
expect_snapshot(error = TRUE, {
pmap(environment(), identity)
pmap(list(environment()), identity)
})
})
test_that("recycles inputs", {
expect_equal(pmap(list(1:2, 1), `+`), list(2, 3))
expect_equal(pmap(list(integer(), 1), `+`), list())
expect_equal(pmap(list(NULL, 1), `+`), list())
expect_snapshot(error = TRUE, {
pmap(list(1:2, 1:3), `+`)
pmap(list(1:2, integer()), `+`)
})
})
test_that("only takes names from x", {
x1 <- 1:2
x2 <- set_names(x1, letters[1:2])
x3 <- set_names(x1, "")
expect_named(pmap(list(x1, x2), `+`), NULL)
expect_named(pmap(list(x2, x2), `+`), c("a", "b"))
expect_named(pmap(list(x3, x2), `+`), c("", ""))
# recycling them if needed (#779)
x4 <- c(a = 1)
expect_named(pmap(list(x4, 1:2), `+`), c("a", "a"))
})
test_that("avoid expensive [[ method on data frames", {
local_bindings(
`[[.mydf` = function(x, ...) stop("Not allowed!"),
.env = global_env()
)
df <- data.frame(x = 1:2, y = 2:1)
class(df) <- c("mydf", "data.frame")
expect_equal(pmap(df, list), list(list(x = 1, y = 2), list(x = 2, y = 1)))
expect_equal(pmap_lgl(df, ~ TRUE), c(TRUE, TRUE))
expect_equal(pmap_int(df, ~ 2), c(2, 2))
expect_equal(pmap_dbl(df, ~ 3.5), c(3.5, 3.5))
expect_equal(pmap_chr(df, ~ "x"), c("x", "x"))
})
test_that("pmap works with empty lists", {
expect_identical(pmap(list(), ~ 1), list())
})
test_that("preserves S3 class of input vectors (#358)", {
date <- as.Date("2018-09-27")
expect_equal(pmap(list(date), identity), list(date))
expect_output(pwalk(list(date), print), format(date))
})
test_that("works with vctrs records (#963)", {
x <- new_rcrd(list(x = c(1, 2), y = c("a", "b")))
out <- list(new_rcrd(list(x = 1, y = "a")), new_rcrd(list(x = 2, y = "b")))
expect_identical(pmap(list(x, 1, 1:2), ~ .x), out)
})
test_that("don't evaluate symbolic objects (#428)", {
pmap(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2)))
pwalk(list(exprs(1 + 2)), ~ expect_identical(.x, quote(1 + 2)))
})
purrr/tests/testthat/test-pluck-depth.R 0000644 0001762 0000144 00000001151 14314671330 017746 0 ustar ligges users test_that("depth of non-vectors is 0", {
expect_equal(pluck_depth(NULL), 0L)
expect_equal(pluck_depth(mean), 0L)
})
test_that("depth of atomic vector is 1", {
expect_equal(pluck_depth(1:10), 1)
expect_equal(pluck_depth(letters), 1)
expect_equal(pluck_depth(c(TRUE, FALSE)), 1)
})
test_that("depth of nested is depth of deepest element + 1", {
x <- list(
NULL,
list(),
list(list())
)
depths <- map_int(x, pluck_depth)
expect_equal(depths, c(0, 1, 2))
expect_equal(pluck_depth(x), 3)
})
test_that("vec_depth() is deprecated", {
expect_snapshot({
. <- vec_depth(list())
})
})
purrr/tests/testthat/test-every-some-none.R 0000644 0001762 0000144 00000002437 14304371054 020565 0 ustar ligges users test_that("every returns TRUE if all elements are TRUE", {
x <- list(0, 1, TRUE)
expect_false(every(x, isTRUE))
expect_true(every(x[3], isTRUE))
})
test_that("some returns FALSE if all elements are FALSE", {
x <- list(1, 0, FALSE)
expect_false(some(x, isTRUE))
expect_true(some(x[1], negate(isTRUE)))
})
test_that("none returns TRUE if all elements are FALSE", {
x <- list(1, 0, TRUE)
expect_false(none(x, isTRUE))
expect_true(none(x[1], isTRUE))
})
test_that("every() requires logical value", {
expect_error(every(list(1:3), identity), "must return a single")
expect_error(every(list(function() NULL), identity), "must return a single")
})
test_that("every() has the same behaviour as `&&` (#751)", {
expect_false(every(list(NA, FALSE), identity))
expect_false(every(list(FALSE, NA), identity))
expect_identical(every(list(NA, TRUE), identity), NA)
expect_identical(every(list(TRUE, NA), identity), NA)
expect_identical(every(list(NA, NA), identity), NA)
})
test_that("some() has the same behaviour as `||`", {
expect_true(some(list(TRUE, NA), identity))
expect_true(some(list(NA, TRUE), identity))
expect_identical(some(list(NA, FALSE), identity), NA)
expect_identical(some(list(FALSE, NA), identity), NA)
expect_identical(some(list(NA, NA), identity), NA)
})
purrr/tests/testthat/test-lmap.R 0000644 0001762 0000144 00000003265 14330306457 016472 0 ustar ligges users test_that("lmap output is list if input is list", {
x <- list(a = 1:4, b = letters[5:7], c = 8:9, d = letters[10])
maybe_rep <- function(x) {
n <- rpois(1, 2)
out <- rep_len(x, n)
if (length(out) > 0) {
names(out) <- paste0(names(x), seq_len(n))
}
out
}
expect_bare(lmap_at(x, "a", maybe_rep), "list")
})
test_that("lmap() returns a data frame if input is a data frame", {
df <- data.frame(x = 1, y = 2)
# as.data.frame() handles repeated names
out <- lmap(df, function(x) as.data.frame(rep(x, 2)))
expect_equal(out, data.frame(x = 1, x.1 = 1, y = 2, y.1 = 2))
# even if we return bare lists
out <- lmap(df, function(x) as.list(rep(x, 2)))
expect_equal(out, data.frame(x = 1, x.1 = 1, y = 2, y.1 = 2))
})
test_that("lmap() can increase and decrease elements", {
out <- lmap(list(0, 1, 2), ~ as.list(rep(.x, .x)))
expect_equal(out, list(1, 2, 2))
})
test_that("lmap_at() only affects selected elements", {
out <- lmap_at(list(0, 1, 2), c(1, 3), ~ as.list(rep(.x, .x)))
expect_equal(out, list(1, 2, 2))
out <- lmap_at(list(0, 1, 2), c(2, 3), ~ as.list(rep(.x, .x)))
expect_equal(out, list(0, 1, 2, 2))
})
test_that("lmap_at can use tidyselect", {
local_options(lifecycle_verbosity = "quiet")
x <- lmap_at(mtcars, vars(tidyselect::contains("vs")), ~ .x + 10)
expect_equal(x$vs[1], 10)
})
test_that("`.else` preserves false elements", {
x <- list("a", 99)
out <- lmap_if(x, is.character, ~ list(1, 2), .else = ~ list(3, 4))
expect_equal(out, list(1, 2, 3, 4))
})
test_that("validates inputs", {
expect_snapshot(error = TRUE, {
lmap(list(1), ~ 1)
lmap(list(1), environment())
lmap(list(1), ~ 1, .else = environment())
})
})
purrr/tests/testthat/test-deprec-lift.R 0000644 0001762 0000144 00000002375 14330525021 017726 0 ustar ligges users test_that("lift_dl and lift_ld are inverses of each other", {
options(lifecycle_verbosity = "quiet")
expect_identical(
sum %>%
lift_dl(.unnamed = TRUE) %>%
do.call(list(3, NA, 4, na.rm = TRUE)),
sum %>%
lift_dl() %>%
lift_ld() %>%
exec(3, NA, 4, na.rm = TRUE)
)
})
test_that("lift_dv is from ... to c(...)", {
options(lifecycle_verbosity = "quiet")
expect_equal(lift_dv(range, .unnamed = TRUE)(1:10), c(1, 10))
})
test_that("lift_vd is from c(...) to ...", {
options(lifecycle_verbosity = "quiet")
expect_equal(lift_vd(mean)(1, 2), 1.5)
})
test_that("lift_vl is from c(...) to list(...)", {
options(lifecycle_verbosity = "quiet")
expect_equal(lift_vl(mean)(list(1, 2)), 1.5)
})
test_that("lift_lv is from list(...) to c(...)", {
options(lifecycle_verbosity = "quiet")
glue <- function(l) {
if (!is.list(l)) stop("not a list")
l %>% do.call(paste, .)
}
expect_identical(lift_lv(glue)(letters), paste(letters, collapse = " "))
})
test_that("lift functions are deprecated", {
expect_snapshot({
. <- lift_dl(function() {})
. <- lift_dv(function() {})
. <- lift_vl(function() {})
. <- lift_vd(function() {})
. <- lift_ld(function() {})
. <- lift_lv(function() {})
})
})
purrr/tests/testthat/test-deprec-utils.R 0000644 0001762 0000144 00000001747 14311066210 020131 0 ustar ligges users test_that("rdunif and rbernoulli are deprecated", {
expect_snapshot({
. <- rdunif(10, 1)
. <- rbernoulli(10)
})
})
test_that("rbernoulli is a special case of rbinom", {
local_options(lifecycle_verbosity = "quiet")
set.seed(1)
x <- rbernoulli(10)
set.seed(1)
y <- ifelse(rbinom(10, 1, 0.5) == 1, TRUE, FALSE)
expect_equal(x, y)
})
test_that("rdunif works", {
local_options(lifecycle_verbosity = "quiet")
expect_length(rdunif(100, 10), 100)
})
test_that("rdunif fails if a and b are not unit length numbers", {
local_options(lifecycle_verbosity = "quiet")
expect_error(rdunif(1000, 1, "a"))
expect_error(rdunif(1000, 1, c(0.5, 0.2)))
expect_error(rdunif(1000, FALSE, 2))
expect_error(rdunif(1000, c(2, 3), 2))
})
# Lifecycle ---------------------------------------------------------------
test_that("%@% is an infix attribute accessor", {
local_options(lifecycle_verbosity = "quiet")
expect_identical(mtcars %@% "names", attr(mtcars, "names"))
})
purrr/tests/testthat/test-modify.R 0000644 0001762 0000144 00000011544 14350140332 017015 0 ustar ligges users # Input types, ordered by apperance
test_that("modifying vectors list preserves type", {
x1 <- vctrs::list_of(c(1, 2), c(3, 6, 9))
x2 <- vctrs::list_of(c(2, 3), c(4, 7, 10))
expect_equal(modify(x1, ~ .x + 1), x2)
})
test_that("modfiying data.frame preserves type and size", {
df1 <- data.frame(x = 1:2, y = 2:1)
expect_equal(modify(df1, ~ 1), data.frame(x = c(1, 1), y = c(1, 1)))
expect_equal(modify_at(df1, 1, ~ 1), data.frame(x = c(1, 1), y = 2:1))
expect_equal(modify2(df1, df1, ~ .x + .y), data.frame(x = c(2, 4), y = c(4, 2)))
df2 <- new_data_frame(n = 5L)
expect_equal(modify(df2, ~ 1), df2)
expect_snapshot(error = TRUE, {
modify(df1, ~ integer())
modify(df1, ~ 1:4)
modify_at(df1, 2, ~ integer())
modify2(df1, list(1, 1:3), ~ .y)
})
})
test_that("zap gives clear error", {
expect_snapshot(error = TRUE, {
modify_at(1, 1, ~ zap())
modify_at(list(1), 1, ~ zap())
modify_at(data.frame(x = 1), 1, ~ zap())
modify_at(lm(mpg ~ wt, data = mtcars), 1, ~ zap())
})
})
test_that("data.frames are modified by column, not row", {
df1 <- data.frame(x = 1:3, y = letters[1:3])
df2 <- data.frame(x = 2:4, y = letters[1:3])
expect_equal(modify(df1, ~ if (is.numeric(.x)) .x + 1 else .x), df2)
expect_equal(modify_at(df1, "x", ~ .x + 1), df2)
})
test_that("modifying vectors preserves type", {
expect_identical(modify(1:3, ~ .x + 1), 2:4)
expect_equal(modify("a", ~ factor("b")), "b")
expect_identical(modify_if(1:2, ~ .x %% 2 == 0, ~ 3), c(1L, 3L))
expect_identical(modify_at(1:2, 2, ~ 3), c(1L, 3L))
expect_identical(modify2(1:2, c(0, 1), `+`), c(1L, 3L))
})
test_that("bad type has useful error", {
expect_snapshot(error = TRUE, {
modify(1:3, ~ "foo")
modify_at(1:3, 1, ~ "foo")
modify_if(1:3, is_integer, ~ "foo")
modify2(1:3, "foo", ~ .y)
})
})
test_that("modifying lists preserves NULLs", {
l <- list(a = 1, b = NULL, c = 3)
expect_equal(modify(l, identity), l)
expect_equal(modify_at(l, "b", identity), l)
expect_equal(modify_if(l, is.null, identity), l)
expect_equal(
modify2(l, list(NULL, 1, NULL), ~ .y),
list(a = NULL, b = 1, c = NULL)
)
})
test_that("can modify non-vector lists", {
notlist <- function(...) structure(list(...), class = "notlist")
x <- notlist(x = 1, y = "a")
expect_equal(modify(x, ~ 2), notlist(x = 2, y = 2))
expect_equal(modify_if(x, is.character, ~ 2), notlist(x = 1, y = 2))
expect_equal(modify_at(x, "y", ~ 2), notlist(x = 1, y = 2))
local_bindings(
"[.notlist" = function(...) structure(NextMethod(), class = "notlist"),
.env = globalenv()
)
expect_equal(modify2(x, list(3, 4), ~ .y), notlist(x = 3, y = 4))
expect_equal(modify2(notlist(1), list(3, 4), ~ .y), notlist(3, 4))
})
test_that("modifying data frame ignores [<- methods", {
df <- function(...) structure(data_frame(...), class = c("df", "data.frame"))
local_bindings(
"[<-.df" = function(...) stop("Forbidden"),
.env = globalenv()
)
x <- df(x = 1, y = "x")
expect_equal(modify(x, ~ 2), df(x = 2, y = 2))
expect_equal(modify_if(x, is.character, ~ 2), df(x = 1, y = 2))
expect_equal(modify_at(x, "y", ~ 2), df(x = 1, y = 2))
expect_equal(modify2(x, list(2, 3), ~ .y), df(x = 2, y = 3))
})
# other properties --------------------------------------------------------
test_that("`.else` modifies false elements", {
exp <- modify_if(iris, negate(is.factor), as.integer)
exp <- modify_if(exp, is.factor, as.character)
expect_identical(modify_if(iris, is.factor, as.character, .else = as.integer), exp)
expect_equal(modify_if(c(TRUE, FALSE), ~ .x, ~ FALSE, .else = ~ TRUE), c(FALSE, TRUE))
expect_equal(modify_if(1:2, ~ .x == 1, ~ 3L, .else = ~ 4L), c(3, 4))
expect_equal(modify_if(c(1, 10), ~ .x < 5, ~ .x * 10, .else = ~ .x / 2), c(10, 5))
expect_equal(modify_if(c("a", "b"), ~ .x == "a", ~ "A", .else = ~ "B"), c("A", "B"))
})
test_that("modify_at() can use tidyselect", {
local_options(lifecycle_verbosity = "quiet")
df <- data.frame(x = 1, y = 3)
expect_equal(
modify_at(df, vars(x), ~ 2),
data.frame(x = 2, y = 3)
)
})
test_that("imodify uses index", {
expect_equal(imodify(list(2), ~ .y), list(1))
expect_equal(imodify(list(a = 2), ~ .y), list(a = "a"))
})
# input validation --------------------------------------------------------
test_that("modify2() recycles arguments", {
expect_equal(modify2(1:3, 1L, `+`), c(2, 3, 4))
expect_equal(modify2(1, 1:3, `+`), c(2, 3, 4))
expect_snapshot(error = TRUE, {
modify2(1:3, integer(), `+`)
modify2(1:3, 1:4, `+`)
})
})
test_that("modify_if() requires predicate functions", {
expect_snapshot(error = TRUE, {
modify_if(list(1, 2), ~ NA, ~ "foo")
})
})
test_that("user friendly error for non-supported cases", {
expect_snapshot(error = TRUE, {
modify(mean, identity)
modify_if(mean, TRUE, identity)
modify_at(mean, "x", identity)
modify2(mean, 1, identity)
})
})
purrr/tests/testthat/test-deprec-invoke.R 0000644 0001762 0000144 00000004457 14310436312 020270 0 ustar ligges users test_that("invoke_* is deprecated", {
expect_snapshot({
. <- invoke(identity, 1)
. <- invoke_map(identity, list())
. <- invoke_map_lgl(identity, list())
. <- invoke_map_int(identity, list())
. <- invoke_map_dbl(identity, list())
. <- invoke_map_chr(identity, list())
. <- invoke_map_raw(identity, list())
})
})
# invoke ------------------------------------------------------------------
test_that("invoke() evaluates expressions in the right environment", {
local_options(lifecycle_verbosity = "quiet")
x <- letters
f <- toupper
expect_equal(invoke("f", quote(x)), toupper(letters))
})
test_that("invoke() follows promises to find the evaluation env", {
local_options(lifecycle_verbosity = "quiet")
x <- letters
f <- toupper
f1 <- function(y) {
f2 <- function(z) purrr::invoke(z, quote(x))
f2(y)
}
expect_equal(f1("f"), toupper(letters))
})
# invoke_map --------------------------------------------------------------
test_that("invoke_map() works with bare function", {
local_options(lifecycle_verbosity = "quiet")
data <- list(1:2, 3:4)
expected <- list("1 2", "3 4")
expect_equal(invoke_map(paste, data), expected)
expect_equal(invoke_map("paste", data), expected)
expect_equal(invoke_map_chr(paste, data), unlist(expected))
expect_identical(invoke_map_dbl(`+`, data), c(3, 7))
expect_identical(invoke_map_int(`+`, data), c(3L, 7L))
expect_identical(invoke_map_lgl(`&&`, data), c(TRUE, TRUE))
expect_identical(invoke_map_raw(identity, as.raw(1:3)), as.raw(1:3))
})
test_that("invoke_map() works with bare function with data frames", {
local_options(lifecycle_verbosity = "quiet")
skip_if_not_installed("dplyr")
data <- list(1:2, 3:4)
ops <- set_names(c(`+`, `-`), c("a", "b"))
expect_identical(invoke_map_dfr(ops, data), invoke_map_dfc(ops, data))
})
test_that("invoke_map() evaluates expressions in the right environment", {
local_options(lifecycle_verbosity = "quiet")
shadowed_object <- letters
shadowed_fun <- toupper
expect_equal(
invoke_map("shadowed_fun", list(quote(shadowed_object))),
list(toupper(letters))
)
})
test_that("invoke_maps doesn't rely on c() returning list", {
local_options(lifecycle_verbosity = "quiet")
day <- as.Date("2016-09-01")
expect_equal(invoke_map(identity, list(day)), list(day))
})
purrr/tests/testthat/test-adverb-auto-browse.R 0000644 0001762 0000144 00000000255 14310436312 021235 0 ustar ligges users test_that("auto_browse() not intended for primitive functions", {
expect_snapshot(auto_browse(log)(NULL), error = TRUE)
expect_error(auto_browse(identity)(NULL), NA)
})
purrr/tests/testthat/test-list-flatten.R 0000644 0001762 0000144 00000003676 14310436312 020145 0 ustar ligges users test_that("flattening removes single layer of nesting", {
expect_equal(list_flatten(list(list(1), list(2))), list(1, 2))
expect_equal(list_flatten(list(list(1), list(list(2)))), list(1, list(2)))
expect_equal(list_flatten(list(list(1), list(), list(2))), list(1, 2))
})
test_that("flattening a flat list is idempotent", {
expect_equal(list_flatten(list(1, 2)), list(1, 2))
})
test_that("uses either inner or outer names if only one present", {
expect_equal(list_flatten(list(x = list(1), list(y = 2))), list(x = 1, y = 2))
})
test_that("can control names if both present", {
x <- list(a = list(x = 1))
expect_equal(list_flatten(x), list(a_x = 1))
expect_equal(list_flatten(x, name_spec = "{inner}"), list(x = 1))
expect_equal(list_flatten(x, name_spec = "{outer}"), list(a = 1))
})
test_that("requires a list", {
expect_snapshot(list_flatten(1:2), error = TRUE)
})
test_that("list_flatten() restores", {
# This simulates a recursive list-of type
my_num_list <- function(...) {
new_my_num_list(list2(...))
}
new_my_num_list <- function(xs) {
stopifnot(
every(xs, function(x) {
is_null(x) || is.numeric(x) || inherits(x, "my_num_list")
})
)
new_vctr(xs, class = "my_num_list")
}
local_methods(
vec_restore.my_num_list = function(x, to, ...) {
new_my_num_list(x)
}
)
xs <- my_num_list(1, 2, my_num_list(3:4))
expect_equal(
list_flatten(xs),
my_num_list(1, 2, 3:4)
)
})
test_that("list_flatten() supports strict types", {
local_methods(
vec_cast.list.my_strict_list = function(x, to, ...) {
abort("Can't coerce to list.")
}
)
x <- structure(list(1), class = c("my_strict_list", "list"))
expect_equal(
list_flatten(list(x)),
list(1)
)
})
test_that("list_flatten() works with vctrs::list_of()", {
# Currently only with flat lists because list_of can't be recursive
expect_equal(
list_flatten(list_of(1, 2, 3)),
list_of(1, 2, 3)
)
})
purrr/tests/testthat/test-superseded-map-df.R 0000644 0001762 0000144 00000001505 14330525021 021027 0 ustar ligges users test_that("row and column binding work", {
skip_if_not_installed("dplyr")
local_name_repair_quiet()
mtcar_mod <- mtcars %>%
split(.$cyl) %>%
map(~ lm(mpg ~ wt, data = .x))
f_coef <- function(x) as.data.frame(t(as.matrix(coef(x))))
expect_length(mtcar_mod %>% map_dfr(f_coef), 2)
expect_length(mtcar_mod %>% map_dfc(f_coef), 6)
})
test_that("data frame imap works", {
skip_if_not_installed("dplyr")
x <- set_names(1:3)
expect_identical(imap_dfc(x, paste), imap_dfr(x, paste))
})
test_that("outputs are suffixes have correct type for data frames", {
skip_if_not_installed("dplyr")
local_name_repair_quiet()
local_options(rlang_message_verbosity = "quiet")
x <- 1:3
expect_s3_class(pmap_dfr(list(x), as.data.frame), "data.frame")
expect_s3_class(pmap_dfc(list(x), as.data.frame), "data.frame")
})
purrr/tests/testthat/test-superseded-transpose.R 0000644 0001762 0000144 00000005647 14330525021 021714 0 ustar ligges users test_that("input must be a list", {
expect_snapshot(transpose(1:3), error = TRUE)
})
test_that("elements of input must be atomic vectors", {
expect_snapshot(transpose(list(environment())), error = TRUE)
expect_snapshot(transpose(list(list(), environment())), error = TRUE)
})
test_that("empty list returns empty list", {
expect_equal(transpose(list()), list())
})
test_that("transpose switches order of first & second idnex", {
x <- list(list(1, 3), list(2, 4))
expect_equal(transpose(x), list(list(1, 2), list(3, 4)))
})
test_that("inside names become outside names", {
x <- list(list(x = 1), list(x = 2))
expect_equal(transpose(x), list(x = list(1, 2)))
})
test_that("outside names become inside names", {
x <- list(x = list(1, 3), y = list(2, 4))
expect_equal(transpose(x), list(list(x = 1, y = 2), list(x = 3, y = 4)))
})
test_that("warns if element too short", {
x <- list(list(1, 2), list(1))
expect_warning(out <- transpose(x), "Element 2 must be length 2, not 1")
expect_equal(out, list(list(1, 1), list(2, NULL)))
})
test_that("warns if element too long", {
x <- list(list(1, 2), list(1, 2, 3))
expect_warning(out <- transpose(x), "Element 2 must be length 2, not 3")
expect_equal(out, list(list(1, 1), list(2, 2)))
})
test_that("can transpose list of lists of atomic vectors", {
x <- list(list(TRUE, 1L, 1, "1"))
expect_equal(transpose(x), list(list(TRUE), list(1L), list(1), list("1")))
})
test_that("can transpose lists of atomic vectors", {
expect_equal(transpose(list(TRUE, FALSE)), list(list(TRUE, FALSE)))
expect_equal(transpose(list(1L, 2L)), list(list(1L, 2L)))
expect_equal(transpose(list(1, 2)), list(list(1, 2)))
expect_equal(transpose(list("a", "b")), list(list("a", "b")))
})
test_that("can't transpose expressions", {
expect_snapshot(transpose(list(expression(a))), error = TRUE)
})
# Named based matching ----------------------------------------------------
test_that("can override default names", {
x <- list(
list(x = 1),
list(y = 2, x = 1)
)
tx <- transpose(x, c("x", "y"))
expect_equal(tx, list(
x = list(1, 1),
y = list(NULL, 2)
))
})
test_that("if present, names are used", {
x <- list(
list(x = 1, y = 2),
list(y = 2, x = 1)
)
tx <- transpose(x)
expect_equal(tx$x, list(1, 1))
expect_equal(tx$y, list(2, 2))
})
test_that("if missing elements, filled with NULL", {
x <- list(
list(x = 1, y = 2),
list(x = 1)
)
tx <- transpose(x)
expect_equal(tx$y, list(2, NULL))
})
# Position based matching -------------------------------------------------
test_that("warning if too short", {
x <- list(
list(1, 2),
list(1)
)
expect_warning(tx <- transpose(x), "must be length 2, not 1")
expect_equal(tx, list(list(1, 1), list(2, NULL)))
})
test_that("warning if too long", {
x <- list(
list(1),
list(1, 2)
)
expect_warning(tx <- transpose(x), "must be length 1, not 2")
expect_equal(tx, list(list(1, 1)))
})
purrr/tests/testthat/test-deprec-prepend.R 0000644 0001762 0000144 00000002125 14310436312 020420 0 ustar ligges users test_that("prepend is deprecated", {
expect_snapshot({
. <- prepend(1, 2)
})
})
test_that("prepend is clearer version of merging with c()", {
local_options(lifecycle_verbosity = "quiet")
x <- 1:3
expect_identical(
x %>% prepend(4),
x %>% c(4, .)
)
expect_identical(
x %>% prepend(4, before = 3),
x %>% {
c(.[1:2], 4, .[3])
}
)
})
test_that("prepend appends at the beginning for empty list by default", {
local_options(lifecycle_verbosity = "quiet")
x <- list()
expect_identical(
x %>% prepend(1),
x %>% c(1, .)
)
})
test_that("prepend throws error if before param is neither NULL nor between 1 and length(x)", {
local_options(lifecycle_verbosity = "quiet")
expect_error(
prepend(list(), 1, before = 1),
"is.null(before) || (before > 0 && before <= n) is not TRUE"
)
x <- as.list(1:3)
expect_error(
x %>% prepend(4, before = 0),
"is.null(before) || (before > 0 && before <= n) is not TRUE"
)
expect_error(
x %>% prepend(4, before = 4),
"is.null(before) || (before > 0 && before <= n) is not TRUE"
)
})
purrr/tests/testthat/test-adverb-slowly.R 0000644 0001762 0000144 00000000137 14310436312 020316 0 ustar ligges users test_that("validates inputs", {
expect_snapshot(error = TRUE, {
slowly(mean, 10)
})
})
purrr/tests/testthat/test-adverb-quietly.R 0000644 0001762 0000144 00000000552 14347711234 020473 0 ustar ligges users test_that("quietly captures output", {
f <- function() {
cat(1)
message(2, appendLF = FALSE)
warning(3)
4
}
expect_output(quietly(f)(), NA)
expect_message(quietly(f)(), NA)
expect_warning(quietly(f)(), NA)
out <- quietly(f)()
expect_equal(out, list(
result = 4,
output = "1",
warnings = "3",
messages = "2"
))
})
purrr/tests/testthat/helper-map.R 0000644 0001762 0000144 00000000164 14304371054 016605 0 ustar ligges users named <- function(x) set_names(x, chr())
# Until we can reexport from rlang
vars <- function(...) rlang::quos(...)
purrr/tests/testthat/test-adverb-possibly.R 0000644 0001762 0000144 00000000466 14304371054 020642 0 ustar ligges users test_that("possibly returns default value on failure", {
expect_identical(possibly(log, NA_real_)("a"), NA_real_)
})
test_that("possibly emits a message on failure if quiet = FALSE", {
f <- function(...) stop("tilt")
expect_message({
possibly(f, NA_real_, quiet = FALSE)()
}, regexp = "tilt")
})
purrr/tests/testthat/test-pluck-assign.R 0000644 0001762 0000144 00000004540 14311066210 020123 0 ustar ligges users
# assign_in() ----------------------------------------------------------
test_that("assign_in() doesn't assign in the caller environment", {
x <- list(list(bar = 1, foo = 2))
assign_in(x, list(1, "foo"), value = 20)
expect_identical(x, list(list(bar = 1, foo = 2)))
})
test_that("assign_in() assigns", {
x <- list(list(bar = 1, foo = 2))
out <- assign_in(x, list(1, "foo"), value = 20)
expect_identical(out, list(list(bar = 1, foo = 20)))
})
test_that("can assign NULL (#636)", {
expect_equal(
assign_in(list(x = 1, y = 2), 1, value = NULL),
list(x = NULL, y = 2)
)
expect_equal(
assign_in(list(x = 1, y = 2), "y", value = NULL),
list(x = 1, y = NULL)
)
})
test_that("can remove elements with zap()", {
expect_equal(
assign_in(list(x = 1, y = 2), 1, value = zap()),
list(y = 2)
)
expect_equal(
assign_in(list(x = 1, y = 2), "y", value = zap()),
list(x = 1)
)
# And deep indexing leaves unchanged
expect_equal(
assign_in(list(x = 1, y = 2), c(3, 4, 5), value = zap()),
list(x = 1, y = 2)
)
expect_equal(
assign_in(list(x = 1, y = 2), c("a", "b", "c"), value = zap()),
list(x = 1, y = 2)
)
})
test_that("assign_in() requires at least one location", {
x <- list("foo")
expect_snapshot(error = TRUE, {
assign_in(x, NULL, value = "foo")
})
})
test_that("can modify non-existing locations", {
expect_equal(assign_in(list(), "x", 1), list(x = 1))
expect_equal(assign_in(list(), 2, 1), list(NULL, 1))
expect_equal(assign_in(list(), c("x", "y"), 1), list(x = list(y = 1)))
expect_equal(assign_in(list(), c(2, 1), 1), list(NULL, list(1)))
expect_equal(assign_in(list(), list("x", 2), 1), list(x = list(NULL, 1)))
expect_equal(assign_in(list(), list(1, "y"), 1), list(list(y = 1)))
})
# modify_in() ----------------------------------------------------------
test_that("modify_in() modifies in pluck location", {
x <- list(list(bar = 1, foo = 2))
out <- modify_in(x, list(1, "foo"), `+`, 100)
expect_identical(out, list(list(bar = 1, foo = 102)))
out <- modify_in(x, c(1, 1), `+`, 10)
expect_identical(out, list(list(bar = 11, foo = 2)))
})
test_that("modify_in() doesn't require existing", {
x <- list(list(x = 1, y = 2))
expect_equal(modify_in(x, 2, ~ 10), list(list(x = 1, y = 2), 10))
expect_equal(modify_in(x, list(1, "z"), ~ 10), list(list(x = 1, y = 2, z = 10)))
})
purrr/tests/testthat/test-list-simplify.R 0000644 0001762 0000144 00000003450 14311066210 020327 0 ustar ligges users test_that("simplifies using vctrs principles", {
expect_identical(list_simplify(list(1, 2L)), c(1, 2))
expect_equal(list_simplify(list("x", factor("y"))), c("x", "y"))
x <- list(data.frame(x = 1), data.frame(y = 2))
expect_equal(list_simplify(x), data.frame(x = c(1, NA), y = c(NA, 2)))
})
test_that("only uses outer names", {
out <- list_simplify(list(a = 1, c(b = 1), c = c(d = 1)))
expect_named(out, c("a", "", "c"))
})
test_that("ptype is enforced", {
expect_equal(list_simplify(list(1, 2), ptype = double()), c(1, 2))
expect_snapshot(list_simplify(list(1, 2), ptype = character()), error = TRUE)
# even if `strict = FALSE`
expect_snapshot(list_simplify(list(1, 2), ptype = character(), strict = FALSE), error = TRUE)
})
test_that("strict simplification will error", {
expect_snapshot(error = TRUE, {
list_simplify(list(mean))
list_simplify(list(1, "a"))
list_simplify(list(1, 1:2))
list_simplify(list(data.frame(x = 1), data.frame(x = 1:2)))
list_simplify(list(1, 2), ptype = character())
})
})
test_that("simplification requires length-1 vectors with common type", {
expect_equal(list_simplify(list(mean), strict = FALSE), list(mean))
expect_equal(list_simplify(list(1, 2:3), strict = FALSE), list(1, 2:3))
expect_equal(list_simplify(list(1, "a"), strict = FALSE), list(1, "a"))
})
# argument checking -------------------------------------------------------
test_that("list_simplify() validates inputs", {
expect_snapshot(list_simplify(1:5), error = TRUE)
expect_snapshot(list_simplify(list(), strict = NA), error = TRUE)
})
test_that("list_simplify_internal() validates inputs", {
expect_snapshot(list_simplify_internal(list(), simplify = 1), error = TRUE)
expect_snapshot(list_simplify_internal(list(), simplify = FALSE, ptype = integer()), error = TRUE)
})
purrr/tests/testthat/test-keep.R 0000644 0001762 0000144 00000002052 14311066210 016443 0 ustar ligges users test_that("can keep/discard with logical vector", {
expect_equal(keep(1:3, c(TRUE, FALSE, TRUE)), c(1, 3))
expect_equal(discard(1:3, c(TRUE, FALSE, TRUE)), 2)
})
test_that("can keep/discard with predicate", {
expect_equal(keep(1:3, ~ .x != 2), c(1, 3))
expect_equal(discard(1:3, ~ .x != 2), c(2))
})
test_that("keep() and discard() require predicate functions", {
expect_snapshot(error = TRUE, {
keep(1:3, ~ NA)
discard(1:3, ~ NA)
})
})
# keep_at / discard_at ----------------------------------------------------
test_that("can keep_at/discard_at with character vector", {
x <- list(a = 1, b = 1, c = 1)
expect_equal(keep_at(x, "b"), list(b = 1))
expect_equal(discard_at(x, "b"), list(a = 1, c = 1))
})
test_that("can keep_at/discard_at with function", {
x <- list(a = 1, b = 1, c = 1)
expect_equal(keep_at(x, ~ . == "b"), list(b = 1))
expect_equal(discard_at(x, ~ . == "b"), list(a = 1, c = 1))
})
test_that("discard_at works when nothing discarded", {
x <- list(a = 1, b = 1, c = 1)
expect_equal(discard_at(x, "d"), x)
})
purrr/tests/testthat/test-deprec-along.R 0000644 0001762 0000144 00000000643 14310436312 020066 0 ustar ligges users test_that("list-along is deprecated", {
expect_snapshot({
. <- list_along(1:4)
})
})
test_that("list_along works", {
local_options(lifecycle_verbosity = "quiet")
x <- 1:5
expect_identical(list_along(x), vector("list", 5))
})
test_that("rep_along works", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(
rep_along(c("c", "b", "a"), 1:3),
rep_along(c("d", "f", "e"), 1:3)
)
})
purrr/tests/testthat/test-adverb-compose.R 0000644 0001762 0000144 00000007767 14312677144 020466 0 ustar ligges users test_that("composed functions are applied right to left by default", {
expect_identical(!is.null(4), compose(`!`, is.null)(4))
set.seed(1)
x <- sample(1:4, 100, replace = TRUE)
expect_identical(unname(sort(table(x))), compose(unname, sort, table)(x))
})
test_that("composed functions are applied in reverse order if .dir is supplied", {
expect_identical(compose(~ .x + 100, ~ .x * 2, .dir = "forward")(2), 204)
})
test_that("compose supports formulas", {
round_mean <- compose(~ .x * 100, ~ round(.x, 2), ~ mean(.x, na.rm = TRUE))
expect_s3_class(round_mean, "purrr_function_compose")
expect_identical(round_mean(1:100), round( mean(1:100, na.rm = TRUE), 2) * 100 )
})
test_that("compose() supports character vectors", {
fn <- local({
foobar <- function(x) paste(x, "baz")
compose("foobar", "foobar")
})
expect_identical(fn("quux"), "quux baz baz")
})
test_that("can splice lists of functions", {
fns <- list(
~ paste(.x, "a"),
~ paste(.x, "b")
)
fn <- compose(!!!fns)
expect_identical(fn("c"), "c b a")
})
test_that("composed function has formals of first function called", {
fn <- function(x, y = 1) NULL
expect_identical(formals(compose(identity, fn)), formals(fn))
})
test_that("can compose primitive functions", {
expect_identical(compose(is.character, as.character)(3), TRUE)
expect_identical(compose(`-`, `/`)(4, 2), -2)
})
test_that("composed function prints informatively", {
fn1 <- set_env(function(x) x + 1, global_env())
fn2 <- set_env(function(x) x / 1, global_env())
expect_snapshot({
"Single input"
compose(fn1)
"Multiple inputs"
compose(fn1, fn2)
})
})
test_that("compose() with 0 inputs returns the identity", {
expect_identical(compose()(mtcars), mtcars)
})
test_that("compose() with 1 input is a noop", {
expect_identical(compose(toupper)(letters), toupper(letters))
})
test_that("compose() works with generic functions (#629)", {
purrr__gen <- function(x) UseMethod("purrr__gen")
local({
purrr__gen.default <- function(x) x + 1
expect_identical(compose(~ purrr__gen(.x))(0), 1)
expect_identical(compose(~ purrr__gen(.x), ~ purrr__gen(.x))(0), 2)
expect_identical(compose(purrr__gen)(0), 1)
expect_identical(compose(purrr__gen, purrr__gen)(0), 2)
})
})
test_that("compose() works with generic functions (#639)", {
n_unique <- purrr::compose(length, unique)
expect_identical(n_unique(iris$Species), 3L)
})
test_that("compose() works with argument matching functions", {
# They inspect their dynamic context via sys.function()
fn <- function(x = c("foo", "bar")) match.arg(x)
expect_identical(compose(fn)("f"), "foo")
expect_identical(compose(fn, fn)("f"), "foo")
})
test_that("compose() works with non-local exits", {
fn <- function(x) return(x)
expect_identical(compose(fn)("foo"), "foo")
expect_identical(compose(fn, fn)("foo"), "foo")
expect_identical(compose(~ return(paste(.x, "foo")), ~ return("bar"))(), "bar foo")
})
test_that("compose() preserves lexical environment", {
fn <- local({
`_foo` <- "foo"
function(...) `_foo`
})
expect_identical(compose(fn)(), "foo")
expect_identical(compose(fn, fn)(), "foo")
})
test_that("compose() can take dots from multiple environments", {
f <- function(...) {
`_foo` <- "foo"
g(`_foo`, ...)
}
g <- function(...) {
`_bar` <- "bar"
h(`_bar`, ...)
}
h <- function(...) {
`_baz` <- "baz"
fn(`_baz`, ...)
}
`_quux` <- "quux"
# By value
fn <- compose(function(...) c(...))
expect_identical(f(`_quux`), c("baz", "bar", "foo", "quux"))
# By expression (base)
fn <- compose(function(...) substitute(...()))
expect_identical(f(`_quux`), as.pairlist(exprs(`_baz`, `_bar`, `_foo`, `_quux`)))
# By expression (rlang)
fn <- compose(function(...) enquos(...))
quos <- f(`_quux`)
frame <- current_env()
expect_true(is_reference(quo_get_env(quos[[4]]), frame))
expect_false(is_reference(quo_get_env(quos[[3]]), frame))
expect_identical(unname(map_chr(quos, as_name)), c("_baz", "_bar", "_foo", "_quux"))
})
purrr/tests/testthat/test-adverb-safely.R 0000644 0001762 0000144 00000000521 14304371054 020251 0 ustar ligges users test_that("safely has NULL error when successful", {
out <- safely(log10)(10)
expect_equal(out, list(result = 1, error = NULL))
})
test_that("safely has NULL result on failure", {
out <- safely(log10)("a")
expect_equal(out$result, NULL)
expect_equal(out$error$message,
"non-numeric argument to mathematical function")
})
purrr/tests/testthat/test-adverb-insistently.R 0000644 0001762 0000144 00000000526 14310436312 021354 0 ustar ligges users test_that("insistently() resets rate state", {
fn <- insistently(compose(), rate_delay(1, max_times = 0))
expect_snapshot_error(fn(), class = "purrr_error_rate_excess")
expect_snapshot_error(fn(), class = "purrr_error_rate_excess")
})
test_that("validates inputs", {
expect_snapshot(error = TRUE, {
insistently(mean, 10)
})
})
purrr/tests/testthat/helper.R 0000644 0001762 0000144 00000001270 14310436312 016025 0 ustar ligges users expect_bare <- function(x, type) {
predicate <- switch(
type,
logical = is_bare_logical,
integer = is_bare_integer,
double = is_bare_double,
complex = is_bare_complex,
character = is_bare_character,
raw = is_bare_raw,
list = is_bare_list,
)
expect_true(predicate(x))
}
local_name_repair_quiet <- function(frame = caller_env()) {
local_options(rlib_name_repair_verbosity = "quiet", .frame = frame)
}
local_name_repair_verbose <- function(frame = caller_env()) {
local_options(rlib_name_repair_verbosity = "verbose", .frame = frame)
}
local_methods <- function(..., .frame = caller_env()) {
local_bindings(..., .env = global_env(), .frame = .frame)
}
purrr/tests/testthat/_snaps/ 0000755 0001762 0000144 00000000000 14462253072 015716 5 ustar ligges users purrr/tests/testthat/_snaps/list-simplify.md 0000644 0001762 0000144 00000003570 14462251443 021052 0 ustar ligges users # ptype is enforced
Code
list_simplify(list(1, 2), ptype = character())
Condition
Error in `list_simplify()`:
! Can't convert `[[1]]` to .
---
Code
list_simplify(list(1, 2), ptype = character(), strict = FALSE)
Condition
Error in `list_simplify()`:
! Can't convert `[[1]]` to .
# strict simplification will error
Code
list_simplify(list(mean))
Condition
Error in `list_simplify()`:
! `x[[1]]` must be a vector, not a function.
Code
list_simplify(list(1, "a"))
Condition
Error in `list_simplify()`:
! Can't combine `[[1]]` and `[[2]]` .
Code
list_simplify(list(1, 1:2))
Condition
Error in `list_simplify()`:
! `x[[2]]` must have size 1, not size 2.
Code
list_simplify(list(data.frame(x = 1), data.frame(x = 1:2)))
Condition
Error in `list_simplify()`:
! `x[[2]]` must have size 1, not size 2.
Code
list_simplify(list(1, 2), ptype = character())
Condition
Error in `list_simplify()`:
! Can't convert `[[1]]` to .
# list_simplify() validates inputs
Code
list_simplify(1:5)
Condition
Error in `list_simplify()`:
! `x` must be a list, not an integer vector.
---
Code
list_simplify(list(), strict = NA)
Condition
Error in `list_simplify()`:
! `strict` must be `TRUE` or `FALSE`, not `NA`.
# list_simplify_internal() validates inputs
Code
list_simplify_internal(list(), simplify = 1)
Condition
Error:
! `simplify` must be `TRUE`, `FALSE`, or `NA`, not the number 1.
---
Code
list_simplify_internal(list(), simplify = FALSE, ptype = integer())
Condition
Error:
! Can't specify `ptype` when `simplify = FALSE`.
purrr/tests/testthat/_snaps/detect.md 0000644 0001762 0000144 00000001512 14462251442 017506 0 ustar ligges users # `detect()` requires a predicate function
Code
detect(list(1:2, 2), is.na)
Condition
Error in `detect()`:
! `.f()` must return a single `TRUE` or `FALSE`, not a logical vector.
---
Code
detect_index(list(1:2, 2), is.na)
Condition
Error in `detect_index()`:
! `.f()` must return a single `TRUE` or `FALSE`, not a logical vector.
# `.right` argument is retired
Code
. <- detect(1:2, ~TRUE, .right = TRUE)
Condition
Warning:
The `.right` argument of `detect()` is deprecated as of purrr 0.3.0.
i Please use the `.dir` argument instead.
Code
. <- detect_index(1:2, ~TRUE, .right = TRUE)
Condition
Warning:
The `.right` argument of `detect_index()` is deprecated as of purrr 0.3.0.
i Please use the `.dir` argument instead.
purrr/tests/testthat/_snaps/arrays.md 0000644 0001762 0000144 00000000322 14462251440 017533 0 ustar ligges users # array_branch throws an error for wrong margins on a vector
Code
array_branch(1:3, 2)
Condition
Error in `array_branch()`:
! `margin` must be `NULL` or `1` with 1D arrays, not "2".
purrr/tests/testthat/_snaps/map-raw.md 0000644 0001762 0000144 00000001450 14462251444 017605 0 ustar ligges users # _raw funtions are deprecated
Code
. <- map_raw(list(), ~.x)
Condition
Warning:
`map_raw()` was deprecated in purrr 1.0.0.
i Please use `map_vec()` instead.
Code
. <- map2_raw(list(), list(), ~.x)
Condition
Warning:
`map2_raw()` was deprecated in purrr 1.0.0.
i Please use `map2_vec()` instead.
Code
. <- imap_raw(list(), ~.x)
Condition
Warning:
`imap_raw()` was deprecated in purrr 1.0.0.
i Please use `imap_vec()` instead.
Code
. <- pmap_raw(list(), ~.x)
Condition
Warning:
`pmap_raw()` was deprecated in purrr 1.0.0.
i Please use `pmap_vec()` instead.
Code
. <- flatten_raw(list())
Condition
Warning:
`flatten_raw()` was deprecated in purrr 1.0.0.
purrr/tests/testthat/_snaps/list-modify.md 0000644 0001762 0000144 00000002061 14462251443 020477 0 ustar ligges users # list_modify() validates inputs
Code
list_modify(1:3)
Condition
Error in `list_modify()`:
! `.x` must be a list, not an integer vector.
---
Code
list_modify(list(a = 1), 2, a = 2)
Condition
Error in `list_modify()`:
! `...` arguments must be either all named or all unnamed.
---
Code
list_modify(list(x = 1), x = 2, x = 3)
Condition
Error in `list_modify()`:
! Arguments in `...` must have unique names.
x Multiple arguments named `x` at positions 1 and 2.
# merge() validates inputs
Code
list_merge(1:3)
Condition
Error in `list_merge()`:
! `.x` must be a list, not an integer vector.
---
Code
list_merge(list(x = 1), x = 2, x = 3)
Condition
Error in `list_merge()`:
! Arguments in `...` must have unique names.
x Multiple arguments named `x` at positions 1 and 2.
# update_list() is deprecated
Code
. <- update_list(list())
Condition
Warning:
`update_list()` was deprecated in purrr 1.0.0.
purrr/tests/testthat/_snaps/deprec-utils.md 0000644 0001762 0000144 00000000414 14462251441 020635 0 ustar ligges users # rdunif and rbernoulli are deprecated
Code
. <- rdunif(10, 1)
Condition
Warning:
`rdunif()` was deprecated in purrr 1.0.0.
Code
. <- rbernoulli(10)
Condition
Warning:
`rbernoulli()` was deprecated in purrr 1.0.0.
purrr/tests/testthat/_snaps/map2.md 0000644 0001762 0000144 00000002164 14462251444 017103 0 ustar ligges users # verifies result types and length
Code
map2_int(1, 1, ~"x")
Condition
Error in `map2_int()`:
i In index: 1.
Caused by error:
! Can't coerce from a string to an integer.
Code
map2_int(1, 1, ~ 1:2)
Condition
Error in `map2_int()`:
i In index: 1.
Caused by error:
! Result must be length 1, not 2.
Code
map2_vec(1, 1, ~1, .ptype = character())
Condition
Error in `map2_vec()`:
! Can't convert `[[1]]` to .
# requires vector inputs
Code
map2(environment(), "a", identity)
Condition
Error in `map2()`:
! `.x` must be a vector, not an environment.
Code
map2("a", environment(), "a", identity)
Condition
Error in `map2()`:
! `.y` must be a vector, not an environment.
# recycles inputs
Code
map2(1:2, 1:3, `+`)
Condition
Error in `map2()`:
! Can't recycle `.x` (size 2) to match `.y` (size 3).
Code
map2(1:2, integer(), `+`)
Condition
Error in `map2()`:
! Can't recycle `.x` (size 2) to match `.y` (size 0).
purrr/tests/testthat/_snaps/list-combine.md 0000644 0001762 0000144 00000004555 14462251442 020635 0 ustar ligges users # list_c() concatenates vctrs of compatible types
Code
list_c(list("a", 1))
Condition
Error in `list_c()`:
! Can't combine `x[[1]]` and `x[[2]]` .
# list_c() can enforce ptype
Code
list_c(list("a"), ptype = integer())
Condition
Error in `list_c()`:
! Can't convert `x[[1]]` to .
# list_cbind() column-binds compatible data frames
Code
list_cbind(list(df1, df3))
Condition
Error in `list_cbind()`:
! Can't recycle `..1` (size 2) to match `..2` (size 3).
# list_cbind() can enforce size
Code
list_cbind(list(df1), size = 3)
Condition
Error:
! Can't recycle input of size 2 to size 3.
# list_rbind() row-binds compatible data.frames
Code
list_rbind(list(df1, df3))
Condition
Error in `list_rbind()`:
! Can't combine `..1$x` and `..2$x` .
# list_rbind() can enforce ptype
Code
ptype <- data.frame(x = character(), stringsAsFactors = FALSE)
list_rbind(list(df1), ptype = ptype)
Condition
Error in `list_rbind()`:
! Can't convert `..1$x` to match type of `x` .
# assert input is a list
Code
list_c(1)
Condition
Error in `list_c()`:
! `x` must be a list, not the number 1.
Code
list_rbind(1)
Condition
Error in `list_rbind()`:
! `x` must be a list, not the number 1.
Code
list_cbind(1)
Condition
Error in `list_cbind()`:
! `x` must be a list, not the number 1.
---
Code
list_c(mtcars)
Condition
Error in `list_c()`:
! `x` must be a list, not a object.
Code
list_rbind(mtcars)
Condition
Error in `list_rbind()`:
! `x` must be a list, not a object.
Code
list_cbind(mtcars)
Condition
Error in `list_cbind()`:
! `x` must be a list, not a object.
# assert input is list of data frames
Code
list_rbind(list(1, mtcars, 3))
Condition
Error in `list_rbind()`:
! Each element of `x` must be either a data frame or `NULL`.
i Elements 1 and 3 are not.
Code
list_cbind(list(1, mtcars, 3))
Condition
Error in `list_cbind()`:
! Each element of `x` must be either a data frame or `NULL`.
i Elements 1 and 3 are not.
purrr/tests/testthat/_snaps/superseded-transpose.md 0000644 0001762 0000144 00000001267 14462251447 022431 0 ustar ligges users # input must be a list
Code
transpose(1:3)
Condition
Error in `transpose()`:
! `.l` must be a list, not an integer vector.
# elements of input must be atomic vectors
Code
transpose(list(environment()))
Condition
Error in `transpose()`:
! Element 1 must be a vector, not an environment.
---
Code
transpose(list(list(), environment()))
Condition
Error in `transpose()`:
! Element 2 must be a vector, not an environment.
# can't transpose expressions
Code
transpose(list(expression(a)))
Condition
Error in `transpose()`:
! Transposed element must be a vector, not an expression vector.
purrr/tests/testthat/_snaps/deprec-map.md 0000644 0001762 0000144 00000000276 14462251441 020260 0 ustar ligges users # at_depth is defunct
Code
at_depth()
Condition
Error:
! `at_depth()` was deprecated in purrr 0.3.0 and is now defunct.
i Please use `map_depth()` instead.
purrr/tests/testthat/_snaps/list-flatten.md 0000644 0001762 0000144 00000000227 14462251442 020646 0 ustar ligges users # requires a list
Code
list_flatten(1:2)
Condition
Error in `list_flatten()`:
! `x` must be a list, not an integer vector.
purrr/tests/testthat/_snaps/conditions.md 0000644 0001762 0000144 00000003511 14462251441 020407 0 ustar ligges users # stop_bad_type() constructs default `what`
Code
stop_bad_type(NA, "`NULL`")
Condition
Error:
! Object must be `NULL`, not `NA`.
---
Code
stop_bad_type(NA, "`NULL`", arg = ".foo")
Condition
Error:
! `.foo` must be `NULL`, not `NA`.
---
Code
stop_bad_type(NA, "`NULL`", arg = quote(.foo))
Condition
Error in `what_bad_object()`:
! `arg` must be `NULL` or a string, not a symbol.
# stop_bad_element_type() constructs type errors
Code
stop_bad_element_type(1:3, 3, "a foobaz")
Condition
Error:
! Element 3 must be a foobaz, not an integer vector.
---
Code
stop_bad_element_type(1:3, 3, "a foobaz", actual = "a quux")
Condition
Error:
! Element 3 must be a foobaz, not an integer vector.
---
Code
stop_bad_element_type(1:3, 3, "a foobaz", arg = "..arg")
Condition
Error:
! `..arg[[3]]` must be a foobaz, not an integer vector.
# stop_bad_element_type() accepts `what`
Code
stop_bad_element_type(1:3, 3, "a foobaz", what = "Result")
Condition
Error:
! Result 3 must be a foobaz, not an integer vector.
# stop_bad_element_length() constructs error message
Code
stop_bad_element_length(1:3, 8, 10)
Condition
Error:
! Element 8 must have length 10, not 3.
---
Code
stop_bad_element_length(1:3, 8, 10, arg = ".foo")
Condition
Error:
! `.foo[[8]]` must have length 10, not 3.
---
Code
stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result")
Condition
Error:
! `.foo[[8]]` must have length 10, not 3.
---
Code
stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result", recycle = TRUE)
Condition
Error:
! `.foo[[8]]` must have length 1 or 10, not 3.
purrr/tests/testthat/_snaps/pmap.md 0000644 0001762 0000144 00000002231 14462251446 017176 0 ustar ligges users # verifies result types and length
Code
pmap_int(list(1), ~"x")
Condition
Error in `pmap_int()`:
i In index: 1.
Caused by error:
! Can't coerce from a string to an integer.
Code
pmap_int(list(1), ~ 1:2)
Condition
Error in `pmap_int()`:
i In index: 1.
Caused by error:
! Result must be length 1, not 2.
Code
pmap_vec(list(1), ~1, .ptype = character())
Condition
Error in `pmap_vec()`:
! Can't convert `[[1]]` to .
# requires list of vectors
Code
pmap(environment(), identity)
Condition
Error in `pmap()`:
! `.l` must be a list, not an environment.
Code
pmap(list(environment()), identity)
Condition
Error in `pmap()`:
! `.l[[1]]` must be a vector, not an environment.
# recycles inputs
Code
pmap(list(1:2, 1:3), `+`)
Condition
Error in `pmap()`:
! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 3).
Code
pmap(list(1:2, integer()), `+`)
Condition
Error in `pmap()`:
! Can't recycle `.l[[1]]` (size 2) to match `.l[[2]]` (size 0).
purrr/tests/testthat/_snaps/modify-tree.md 0000644 0001762 0000144 00000000535 14462251444 020470 0 ustar ligges users # validates inputs
Code
modify_tree(list(), is_node = ~1)
Condition
Error in `modify_tree()`:
! `is_node()` must return a single `TRUE` or `FALSE`, not a number.
Code
modify_tree(list(), is_node = 1)
Condition
Error in `modify_tree()`:
! Can't convert `is_node`, a double vector, to a function.
purrr/tests/testthat/_snaps/modify.md 0000644 0001762 0000144 00000006004 14462251445 017531 0 ustar ligges users # modfiying data.frame preserves type and size
Code
modify(df1, ~ integer())
Condition
Error in `modify()`:
! Can't recycle `out$x` (size 0) to size 2.
Code
modify(df1, ~ 1:4)
Condition
Error in `modify()`:
! Can't recycle `out$x` (size 4) to size 2.
Code
modify_at(df1, 2, ~ integer())
Condition
Error in `modify_where()`:
! Can't recycle `out$y` (size 0) to size 2.
Code
modify2(df1, list(1, 1:3), ~.y)
Condition
Error in `modify2()`:
! Can't recycle `out$y` (size 3) to size 2.
# zap gives clear error
Code
modify_at(1, 1, ~ zap())
Condition
Error in `map_vec()`:
! `out[[1]]` must be a vector, not a object.
Code
modify_at(list(1), 1, ~ zap())
Condition
Error in `modify_at()`:
! Can't use `zap()` to change the size of the output.
Code
modify_at(data.frame(x = 1), 1, ~ zap())
Condition
Error in `modify_at()`:
! Can't use `zap()` to change the size of the output.
Code
modify_at(lm(mpg ~ wt, data = mtcars), 1, ~ zap())
Condition
Error in `modify_at()`:
! Can't use `zap()` to change the size of the output.
# bad type has useful error
Code
modify(1:3, ~"foo")
Condition
Error in `map_vec()`:
! Can't convert `[[1]]` to .
Code
modify_at(1:3, 1, ~"foo")
Condition
Error in `map_vec()`:
! Can't convert `[[1]]` to .
Code
modify_if(1:3, is_integer, ~"foo")
Condition
Error in `map_vec()`:
! Can't convert `[[1]]` to .
Code
modify2(1:3, "foo", ~.y)
Condition
Error in `map2_vec()`:
! Can't convert `[[1]]` to .
# modify2() recycles arguments
Code
modify2(1:3, integer(), `+`)
Condition
Error in `map2()`:
! Can't recycle `.x` (size 3) to match `.y` (size 0).
Code
modify2(1:3, 1:4, `+`)
Condition
Error in `map2()`:
! Can't recycle `.x` (size 3) to match `.y` (size 4).
# modify_if() requires predicate functions
Code
modify_if(list(1, 2), ~NA, ~"foo")
Condition
Error in `modify_if()`:
i In index: 1.
Caused by error:
! `.p()` must return a single `TRUE` or `FALSE`, not `NA`.
# user friendly error for non-supported cases
Code
modify(mean, identity)
Condition
Error in `modify()`:
! `.x` must be a vector, list, or data frame, not a function.
Code
modify_if(mean, TRUE, identity)
Condition
Error in `modify_if()`:
! `.x` must be a vector, list, or data frame, not a function.
Code
modify_at(mean, "x", identity)
Condition
Error in `modify_at()`:
! `.x` must be a vector, list, or data frame, not a function.
Code
modify2(mean, 1, identity)
Condition
Error in `modify2()`:
! `.x` must be a vector, list, or data frame, not a function.
purrr/tests/testthat/_snaps/deprec-splice.md 0000644 0001762 0000144 00000000260 14462251441 020753 0 ustar ligges users # splice is deprecated
Code
. <- splice()
Condition
Warning:
`splice()` was deprecated in purrr 1.0.0.
i Please use `list_flatten()` instead.
purrr/tests/testthat/_snaps/deprec-prepend.md 0000644 0001762 0000144 00000000270 14462251441 021132 0 ustar ligges users # prepend is deprecated
Code
. <- prepend(1, 2)
Condition
Warning:
`prepend()` was deprecated in purrr 1.0.0.
i Please use append(after = 0) instead.
purrr/tests/testthat/_snaps/adverb-partial.md 0000644 0001762 0000144 00000001447 14462251440 021140 0 ustar ligges users # partial() squashes quosures before printing
Code
foo
Output
function (...)
foo(y = 3, ...)
# `.lazy`, `.env`, and `.first` are soft-deprecated
Code
. <- partial(list, "foo", .lazy = TRUE)
Condition
Warning:
The `.lazy` argument of `partial()` is deprecated as of purrr 0.3.0.
Code
. <- partial(list, "foo", .env = env())
Condition
Warning:
The `.env` argument of `partial()` is deprecated as of purrr 0.3.0.
Code
. <- partial(list, "foo", .first = TRUE)
Condition
Warning:
The `.first` argument of `partial()` is deprecated as of purrr 0.3.0.
# checks inputs
Code
partial(1)
Condition
Error in `partial()`:
! `.f` must be a function, not a number.
purrr/tests/testthat/_snaps/keep.md 0000644 0001762 0000144 00000000637 14462251442 017171 0 ustar ligges users # keep() and discard() require predicate functions
Code
keep(1:3, ~NA)
Condition
Error in `keep()`:
i In index: 1.
Caused by error:
! `.p()` must return a single `TRUE` or `FALSE`, not `NA`.
Code
discard(1:3, ~NA)
Condition
Error in `discard()`:
i In index: 1.
Caused by error:
! `.p()` must return a single `TRUE` or `FALSE`, not `NA`.
purrr/tests/testthat/_snaps/lmap.md 0000644 0001762 0000144 00000000700 14462251443 017166 0 ustar ligges users # validates inputs
Code
lmap(list(1), ~1)
Condition
Error in `lmap()`:
! `.f(.x[[1]])` must return a list, not a number.
Code
lmap(list(1), environment())
Condition
Error in `lmap()`:
! Can't convert `.f`, an environment, to a function.
Code
lmap(list(1), ~1, .else = environment())
Condition
Error in `lmap()`:
! Can't convert `.else`, an environment, to a function.
purrr/tests/testthat/_snaps/coerce.md 0000644 0001762 0000144 00000002170 14462251440 017475 0 ustar ligges users # can coerce to character vectors
Code
expect_equal(coerce_chr(TRUE), "TRUE")
Condition
Warning:
Automatic coercion from logical to character was deprecated in purrr 1.0.0.
i Please use an explicit call to `as.character()` within `map_chr()` instead.
Code
expect_equal(coerce_chr(1L), "1")
Condition
Warning:
Automatic coercion from integer to character was deprecated in purrr 1.0.0.
i Please use an explicit call to `as.character()` within `map_chr()` instead.
Code
expect_equal(coerce_chr(1.5), "1.500000")
Condition
Warning:
Automatic coercion from double to character was deprecated in purrr 1.0.0.
i Please use an explicit call to `as.character()` within `map_chr()` instead.
# error captures correct env
Code
map_chr(1:4, identity)
Condition
Warning:
Automatic coercion from integer to character was deprecated in purrr 1.0.0.
i Please use an explicit call to `as.character()` within `map_chr()` instead.
Output
[1] "1" "2" "3" "4"
Code
indirect()
Output
[1] "1" "2" "3" "4"
purrr/tests/testthat/_snaps/pluck.md 0000644 0001762 0000144 00000012022 14462251446 017356 0 ustar ligges users # can pluck/chuck from NULL
Code
chuck(NULL, 1)
Condition
Error in `chuck()`:
! Can't pluck from NULL at level 1.
# unsupported types have useful error
Code
pluck(quote(x), 1)
Condition
Error in `pluck_raw()`:
! Can't pluck from a symbol at level 1.
Code
pluck(quote(f(x, 1)), 1)
Condition
Error in `pluck_raw()`:
! Can't pluck from a call at level 1.
Code
pluck(expression(1), 1)
Condition
Error in `pluck_raw()`:
! Can't pluck from an expression vector at level 1.
# dots must be unnamed
Code
pluck(1, a = 1)
Condition
Error in `pluck()`:
! Arguments in `...` must be passed by position, not name.
x Problematic argument:
* a = 1
---
Code
chuck(1, a = 1)
Condition
Error in `chuck()`:
! Arguments in `...` must be passed by position, not name.
x Problematic argument:
* a = 1
# can pluck by position (positive and negative)
Code
chuck(x, 0)
Condition
Error in `chuck()`:
! Index 1 is zero.
---
Code
chuck(x, 4)
Condition
Error in `chuck()`:
! Index 1 exceeds the length of plucked object (4 > 3).
---
Code
chuck(x, -4)
Condition
Error in `chuck()`:
! Index 1 is zero.
---
Code
chuck(x, -5)
Condition
Error in `chuck()`:
! Negative index 1 must be greater than or equal to -3, not -5.
# special numbers don't match
Code
chuck(x, NA_integer_)
Condition
Error in `chuck()`:
! Index 1 must be finite, not NA.
---
Code
chuck(x, NA_real_)
Condition
Error in `chuck()`:
! Index 1 must be finite, not NA.
---
Code
chuck(x, NaN)
Condition
Error in `chuck()`:
! Index 1 must be finite, not NaN.
---
Code
chuck(x, Inf)
Condition
Error in `chuck()`:
! Index 1 must be finite, not Inf.
---
Code
chuck(x, -Inf)
Condition
Error in `chuck()`:
! Index 1 must be finite, not -Inf.
# can pluck by name
Code
chuck(x, "b")
Condition
Error in `chuck()`:
! Can't find name `b` in vector.
---
Code
chuck(x, NA_character_)
Condition
Error in `chuck()`:
! Index 1 can't be NA.
---
Code
chuck(x, "")
Condition
Error in `chuck()`:
! Index 1 can't be an empty string ("").
# even if names don't exist
Code
chuck(x, "a")
Condition
Error in `chuck()`:
! Index 1 is attempting to pluck from an unnamed vector using a string name.
# empty and NA names never match
Code
chuck(x, "")
Condition
Error in `chuck()`:
! Index 1 can't be an empty string ("").
---
Code
chuck(x, NA_character_)
Condition
Error in `chuck()`:
! Index 1 can't be NA.
# require length 1 character/double vectors
Code
pluck(1, 1:2)
Condition
Error in `pluck_raw()`:
! Index 1 must have length 1, not 2.
Code
pluck(1, integer())
Condition
Error in `pluck_raw()`:
! Index 1 must have length 1, not 0.
Code
pluck(1, NULL)
Condition
Error in `pluck_raw()`:
! Index 1 must have length 1, not 0.
Code
pluck(1, TRUE)
Condition
Error in `pluck_raw()`:
! Index 1 must be a character or numeric vector, not `TRUE`.
# validate index even when indexing NULL
Code
pluck(NULL, 1:2)
Condition
Error in `pluck_raw()`:
! Index 1 must have length 1, not 2.
Code
pluck(NULL, TRUE)
Condition
Error in `pluck_raw()`:
! Index 1 must be a character or numeric vector, not `TRUE`.
# accessors throw correct errors
Code
pluck(1:3, function() NULL)
Condition
Error:
! unused argument (1:3)
Code
pluck(1:3, function(x, y) y)
Condition
Error:
! argument "y" is missing, with no default
# can pluck/chuck environment by name
Code
chuck(x, "y")
Condition
Error in `chuck()`:
! Can't find object `y` in environment.
---
Code
chuck(x, NA_character_)
Condition
Error in `chuck()`:
! Index 1 can't be NA.
# environments error with invalid indices
Code
pluck(environment(), 1)
Condition
Error in `pluck_raw()`:
! Index 1 must be a string, not a number.
---
Code
pluck(environment(), letters)
Condition
Error in `pluck_raw()`:
! Index 1 must have length 1, not 26.
# can pluck/chuck from S4 objects
Code
chuck(A, "b")
Condition
Error in `chuck()`:
! Can't find slot `b`.
---
Code
chuck(A, NA_character_)
Condition
Error in `chuck()`:
! Index 1 can't be NA.
# S4 objects error with invalid indices
Code
pluck(A, 1)
Condition
Error in `pluck_raw()`:
! Index 1 must be a string, not a number.
---
Code
pluck(A, letters)
Condition
Error in `pluck_raw()`:
! Index 1 must have length 1, not 26.
purrr/tests/testthat/_snaps/superseded-flatten.md 0000644 0001762 0000144 00000001331 14462251447 022040 0 ustar ligges users # input must be a list
Code
flatten(1)
Condition
Error in `flatten()`:
! `.x` must be a list, not a number.
---
Code
flatten_dbl(1)
Condition
Error in `flatten_dbl()`:
! `.x` must be a list, not a number.
# contents of list must be supported types
Code
flatten(list(quote(a)))
Condition
Error in `flatten()`:
! `.x[[1]]` must be a vector, not a symbol.
---
Code
flatten(list(expression(a)))
Condition
Error in `flatten()`:
! `.x[[1]]` must be a vector, not an expression vector.
# must be a list
Code
flatten_lgl(1)
Condition
Error in `flatten_lgl()`:
! `.x` must be a list, not a number.
purrr/tests/testthat/_snaps/pluck-assign.md 0000644 0001762 0000144 00000000277 14462251445 020650 0 ustar ligges users # assign_in() requires at least one location
Code
assign_in(x, NULL, value = "foo")
Condition
Error in `assign_in()`:
! `where` must contain at least one element.
purrr/tests/testthat/_snaps/map.md 0000644 0001762 0000144 00000003537 14462253072 017025 0 ustar ligges users # fails on non-vectors
Code
map(environment(), identity)
Condition
Error in `map()`:
! `.x` must be a vector, not an environment.
---
Code
map(quote(a), identity)
Condition
Error in `map()`:
! `.x` must be a vector, not a symbol.
# all inform about location of problem
Code
map_int(1:3, ~ fail_at_3(.x, 2:1))
Condition
Error in `map_int()`:
i In index: 3.
Caused by error:
! Result must be length 1, not 2.
Code
map_int(1:3, ~ fail_at_3(.x, "x"))
Condition
Error in `map_int()`:
i In index: 3.
Caused by error:
! Can't coerce from a string to an integer.
Code
map(1:3, ~ fail_at_3(.x, stop("Doesn't work")))
Condition
Error in `map()`:
i In index: 3.
Caused by error in `fail_at_3()`:
! Doesn't work
# error location uses name if present
Code
map_int(c(a = 1, b = 2, c = 3), ~ fail_at_3(.x, stop("Error")))
Condition
Error in `map_int()`:
i In index: 3.
i With name: c.
Caused by error in `fail_at_3()`:
! Error
Code
map_int(c(a = 1, b = 2, 3), ~ fail_at_3(.x, stop("Error")))
Condition
Error in `map_int()`:
i In index: 3.
Caused by error in `fail_at_3()`:
! Error
# requires output be length 1 and have common type
Code
map_vec(1:2, ~ rep(1, .x))
Condition
Error in `map_vec()`:
! `out[[2]]` must have size 1, not size 2.
Code
map_vec(1:2, ~ if (.x == 1) factor("x") else 1)
Condition
Error in `map_vec()`:
! Can't combine `[[1]]` > and `[[2]]` .
# can enforce .ptype
Code
map_vec(1:2, ~ factor("x"), .ptype = integer())
Condition
Error in `map_vec()`:
! Can't convert `[[1]]` > to .
purrr/tests/testthat/_snaps/deprec-along.md 0000644 0001762 0000144 00000000303 14462251441 020572 0 ustar ligges users # list-along is deprecated
Code
. <- list_along(1:4)
Condition
Warning:
`list_along()` was deprecated in purrr 1.0.0.
i Please use rep_along(x, list()) instead.
purrr/tests/testthat/_snaps/pluck-depth.md 0000644 0001762 0000144 00000000300 14462251445 020453 0 ustar ligges users # vec_depth() is deprecated
Code
. <- vec_depth(list())
Condition
Warning:
`vec_depth()` was deprecated in purrr 1.0.0.
i Please use `pluck_depth()` instead.
purrr/tests/testthat/_snaps/deprec-cross.md 0000644 0001762 0000144 00000000351 14462251441 020626 0 ustar ligges users # filtering requires a predicate function
Code
cross2(1:3, 1:3, .filter = ~ c(TRUE, TRUE))
Condition
Error in `cross()`:
! The filter function must return a single `TRUE` or `FALSE`, not a logical vector.
purrr/tests/testthat/_snaps/reduce.md 0000644 0001762 0000144 00000002444 14462251446 017516 0 ustar ligges users # empty input returns init or error
Code
reduce(list())
Condition
Error in `reduce()`:
! Must supply `.init` when `.x` is empty.
# accumulate() does fail when simpification is required
Code
accumulate(list(1, "a"), ~.y, .simplify = TRUE)
Condition
Error in `accumulate()`:
! Can't combine `res[[1]]` and `res[[2]]` .
# requires equal length vectors
Code
reduce2(1:3, 1, `+`)
Condition
Error in `reduce2()`:
! `.y` must have length 2, not 1.
# requires init if `.x` is empty
Code
reduce2(list())
Condition
Error in `reduce2()`:
! Must supply `.init` when `.x` is empty.
# right variants are retired
Code
. <- reduce_right(1:3, c)
Condition
Warning:
`reduce_right()` was deprecated in purrr 0.3.0.
i Please use the `.dir` argument of `reduce()` instead.
Code
. <- reduce2_right(1:3, 1:2, c)
Condition
Warning:
`reduce2_right()` was deprecated in purrr 0.3.0.
i Please use reverse your vectors and use `reduce2()` instead.
Code
. <- accumulate_right(1:3, c)
Condition
Warning:
`accumulate_right()` was deprecated in purrr 0.3.0.
i Please use the `.dir` argument of `accumulate()` instead.
purrr/tests/testthat/_snaps/adverb-compose.md 0000644 0001762 0000144 00000000445 14462251440 021146 0 ustar ligges users # composed function prints informatively
Code
# Single input
compose(fn1)
Output
1. function(x) x + 1
Code
# Multiple inputs
compose(fn1, fn2)
Output
1. function(x) x / 1
2. function(x) x + 1
purrr/tests/testthat/_snaps/map-depth.md 0000644 0001762 0000144 00000002121 14462251444 020114 0 ustar ligges users # map_depth modifies values at specified depth
Code
map_depth(x1, 6, length)
Condition
Error in `.fmap()`:
i In index: 1.
Caused by error in `.fmap()`:
i In index: 1.
Caused by error in `.fmap()`:
i In index: 1.
Caused by error in `map_depth()`:
! List not deep enough
---
Code
map_depth(x1, -5, length)
Condition
Error in `map_depth()`:
! Negative `.depth` (-5) must be greater than -4.
# modify_depth modifies values at specified depth
Code
modify_depth(x1, 5, length)
Condition
Error in `map()`:
i In index: 1.
Caused by error in `map()`:
i In index: 1.
Caused by error in `map()`:
i In index: 1.
Caused by error in `modify_depth()`:
! List not deep enough
---
Code
modify_depth(x1, -5, length)
Condition
Error in `modify_depth()`:
! Negative `.depth` (-5) must be greater than -4.
# validates depth
Code
check_depth(mean)
Condition
Error:
! `depth` must be a whole number, not a function.
purrr/tests/testthat/_snaps/deprec-rerun.md 0000644 0001762 0000144 00000001050 14462251441 020625 0 ustar ligges users # is deprecated
Code
. <- rerun(5, rnorm(1))
Condition
Warning:
`rerun()` was deprecated in purrr 1.0.0.
i Please use `map()` instead.
# Previously
rerun(5, rnorm(1))
# Now
map(1:5, ~ rnorm(1))
Code
. <- rerun(5, rnorm(1), rnorm(2))
Condition
Warning:
`rerun()` was deprecated in purrr 1.0.0.
i Please use `map()` instead.
# Previously
rerun(5, rnorm(1), rnorm(2))
# Now
map(1:5, ~ list(rnorm(1), rnorm(2)))
purrr/tests/testthat/_snaps/deprec-lift.md 0000644 0001762 0000144 00000001373 14462251441 020440 0 ustar ligges users # lift functions are deprecated
Code
. <- lift_dl(function() { })
Condition
Warning:
`lift()` was deprecated in purrr 1.0.0.
Code
. <- lift_dv(function() { })
Condition
Warning:
`lift_dv()` was deprecated in purrr 1.0.0.
Code
. <- lift_vl(function() { })
Condition
Warning:
`lift_vl()` was deprecated in purrr 1.0.0.
Code
. <- lift_vd(function() { })
Condition
Warning:
`lift_vd()` was deprecated in purrr 1.0.0.
Code
. <- lift_ld(function() { })
Condition
Warning:
`lift_ld()` was deprecated in purrr 1.0.0.
Code
. <- lift_lv(function() { })
Condition
Warning:
`lift_lv()` was deprecated in purrr 1.0.0.
purrr/tests/testthat/_snaps/rate.md 0000644 0001762 0000144 00000002561 14462251446 017202 0 ustar ligges users # rates have print methods
Code
rate_delay(20, max_times = Inf)
Message
Attempts: 0/Inf
pause: 20
Code
rate_backoff()
Message
Attempts: 0/3
pause_base: 1
pause_cap: 60
pause_min: 1
# rate_delay() delays
Code
rate_sleep(rate)
Condition
Error in `rate_sleep()`:
! Request failed after 3 attempts.
---
Code
rate_sleep(rate)
Condition
Error in `rate_sleep()`:
! This `rate` object has already be run more than `max_times` allows.
i Do you need to reset it with `rate_reset()`?
# rate_backoff() backs off
Code
rate_sleep(rate)
Condition
Error in `rate_sleep()`:
! Request failed after 3 attempts.
---
Code
rate_sleep(rate)
Condition
Error in `rate_sleep()`:
! This `rate` object has already be run more than `max_times` allows.
i Do you need to reset it with `rate_reset()`?
# rate_sleep() checks that rate is still valid
Code
rate_sleep(rate)
Condition
Error in `rate_sleep()`:
! Request failed after 0 attempts.
---
Code
rate_sleep(rate)
Condition
Error in `rate_sleep()`:
! This `rate` object has already be run more than `max_times` allows.
i Do you need to reset it with `rate_reset()`?
purrr/tests/testthat/_snaps/adverb-slowly.md 0000644 0001762 0000144 00000000222 14462251440 021023 0 ustar ligges users # validates inputs
Code
slowly(mean, 10)
Condition
Error in `slowly()`:
! `rate` must be a rate object, not a number.
purrr/tests/testthat/_snaps/deprec-when.md 0000644 0001762 0000144 00000000255 14462251442 020442 0 ustar ligges users # when is deprecated
Code
. <- when(1:5 < 3 ~ 1, ~0)
Condition
Warning:
`when()` was deprecated in purrr 1.0.0.
i Please use `if` instead.
purrr/tests/testthat/_snaps/map-if-at.md 0000644 0001762 0000144 00000000346 14462251444 020017 0 ustar ligges users # map_if requires predicate functions
Code
map_if(1:3, ~NA, ~"foo")
Condition
Error in `map_if()`:
i In index: 1.
Caused by error:
! `.p()` must return a single `TRUE` or `FALSE`, not `NA`.
purrr/tests/testthat/_snaps/utils.md 0000644 0001762 0000144 00000003471 14462251447 017411 0 ustar ligges users # errors on invalid subsetting vectors
Code
where_at(x, c(FALSE, TRUE))
Condition
Error:
! Can't subset elements with `at`.
x Logical subscript `at` must be size 1 or 3, not 2.
Code
where_at(x, NA_real_)
Condition
Error:
! Can't subset elements.
x Subscript can't contain missing values.
x It has a missing value at location 1.
Code
where_at(x, 4)
Condition
Error:
! Can't subset elements past the end.
i Location 4 doesn't exist.
i There are only 3 elements.
# validates its inputs
Code
where_at(x, list())
Condition
Error:
! `list()` must be a numeric vector, character vector, or function, not an empty list.
# tidyselect `at` is deprecated
Code
. <- where_at(data.frame(x = 1), vars("x"), user_env = globalenv())
Condition
Warning:
Using `vars()` in .at was deprecated in purrr 1.0.0.
# pairlists, expressions, and calls are deprecated
Code
x <- vctrs_vec_compat(expression(1, 2), globalenv())
Condition
Warning:
Use of calls and pairlists in map functions was deprecated in purrr 1.0.0.
i Please coerce explicitly with `as.list()`
---
Code
x <- vctrs_vec_compat(pairlist(1, 2), globalenv())
Condition
Warning:
Use of pairlists in map functions was deprecated in purrr 1.0.0.
i Please coerce explicitly with `as.list()`
---
Code
x <- vctrs_vec_compat(quote(f(a, b = 1)), globalenv())
Condition
Warning:
Use of calls and pairlists in map functions was deprecated in purrr 1.0.0.
i Please coerce explicitly with `as.list()`
# can't work with regular S4 objects
Code
map(foo(), identity)
Condition
Error in `x[[i]]`:
! this S4 class is not subsettable
purrr/tests/testthat/_snaps/list-transpose.md 0000644 0001762 0000144 00000003441 14462251443 021231 0 ustar ligges users # integer template requires exact length of list() simplify etc
Code
list_transpose(x, ptype = list())
Condition
Error in `list_transpose()`:
! Can't convert `result[[1]][[1]]` to .
---
Code
list_transpose(x, ptype = list(integer()))
Condition
Error in `list_transpose()`:
! Length of `ptype` (1) and `template` (2) must be the same when transposing by position.
# simplification fails silently unless requested
Code
list_transpose(list(list(x = 1), list(x = "b")), simplify = TRUE)
Condition
Error in `list_transpose()`:
! Can't combine `result$x[[1]]` and `result$x[[2]]` .
Code
list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE)
Condition
Error in `list_transpose()`:
! `result$x[[2]]` must have size 1, not size 2.
# can supply `simplify` globally or individually
Code
list_transpose(x, simplify = list(c = FALSE))
Condition
Error in `list_transpose()`:
! `simplify` contains unknown names: "c".
# can supply `ptype` globally or individually
Code
list_transpose(x, ptype = list(c = integer()))
Condition
Error in `list_transpose()`:
! `ptype` contains unknown names: "c".
# can supply `default` globally or individually
Code
list_transpose(x, default = list(c = NA))
Condition
Error in `list_transpose()`:
! `default` contains unknown names: "c".
# validates inputs
Code
list_transpose(10)
Condition
Error in `list_transpose()`:
! `x` must be a list, not the number 10.
Code
list_transpose(list(1), template = mean)
Condition
Error in `list_transpose()`:
! `template` must be a character or numeric vector, not a function.
purrr/tests/testthat/_snaps/adverb-insistently.md 0000644 0001762 0000144 00000000420 14462251440 022057 0 ustar ligges users # insistently() resets rate state
Request failed after 0 attempts.
---
Request failed after 0 attempts.
# validates inputs
Code
insistently(mean, 10)
Condition
Error in `insistently()`:
! `rate` must be a rate object, not a number.
purrr/tests/testthat/_snaps/head-tail.md 0000644 0001762 0000144 00000000574 14462251442 020075 0 ustar ligges users # head_while and tail_while require predicate function
Code
head_while(1:3, ~NA)
Condition
Error in `head_while()`:
! `.p()` must return a single `TRUE` or `FALSE`, not `NA`.
---
Code
tail_while(1:3, ~ c(TRUE, FALSE))
Condition
Error in `tail_while()`:
! `.p()` must return a single `TRUE` or `FALSE`, not a logical vector.
purrr/tests/testthat/_snaps/deprec-invoke.md 0000644 0001762 0000144 00000002353 14462251441 020774 0 ustar ligges users # invoke_* is deprecated
Code
. <- invoke(identity, 1)
Condition
Warning:
`invoke()` was deprecated in purrr 1.0.0.
i Please use `exec()` instead.
Code
. <- invoke_map(identity, list())
Condition
Warning:
`invoke_map()` was deprecated in purrr 1.0.0.
i Please use map() + exec() instead.
Code
. <- invoke_map_lgl(identity, list())
Condition
Warning:
`invoke_lgl()` was deprecated in purrr 1.0.0.
i Please use map_lgl() + exec() instead.
Code
. <- invoke_map_int(identity, list())
Condition
Warning:
`invoke_int()` was deprecated in purrr 1.0.0.
i Please use map_int() + exec() instead.
Code
. <- invoke_map_dbl(identity, list())
Condition
Warning:
`invoke_dbl()` was deprecated in purrr 1.0.0.
i Please use map_dbl() + exec() instead.
Code
. <- invoke_map_chr(identity, list())
Condition
Warning:
`invoke_chr()` was deprecated in purrr 1.0.0.
i Please use map_chr() + exec() instead.
Code
. <- invoke_map_raw(identity, list())
Condition
Warning:
`invoke_raw()` was deprecated in purrr 1.0.0.
i Please use map_raw() + exec() instead.
purrr/tests/testthat/_snaps/adverb-auto-browse.md 0000644 0001762 0000144 00000000272 14462251440 021746 0 ustar ligges users # auto_browse() not intended for primitive functions
Code
auto_browse(log)(NULL)
Condition
Error in `auto_browse()`:
! `.f` must not be a primitive function.
purrr/tests/testthat/test-map-raw.R 0000644 0001762 0000144 00000001427 14331035447 017102 0 ustar ligges users test_that("_raw funtions are deprecated", {
expect_snapshot({
. <- map_raw(list(), ~ .x)
. <- map2_raw(list(), list(), ~ .x)
. <- imap_raw(list(), ~ .x)
. <- pmap_raw(list(), ~ .x)
. <- flatten_raw(list())
})
})
test_that("_raw functions still work", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(map_raw("a", charToRaw), charToRaw("a"))
expect_identical(map_raw(set_names(list()), identity), named(raw()))
expect_identical(map2_raw(set_names(list()), list(), identity), named(raw()))
expect_equal(imap_raw(as.raw(12), rawShift), rawShift(as.raw(12), 1) )
expect_bare(pmap_raw(list(1:3), as.raw), "raw")
expect_identical(pmap_raw(list(named(list())), identity), named(raw()))
expect_equal(flatten_raw(list(as.raw(1))), as.raw(1))
})
purrr/tests/testthat/test-detect.R 0000644 0001762 0000144 00000002475 14314671330 017010 0 ustar ligges users y <- 4:10
test_that("detect functions work", {
is_odd <- function(x) x %% 2 == 1
expect_equal(detect(y, is_odd), 5)
expect_equal(detect_index(y, is_odd), 2)
expect_equal(detect(y, is_odd, .dir = "backward"), 9)
expect_equal(detect_index(y, is_odd, .dir = "backward"), 6)
})
test_that("detect returns NULL when match not found", {
expect_null(detect(y, function(x) x > 11))
})
test_that("detect_index returns 0 when match not found", {
expect_equal(detect_index(y, function(x) x > 11), 0)
})
test_that("has_element checks whether a list contains an object", {
expect_true(has_element(list(1, 2), 1))
expect_false(has_element(list(1, 2), 3))
})
test_that("`detect()` requires a predicate function", {
expect_snapshot(detect(list(1:2, 2), is.na), error = TRUE)
expect_snapshot(detect_index(list(1:2, 2), is.na), error = TRUE)
})
# Lifecycle ---------------------------------------------------------------
test_that("`.right` argument is retired", {
expect_snapshot({
. <- detect(1:2, ~ TRUE, .right = TRUE)
. <- detect_index(1:2, ~ TRUE, .right = TRUE)
})
})
test_that("`.right` argument still works", {
local_options(lifecycle_verbosity = "quiet")
is_odd <- function(x) x %% 2 == 1
expect_equal(detect(y, is_odd, .right = TRUE), 9)
expect_equal(detect_index(y, is_odd, .right = TRUE), 6)
})
purrr/tests/testthat/test-list-modify.R 0000644 0001762 0000144 00000011723 14350157731 020000 0 ustar ligges users # list_assign -------------------------------------------------------------
test_that("can modify named lists by name or position", {
expect_equal(list_assign(list(a = 1), b = 2), list(a = 1, b = 2))
expect_equal(list_assign(list(a = 1), a = 2), list(a = 2))
expect_equal(list_assign(list(a = 1), a = NULL), list(a = NULL))
expect_equal(list_assign(list(a = 1, b = 2), b = zap()), list(a = 1))
expect_equal(list_assign(list(a = 1), 2), list(a = 2))
expect_equal(list_assign(list(a = 1, b = 2), zap()), list(b = 2))
})
test_that("can modify unnamed lists by name or position", {
expect_equal(list_assign(list(3), 1, 2), list(1, 2))
expect_equal(list_assign(list(3), NULL), list(NULL))
expect_equal(list_assign(list(3), zap()), list())
expect_equal(list_assign(list(3), zap(), zap()), list())
expect_equal(list_assign(list(1), a = 2), list(1, a = 2))
expect_equal(list_assign(list(1), a = NULL), list(1, a = NULL))
expect_equal(list_assign(list(1), a = zap()), list(1))
})
test_that("doesn't replace recursively", {
x <- list(y = list(a = 1))
expect_equal(list_assign(x, y = list(b = 1)), list(y = list(b = 1)))
})
# list_modify -------------------------------------------------------------
test_that("named lists have values replaced by name", {
expect_equal(list_modify(list(a = 1), b = 2), list(a = 1, b = 2))
expect_equal(list_modify(list(a = 1), a = 2), list(a = 2))
expect_equal(list_modify(list(a = 1), a = NULL), list(a = NULL))
expect_equal(list_modify(list(a = 1, b = 2), b = zap()), list(a = 1))
})
test_that("unnamed lists are replaced by position", {
expect_equal(list_modify(list(3), 1, 2), list(1, 2))
expect_equal(list_modify(list(3), NULL), list(NULL))
expect_equal(list_modify(list(3), zap()), list())
expect_equal(list_modify(list(3), zap(), zap()), list())
expect_equal(list_modify(list(1, 2, 3), 4), list(4, 2, 3))
})
test_that("can update unnamed lists with named inputs", {
expect_identical(list_modify(list(1), a = 2), list(1, a = 2))
expect_identical(list_modify(list(1), a = NULL), list(1, a = NULL))
expect_identical(list_modify(list(1), a = zap()), list(1))
})
test_that("can update named lists with unnamed inputs", {
expect_identical(list_modify(list(a = 1, b = 2), 2), list(a = 2, b = 2))
expect_identical(list_modify(list(a = 1, b = 2), zap()), list(b = 2))
expect_identical(list_modify(list(a = 1, b = 2), 2, 3, 4), list(a = 2, b = 3, 4))
})
test_that("lists are replaced recursively", {
expect_equal(
list_modify(
list(a = list(x = 1)),
a = list(x = 2),
),
list(a = list(x = 2))
)
expect_equal(
list_modify(
list(a = list(x = 1)),
a = list(y = 2)
),
list(a = list(x = 1, y = 2))
)
})
test_that("but data.frames are not", {
x1 <- list(x = data.frame(x = 1))
x2 <- list(x = data.frame(y = 2))
out <- list_modify(x1, !!!x2)
expect_equal(out, x2)
# unless you really want it
out <- list_modify(x1, !!!x2, .is_node = is.list)
expect_equal(out, list(x = data.frame(x = 1, y = 2)))
})
test_that("list_modify() validates inputs", {
expect_snapshot(list_modify(1:3), error = TRUE)
expect_snapshot(list_modify(list(a = 1), 2, a = 2), error = TRUE)
expect_snapshot(list_modify(list(x = 1), x = 2, x = 3), error = TRUE)
})
test_that("list_modify() preserves class & attributes", {
x <- structure(list(a = 1, b = 2), x = 10, class = "foo")
expect_equal(
list_modify(x, a = 10, b = 20),
structure(list(a = 10, b = 20), x = 10, class = "foo")
)
})
# list_merge --------------------------------------------------------------
test_that("list_merge concatenates values from two lists", {
l1 <- list(x = 1:10, y = 4, z = list(a = 1, b = 2))
l2 <- list(x = 11, z = list(a = 2:5, c = 3))
l <- list_merge(l1, !!! l2)
expect_equal(l$x, c(l1$x, l2$x))
expect_equal(l$y, c(l1$y, l2$y))
expect_equal(l$z$a, c(l1$z$a, l2$z$a))
expect_equal(l$z$b, c(l1$z$b, l2$z$b))
expect_equal(l$z$c, c(l1$z$c, l2$z$c))
})
test_that("list_merge concatenates without needing names", {
l1 <- list(1:10, 4, list(1, 2))
l2 <- list(11, 5, list(2:5, 3))
expect_length(list_merge(l1, !!! l2), 3)
})
test_that("list_merge returns the non-empty list", {
expect_equal(list_merge(list(3)), list(3))
expect_equal(list_merge(list(), 2), list(2))
})
test_that("merge() validates inputs", {
expect_snapshot(list_merge(1:3), error = TRUE)
expect_snapshot(list_merge(list(x = 1), x = 2, x = 3), error = TRUE)
})
# update_list ------------------------------------------------------------
test_that("update_list() is deprecated", {
expect_snapshot({
. <- update_list(list())
})
})
test_that("can modify element called x", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(update_list(list(), x = 1), list(x = 1))
})
test_that("quosures and formulas are evaluated", {
local_options(lifecycle_verbosity = "quiet")
expect_identical(update_list(list(x = 1), y = quo(x + 1)), list(x = 1, y = 2))
expect_identical(update_list(list(x = 1), y = ~x + 1), list(x = 1, y = 2))
})
purrr/tests/testthat/test-utils.R 0000644 0001762 0000144 00000007013 14350157731 016675 0 ustar ligges users # where_at ------------------------------------------------------------
test_that("allows valid logical, numeric, and character vectors", {
x <- list(a = 1, b = 1, c = 1)
expect_equal(where_at(x, TRUE), c(TRUE, TRUE, TRUE))
expect_equal(where_at(x, 1), c(TRUE, FALSE, FALSE))
expect_equal(where_at(x, -2), c(TRUE, FALSE, TRUE))
expect_equal(where_at(x, "b"), c(FALSE, TRUE, FALSE))
})
test_that("errors on invalid subsetting vectors", {
x <- list(a = 1, b = 1, c = 1)
expect_snapshot(error = TRUE, {
where_at(x, c(FALSE, TRUE))
where_at(x, NA_real_)
where_at(x, 4)
})
})
test_that("function at is passed names", {
x <- list(a = 1, B = 1, c = 1)
expect_equal(where_at(x, ~ .x %in% LETTERS), c(FALSE, TRUE, FALSE))
expect_equal(where_at(x, ~ intersect(.x, LETTERS)), c(FALSE, TRUE, FALSE))
})
test_that("where_at works with unnamed input", {
x <- list(1, 1, 1)
expect_equal(where_at(x, letters), rep(FALSE, 3))
expect_equal(where_at(x, ~ intersect(.x, LETTERS)), rep(FALSE, 3))
})
test_that("validates its inputs", {
x <- list(a = 1, b = 1, c = 1)
expect_snapshot(where_at(x, list()), error = TRUE)
})
test_that("tidyselect `at` is deprecated", {
expect_snapshot({
. <- where_at(data.frame(x = 1), vars("x"), user_env = globalenv())
})
})
# vctrs compat ------------------------------------------------------------
test_that("arrays become vectors (#970)", {
x <- matrix(1:4, nrow = 2)
expect_equal(vctrs_vec_compat(x, globalenv()), 1:4)
f <- factor(letters[1:4])
dim(f) <- c(2, 2, 1)
expect_equal(vctrs_vec_compat(f, globalenv()), factor(letters[1:4]))
})
test_that("pairlists, expressions, and calls are deprecated", {
expect_snapshot(x <- vctrs_vec_compat(expression(1, 2), globalenv()))
expect_equal(x, list(1, 2))
expect_snapshot(x <- vctrs_vec_compat(pairlist(1, 2), globalenv()))
expect_equal(x, list(1, 2))
expect_snapshot(x <- vctrs_vec_compat(quote(f(a, b = 1)), globalenv()))
expect_equal(x, list(quote(f), quote(a),b = 1))
})
test_that("can work with S4 vector objects", {
foo <- methods::setClass("foo1", contains = "list", where = current_env())
on.exit(methods::removeClass("foo1", where = current_env()), add = TRUE)
x1 <- foo(list(1, 2, 3))
expect_equal(map(x1, identity), list(1, 2, 3))
x2 <- foo(list(x = 1, y = 2, z = 3))
expect_equal(map(x2, identity), list(x = 1, y = 2, z = 3))
})
test_that("preserves names of 1d arrays", {
v <- array(list(1, 2), dim = 2, dimnames = list(c("a", "b")))
expect_equal(map_dbl(v, identity), c(a = 1, b = 2))
})
test_that("can work with output of by", {
df <- data.frame(x = 1:2)
# 1d keeps names
x <- by(df, c("a", "b"), function(df) df$x)
expect_equal(map_dbl(x, identity), c(a = 1, b = 2))
x <- by(df, c("a", "b"), function(df) df$x, simplify = FALSE)
expect_equal(map_dbl(x, identity), c(a = 1, b = 2))
# 2d loses names
x <- by(df, list(c("a", "b"), c("a", "b")), function(df) df$x)
expect_equal(map_dbl(x, identity), c(1, NA, NA, 2))
x <- by(df, list(c("a", "b"), c("a", "b")), function(df) df$x, simplify = FALSE)
expect_equal(map(x, identity), list(1, NULL, NULL, 2))
})
test_that("can work with lubridate periods", {
days <- lubridate::days(1:2)
expect_equal(map(days, identity), list(lubridate::days(1), lubridate::days(2)))
})
test_that("can't work with regular S4 objects", {
foo <- methods::setClass("foo", slots = list(a = "integer"), where = global_env())
on.exit(methods::removeClass("foo", where = global_env()), add = TRUE)
expect_snapshot(map(foo(), identity), error = TRUE)
})
purrr/tests/testthat/test-rate.R 0000644 0001762 0000144 00000004002 14310436312 016452 0 ustar ligges users test_that("new_rate() creates rate objects", {
rate <- new_rate("foo", jitter = FALSE, max_times = 10)
expect_identical(rate$state$i, 0L)
expect_identical(rate$max_times, 10)
expect_false(rate$jitter)
})
test_that("can bump and reset count", {
rate <- new_rate("foo")
rate_bump_count(rate)
rate_bump_count(rate)
expect_identical(rate_count(rate), 2L)
rate_reset(rate)
expect_identical(rate_count(rate), 0L)
})
test_that("rates have print methods", {
expect_snapshot({
# Also checks infinite `max_times` prints properly
rate_delay(20, max_times = Inf)
rate_backoff()
})
})
test_that("rate_delay() delays", {
rate <- rate_delay(
pause = 0.02,
max_times = 3
)
rate_sleep(rate, quiet = FALSE)
rate_reset(rate)
msg <- catch_cnd(rate_sleep(rate))
expect_true(inherits_all(msg, c("purrr_condition_rate_init", "condition")))
msg <- catch_cnd(rate_sleep(rate, quiet = FALSE))
expect_true(inherits_all(msg, c("purrr_message_rate_retry", "message")))
expect_identical(msg$length, 0.02)
msg <- catch_cnd(rate_sleep(rate, quiet = FALSE))
expect_identical(msg$length, 0.02)
expect_snapshot(rate_sleep(rate), error = TRUE)
expect_snapshot(rate_sleep(rate), error = TRUE)
})
test_that("rate_backoff() backs off", {
rate <- rate_backoff(
pause_base = 0.02,
pause_min = 0,
jitter = FALSE
)
msg <- catch_cnd(rate_sleep(rate))
expect_true(inherits_all(msg, c("purrr_condition_rate_init", "condition")))
msg <- catch_cnd(rate_sleep(rate, quiet = FALSE))
expect_true(inherits_all(msg, c("purrr_message_rate_retry", "message")))
expect_identical(msg$length, 0.04)
msg <- catch_cnd(rate_sleep(rate, quiet = FALSE))
expect_identical(msg$length, 0.08)
expect_snapshot(rate_sleep(rate), error = TRUE)
expect_snapshot(rate_sleep(rate), error = TRUE)
})
test_that("rate_sleep() checks that rate is still valid", {
rate <- rate_delay(1, max_times = 0)
expect_snapshot(rate_sleep(rate), error = TRUE)
expect_snapshot(rate_sleep(rate), error = TRUE)
})
purrr/tests/testthat/test-modify-tree.R 0000644 0001762 0000144 00000002012 14315046000 017736 0 ustar ligges users test_that("can modify leaves", {
expect_equal(
modify_tree(c(1, 1, 1), leaf = ~ .x + 9),
c(10, 10, 10)
)
expect_equal(
modify_tree(list(1, list(1, list(1))), leaf = ~ .x + 9),
list(10, list(10, list(10)))
)
})
test_that("can modify nodes", {
expect_equal(
modify_tree(list(1, list(2, list(3))), post = list_flatten),
list(1, 2, 3)
)
})
test_that("default doesn't recurse into data frames, but can customise", {
local_options(stringsAsFactors = FALSE)
x <- list(data.frame(x = 1), data.frame(y = 2))
expect_equal(
modify_tree(x, leaf = class),
list("data.frame", "data.frame")
)
expect_equal(
modify_tree(x, leaf = class, is_node = is.list),
list(data.frame(x = "numeric"), data.frame(y = "numeric"))
)
})
test_that("leaf() is applied to non-node input", {
expect_equal(modify_tree(1:3, leaf = identity), 1:3)
})
test_that("validates inputs", {
expect_snapshot(error = TRUE, {
modify_tree(list(), is_node = ~ 1)
modify_tree(list(), is_node = 1)
})
})
purrr/tests/testthat/test-deprec-splice.R 0000644 0001762 0000144 00000001171 14310436312 020242 0 ustar ligges users test_that("predicate controls which elements get spliced", {
x <- list(1, 2, list(3, 4))
expect_equal(splice_if(x, ~ FALSE), x)
expect_equal(splice_if(x, is.list), list(1, 2, 3, 4))
})
test_that("splice() produces correctly named lists", {
local_options(lifecycle_verbosity = "quiet")
inputs <- list(arg1 = "a", arg2 = "b")
out1 <- splice(inputs, arg3 = c("c1", "c2"))
expect_named(out1, c("arg1", "arg2", "arg3"))
out2 <- splice(inputs, arg = list(arg3 = 1, arg4 = 2))
expect_named(out2, c("arg1", "arg2", "arg3", "arg4"))
})
test_that("splice is deprecated", {
expect_snapshot({
. <- splice()
})
})
purrr/tests/testthat/test-deprec-map.R 0000644 0001762 0000144 00000000122 14326047403 017541 0 ustar ligges users test_that("at_depth is defunct", {
expect_snapshot(at_depth(), error = TRUE)
})
purrr/tests/testthat/test-conditions.R 0000644 0001762 0000144 00000002245 14310436312 017677 0 ustar ligges users test_that("stop_bad_type() constructs default `what`", {
expect_snapshot(stop_bad_type(NA, "`NULL`"), error = TRUE)
expect_snapshot(stop_bad_type(NA, "`NULL`", arg = ".foo"), error = TRUE)
expect_snapshot(stop_bad_type(NA, "`NULL`", arg = quote(.foo)), error = TRUE)
})
test_that("stop_bad_element_type() constructs type errors", {
expect_snapshot(stop_bad_element_type(1:3, 3, "a foobaz"), error = TRUE)
expect_snapshot(stop_bad_element_type(1:3, 3, "a foobaz", actual = "a quux"), error = TRUE)
expect_snapshot(stop_bad_element_type(1:3, 3, "a foobaz", arg = "..arg"), error = TRUE)
})
test_that("stop_bad_element_type() accepts `what`", {
expect_snapshot(stop_bad_element_type(1:3, 3, "a foobaz", what = "Result"), error = TRUE)
})
test_that("stop_bad_element_length() constructs error message", {
expect_snapshot(stop_bad_element_length(1:3, 8, 10), error = TRUE)
expect_snapshot(stop_bad_element_length(1:3, 8, 10, arg = ".foo"), error = TRUE)
expect_snapshot(stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result"), error = TRUE)
expect_snapshot(stop_bad_element_length(1:3, 8, 10, arg = ".foo", what = "Result", recycle = TRUE), error = TRUE)
})
purrr/tests/testthat/test-coerce.R 0000644 0001762 0000144 00000003245 14330525020 016764 0 ustar ligges users test_that("can coerce to logical vectors",{
expect_equal(coerce_lgl(c(TRUE, FALSE, NA)), c(TRUE, FALSE, NA))
expect_equal(coerce_lgl(c(1L, 0L, NA)), c(TRUE, FALSE, NA))
expect_error(coerce_lgl(2L), "Can't coerce")
expect_equal(coerce_lgl(c(1, 0, NA)), c(TRUE, FALSE, NA))
expect_error(coerce_lgl(1.5), "Can't coerce")
expect_error(coerce_lgl("true"), "Can't coerce")
})
test_that("can coerce to integer vectors", {
expect_identical(coerce_int(c(TRUE, FALSE, NA)), c(1L, 0L, NA))
expect_identical(coerce_int(c(NA, 1L, 10L)), c(NA, 1L, 10L))
expect_identical(coerce_int(c(NA, 1, 10)), c(NA, 1L, 10L))
expect_error(coerce_int(1.5), "Can't coerce")
expect_error(coerce_int("1"), "Can't coerce")
})
test_that("can coerce to double vctrs", {
expect_identical(coerce_dbl(c(TRUE, FALSE, NA)), c(1, 0, NA))
expect_identical(coerce_dbl(c(NA, 1L, 10L)), c(NA, 1, 10))
expect_identical(coerce_dbl(c(NA, 1.5)), c(NA, 1.5))
expect_error(coerce_dbl("1.5"), "Can't coerce")
})
test_that("can coerce to character vectors", {
expect_equal(coerce_chr(NA), NA_character_)
expect_snapshot({
expect_equal(coerce_chr(TRUE), "TRUE")
expect_equal(coerce_chr(1L), "1")
expect_equal(coerce_chr(1.5), "1.500000")
})
expect_equal(coerce_chr("x"), "x")
})
test_that("error captures correct env", {
indirect <- function() {
purrr::map_chr(1:4, identity)
}
environment(indirect) <- ns_env("rlang")
expect_snapshot({
map_chr(1:4, identity)
indirect()
})
})
test_that("warns once per vector", {
expect_warning(expect_warning(coerce_chr(1:5)), NA)
})
test_that("can't coerce to expressions", {
expect_error(coerce(list(1), "expression"))
})
purrr/tests/testthat/test-reduce.R 0000644 0001762 0000144 00000020022 14310436312 016766 0 ustar ligges users test_that("empty input returns init or error", {
expect_snapshot(reduce(list()), error = TRUE)
expect_equal(reduce(list(), `+`, .init = 0), 0)
})
test_that("first/value value used as first value", {
expect_equal(reduce(c(1, 1), `+`), 2)
expect_equal(reduce(c(1, 1), `+`, .init = 1), 3)
})
test_that("length 1 argument reduced with init", {
expect_equal(reduce(1, `+`, .init = 1), 2)
})
test_that("direction of reduce determines how generated trees lean", {
expect_identical(reduce(1:4, list), list(list(list(1L, 2L), 3L), 4L))
expect_identical(reduce(1:4, list, .dir = "backward"), list(1L, list(2L, list(3L, 4L))))
})
test_that("can shortcircuit reduction with done()", {
x <- c(TRUE, TRUE, FALSE, TRUE, TRUE)
out <- reduce(x, ~ if (.y) c(.x, "foo") else done(.x), .init = NULL)
expect_identical(out, c("foo", "foo"))
# Empty done box yields the same value as returning the
# result-so-far (the last value) in a done box
out2 <- reduce(x, ~ if (.y) c(.x, "foo") else done(), .init = NULL)
expect_identical(out2, out)
})
test_that("reduce() forces arguments (#643)", {
compose <- function(f, g) function(x) f(g(x))
expect_identical(reduce(list(identity, identity), compose)(1), 1)
})
# accumulate --------------------------------------------------------------
test_that("accumulate passes arguments to function", {
tt <- c("a", "b", "c")
expect_equal(accumulate(tt, paste, sep = "."), c("a", "a.b", "a.b.c"))
expect_equal(accumulate(tt, paste, sep = ".", .dir = "backward"), c("a.b.c", "b.c", "c"))
expect_equal(accumulate(tt, paste, sep = ".", .init = "z"), c("z", "z.a", "z.a.b", "z.a.b.c"))
expect_equal(accumulate(tt, paste, sep = ".", .dir = "backward", .init = "z"), c("a.b.c.z", "b.c.z", "c.z", "z"))
})
test_that("accumulate keeps input names", {
input <- set_names(1:26, letters)
expect_identical(accumulate(input, sum), set_names(cumsum(1:26), letters))
expect_identical(accumulate(input, sum, .dir = "backward"), set_names(rev(cumsum(rev(1:26))), rev(letters)))
})
test_that("accumulate keeps input names when init is supplied", {
expect_identical(accumulate(1:2, c, .init = 0L), list(0L, 0:1, 0:2))
expect_identical(accumulate(0:1, c, .init = 2L, .dir = "backward"), list(0:2, 1:2, 2L))
expect_identical(accumulate(c(a = 1L, b = 2L), c, .init = 0L), list(.init = 0L, a = 0:1, b = 0:2))
expect_identical(accumulate(c(a = 0L, b = 1L), c, .init = 2L, .dir = "backward"), list(b = 0:2, a = 1:2, .init = 2L))
})
test_that("can terminate accumulate() early", {
tt <- c("a", "b", "c")
paste2 <- function(x, y) {
out <- paste(x, y, sep = ".")
if (x == "b" || y == "b") {
done(out)
} else {
out
}
}
expect_equal(accumulate(tt, paste2), c("a", "a.b"))
expect_equal(accumulate(tt, paste2, .dir = "backward"), c("b.c", "c"))
expect_equal(accumulate(tt, paste2, .init = "z"), c("z", "z.a", "z.a.b"))
expect_equal(accumulate(tt, paste2, .dir = "backward", .init = "z"), c("b.c.z", "c.z", "z"))
})
test_that("can terminate accumulate() early with an empty box", {
tt <- c("a", "b", "c")
paste2 <- function(x, y) {
out <- paste(x, y, sep = ".")
if (x == "b" || y == "b") {
done()
} else {
out
}
}
expect_equal(accumulate(tt, paste2), "a")
expect_equal(accumulate(tt, paste2, .dir = "backward"), "c")
expect_equal(accumulate(tt, paste2, .init = "z"), c("z", "z.a"))
expect_equal(accumulate(tt, paste2, .dir = "backward", .init = "z"), c("c.z", "z"))
# Init value is always included, even if done at first iteration
expect_equal(accumulate(c("b", "c"), paste2), "b")
})
test_that("accumulate() forces arguments (#643)", {
compose <- function(f, g) function(x) f(g(x))
fns <- accumulate(list(identity, identity), compose)
expect_true(every(fns, function(f) identical(f(1), 1)))
})
test_that("accumulate() uses vctrs to simplify results", {
out <- list("foo", factor("bar")) %>% accumulate(~ .y)
expect_identical(out, c("foo", "bar"))
})
test_that("accumulate() does not fail when input can't be simplified", {
expect_identical(accumulate(list(1L, 2:3), ~ .y), list(1L, 2:3))
expect_identical(accumulate(list(1, "a"), ~ .y), list(1, "a"))
})
test_that("accumulate() does fail when simpification is required", {
expect_snapshot(accumulate(list(1, "a"), ~ .y, .simplify = TRUE), error = TRUE)
})
# reduce2 -----------------------------------------------------------------
test_that("basic application works", {
paste2 <- function(x, y, sep) paste(x, y, sep = sep)
x <- c("a", "b", "c")
expect_equal(reduce2(x, c("-", "."), paste2), "a-b.c")
expect_equal(reduce2(x, c(".", "-", "."), paste2, .init = "x"), "x.a-b.c")
})
test_that("requires equal length vectors", {
expect_snapshot(reduce2(1:3, 1, `+`), error = TRUE)
})
test_that("requires init if `.x` is empty", {
expect_snapshot(reduce2(list()), error = TRUE)
})
test_that("reduce returns original input if it was length one", {
x <- list(c(0, 1), c(2, 3), c(4, 5))
expect_equal(reduce(x[1], paste), x[[1]])
})
test_that("can shortcircuit reduce2() with done()", {
x <- c(TRUE, TRUE, FALSE, TRUE, TRUE)
out <- reduce2(x, 1:5, ~ if (.y) c(.x, "foo") else done(.x), .init = NULL)
expect_identical(out, c("foo", "foo"))
})
test_that("reduce2() forces arguments (#643)", {
compose <- function(f, g, ...) function(x) f(g(x))
fns <- reduce2(list(identity, identity), "foo", compose)
expect_identical(fns(1), 1)
})
# accumulate2 -------------------------------------------------------------
test_that("basic accumulate2() works", {
paste2 <- function(x, y, sep) paste(x, y, sep = sep)
x <- c("a", "b", "c")
expect_equal(accumulate2(x, c("-", "."), paste2), c("a", "a-b", "a-b.c"))
expect_equal(accumulate2(x, c(".", "-", "."), paste2, .init = "x"), c("x", "x.a", "x.a-b", "x.a-b.c"))
})
test_that("can terminate accumulate2() early", {
paste2 <- function(x, y, sep) {
out <- paste(x, y, sep = sep)
if (y == "b") {
done(out)
} else {
out
}
}
x <- c("a", "b", "c")
expect_equal(accumulate2(x, c("-", "."), paste2), c("a", "a-b"))
expect_equal(accumulate2(x, c(".", "-", "."), paste2, .init = "x"), c("x", "x.a", "x.a-b"))
})
test_that("accumulate2() forces arguments (#643)", {
compose <- function(f, g, ...) function(x) f(g(x))
fns <- accumulate2(list(identity, identity), "foo", compose)
expect_true(every(fns, function(f) identical(f(1), 1)))
})
# Life cycle --------------------------------------------------------------
test_that("right variants are retired", {
expect_snapshot({
. <- reduce_right(1:3, c)
. <- reduce2_right(1:3, 1:2, c)
. <- accumulate_right(1:3, c)
})
})
test_that("reduce_right still works", {
local_options(lifecycle_verbosity = "quiet")
expect_equal(reduce_right(c(1, 1), `+`), 2)
expect_equal(reduce_right(c(1, 1), `+`, .init = 1), 3)
expect_equal(reduce_right(1, `+`, .init = 1), 2)
})
test_that("reduce_right equivalent to reversing input", {
local_options(lifecycle_verbosity = "quiet")
x <- list(c(2, 1), c(4, 3), c(6, 5))
expect_equal(reduce_right(x, c), c(6, 5, 4, 3, 2, 1))
expect_equal(reduce_right(x, c, .init = 7), c(7, 6, 5, 4, 3, 2, 1))
})
test_that("reduce2_right still works", {
local_options(lifecycle_verbosity = "quiet")
paste2 <- function(x, y, sep) paste(x, y, sep = sep)
x <- c("a", "b", "c")
expect_equal(reduce2_right(x, c("-", "."), paste2), "c.b-a")
expect_equal(reduce2_right(x, c(".", "-", "."), paste2, .init = "x"), "x.c-b.a")
x <- list(c(0, 1), c(2, 3), c(4, 5))
y <- list(c(6, 7), c(8, 9))
expect_equal(reduce2_right(x, y, paste), c("4 2 8 0 6", "5 3 9 1 7"))
})
test_that("accumulate_right still works", {
local_options(lifecycle_verbosity = "quiet")
tt <- c("a", "b", "c")
expect_equal(accumulate_right(tt, paste, sep = "."), c("c.b.a", "c.b", "c"))
input <- set_names(1:26, letters)
expect_identical(accumulate_right(input, sum), set_names(rev(cumsum(rev(1:26))), rev(letters)))
expect_identical(accumulate_right(0:1, c, .init = 2L), list(2:0, 2:1, 2L))
expect_identical(accumulate_right(c(a = 0L, b = 1L), c, .init = 2L), list(b = 2:0, a = 2:1, .init = 2L))
})
purrr/tests/testthat/test-list-transpose.R 0000644 0001762 0000144 00000007137 14313364271 020531 0 ustar ligges users test_that("can transpose homogenous list", {
x <- list(x = list(a = 1, b = 2), y = list(a = 3, b = 4))
out <- list_transpose(x)
expect_equal(out, list(a = c(x = 1, y = 3), b = c(x = 2, y = 4)))
})
test_that("transposing empty list returns empty list", {
expect_equal(list_transpose(list()), list())
})
test_that("can use character template", {
x <- list(list(a = 1, b = 2), list(b = 3, c = 4))
# Default:
expect_equal(
list_transpose(x, default = NA),
list(a = c(1, NA), b = c(2, 3))
)
# Change order
expect_equal(
list_transpose(x, template = c("b", "a"), default = NA),
list(b = c(2, 3), a = c(1, NA))
)
# Remove
expect_equal(
list_transpose(x, template = "b", default = NA),
list(b = c(2, 3))
)
# Add
expect_equal(
list_transpose(x, template = c("a", "b", "c"), default = NA),
list(a = c(1, NA), b = c(2, 3), c = c(NA, 4))
)
})
test_that("can use integer template", {
x <- list(list(1, 2, 3), list(4, 5))
# Default:
expect_equal(
list_transpose(x, default = NA),
list(c(1, 4), c(2, 5), c(3, NA))
)
# Change order
expect_equal(
list_transpose(x, template = c(3, 2, 1), default = NA),
list(c(3, NA), c(2, 5), c(1, 4))
)
# Remove
expect_equal(
list_transpose(x, template = 2, default = NA),
list(c(2, 5))
)
# Add
expect_equal(
list_transpose(x, template = 1:4, default = NA),
list(c(1, 4), c(2, 5), c(3, NA), c(NA, NA))
)
})
test_that("integer template requires exact length of list() simplify etc", {
x <- list(list(1, 2), list(3, 4))
expect_snapshot(list_transpose(x, ptype = list()), error = TRUE)
expect_snapshot(list_transpose(x, ptype = list(integer())), error = TRUE)
expect_identical(
list_transpose(x, ptype = list(integer(), integer())),
list(c(1L, 3L), c(2L, 4L))
)
})
test_that("simplification fails silently unless requested", {
expect_equal(
list_transpose(list(list(x = 1), list(x = "b"))),
list(x = list(1, "b"))
)
expect_equal(
list_transpose(list(list(x = 1), list(x = 2:3))),
list(x = list(1, 2:3))
)
expect_snapshot(error = TRUE, {
list_transpose(list(list(x = 1), list(x = "b")), simplify = TRUE)
list_transpose(list(list(x = 1), list(x = 2:3)), simplify = TRUE)
})
})
test_that("can supply `simplify` globally or individually", {
x <- list(list(a = 1, b = 2), list(a = 3, b = 4))
expect_equal(
list_transpose(x, simplify = FALSE),
list(a = list(1, 3), b = list(2, 4))
)
expect_equal(
list_transpose(x, simplify = list(a = FALSE)),
list(a = list(1, 3), b = c(2, 4))
)
expect_snapshot(list_transpose(x, simplify = list(c = FALSE)), error = TRUE)
})
test_that("can supply `ptype` globally or individually", {
x <- list(list(a = 1, b = 2), list(a = 3, b = 4))
expect_identical(
list_transpose(x, ptype = integer()),
list(a = c(1L, 3L), b = c(2L, 4L))
)
expect_identical(
list_transpose(x, ptype = list(a = integer())),
list(a = c(1L, 3L), b = c(2, 4))
)
expect_snapshot(list_transpose(x, ptype = list(c = integer())), error = TRUE)
})
test_that("can supply `default` globally or individually", {
x <- list(list(x = 1), list(y = "a"))
expect_equal(
list_transpose(x, template = c("x", "y"), default = NA),
list(x = c(1, NA), y = c(NA, "a"))
)
expect_equal(
list_transpose(x, template = c("x", "y"), default = list(x = NA, y = "")),
list(x = c(1, NA), y = c("", "a"))
)
expect_snapshot(list_transpose(x, default = list(c = NA)), error = TRUE)
})
test_that("validates inputs", {
expect_snapshot(error = TRUE, {
list_transpose(10)
list_transpose(list(1), template = mean)
})
})
purrr/tests/testthat.R 0000644 0001762 0000144 00000000066 13630736102 014554 0 ustar ligges users library(testthat)
library(purrr)
test_check("purrr")
purrr/src/ 0000755 0001762 0000144 00000000000 14464464653 012233 5 ustar ligges users purrr/src/map.h 0000644 0001762 0000144 00000000721 14317567435 013160 0 ustar ligges users #ifndef MAP_H
#define MAP_H
extern "C" {
SEXP map_impl(SEXP env,
SEXP ffi_type,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i);
SEXP pmap_impl(SEXP env,
SEXP ffi_type,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i,
SEXP call_names,
SEXP ffi_call_n);
}
#endif
purrr/src/cleancall.c 0000644 0001762 0000144 00000010163 14355573666 014322 0 ustar ligges users #define R_NO_REMAP
#include
#include "cleancall.h"
#if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0))
SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot) {
fn_ptr ptr;
ptr.fn = p;
return R_MakeExternalPtr(ptr.p, tag, prot);
}
DL_FUNC R_ExternalPtrAddrFn(SEXP s) {
fn_ptr ptr;
ptr.p = R_ExternalPtrAddr(s);
return ptr.fn;
}
#endif
// The R API does not have a setter for function pointers
SEXP cleancall_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot) {
fn_ptr tmp;
tmp.fn = p;
return R_MakeExternalPtr(tmp.p, tag, prot);
}
void cleancall_SetExternalPtrAddrFn(SEXP s, DL_FUNC p) {
fn_ptr ptr;
ptr.fn = p;
R_SetExternalPtrAddr(s, ptr.p);
}
// Initialised at load time with the `.Call` primitive
SEXP cleancall_fns_dot_call = NULL;
static SEXP callbacks = NULL;
void cleancall_init(void) {
cleancall_fns_dot_call = Rf_findVar(Rf_install(".Call"), R_BaseEnv);
callbacks = R_NilValue;
}
struct eval_args {
SEXP call;
SEXP env;
};
static SEXP eval_wrap(void* data) {
struct eval_args* args = (struct eval_args*) data;
return Rf_eval(args->call, args->env);
}
SEXP cleancall_call(SEXP args, SEXP env) {
SEXP call = PROTECT(Rf_lcons(cleancall_fns_dot_call, args));
struct eval_args data = { call, env };
SEXP out = r_with_cleanup_context(&eval_wrap, &data);
UNPROTECT(1);
return out;
}
// Preallocate a callback
static void push_callback(SEXP stack) {
SEXP top = CDR(stack);
SEXP early_handler = PROTECT(Rf_allocVector(LGLSXP, 1));
SEXP fn_extptr = PROTECT(cleancall_MakeExternalPtrFn(NULL, R_NilValue,
R_NilValue));
SEXP data_extptr = PROTECT(R_MakeExternalPtr(NULL, early_handler,
R_NilValue));
SEXP cb = Rf_cons(Rf_cons(fn_extptr, data_extptr), top);
SETCDR(stack, cb);
UNPROTECT(3);
}
struct data_wrapper {
SEXP (*fn)(void* data);
void *data;
SEXP callbacks;
int success;
};
static void call_exits(void* data) {
// Remove protecting node. Don't remove the preallocated callback on
// the top as it might contain a handler when something went wrong.
SEXP top = CDR(callbacks);
// Restore old stack
struct data_wrapper* state = data;
callbacks = (SEXP) state->callbacks;
// Handlers should not jump
while (top != R_NilValue) {
SEXP cb = CAR(top);
top = CDR(top);
void (*fn)(void*) = (void (*)(void*)) R_ExternalPtrAddrFn(CAR(cb));
void *data = (void*) R_ExternalPtrAddr(CDR(cb));
int early_handler = LOGICAL(R_ExternalPtrTag(CDR(cb)))[0];
// Check for empty pointer in preallocated callbacks
if (fn) {
if (!early_handler || !state->success) fn(data);
}
}
}
static SEXP with_cleanup_context_wrap(void *data) {
struct data_wrapper* cdata = data;
SEXP ret = cdata->fn(cdata->data);
cdata->success = 1;
return ret;
}
SEXP r_with_cleanup_context(SEXP (*fn)(void* data), void* data) {
// Preallocate new stack before changing `callbacks` to avoid
// leaving the global variable in a bad state if alloc fails
SEXP new = PROTECT(Rf_cons(R_NilValue, R_NilValue));
push_callback(new);
SEXP old = callbacks;
callbacks = new;
struct data_wrapper state = { fn, data, old, 0 };
SEXP out = R_ExecWithCleanup(with_cleanup_context_wrap, &state,
&call_exits, &state);
UNPROTECT(1);
return out;
}
static void call_save_handler(void (*fn)(void *data), void* data,
int early) {
if (Rf_isNull(callbacks)) {
fn(data);
Rf_error("Internal error: Exit handler pushed outside "
"of an exit context");
}
SEXP cb = CADR(callbacks);
// Update pointers
cleancall_SetExternalPtrAddrFn(CAR(cb), (DL_FUNC) fn);
R_SetExternalPtrAddr(CDR(cb), data);
LOGICAL(R_ExternalPtrTag(CDR(cb)))[0] = early;
// Preallocate the next callback in case the allocator jumps
push_callback(callbacks);
}
void r_call_on_exit(void (*fn)(void* data), void* data) {
call_save_handler(fn, data, /* early = */ 0);
}
void r_call_on_early_exit(void (*fn)(void* data), void* data) {
call_save_handler(fn, data, /* early = */ 1);
}
purrr/src/flatten.c 0000644 0001762 0000144 00000007276 14311066210 014022 0 ustar ligges users #define R_NO_REMAP
#include
#include
#include "coerce.h"
#include "conditions.h"
#include "utils.h"
const char* objtype(SEXP x) {
return Rf_type2char(TYPEOF(x));
}
SEXP flatten_impl(SEXP x) {
if (TYPEOF(x) != VECSXP) {
stop_bad_type(x, "a list", NULL, ".x");
}
int m = Rf_length(x);
// Determine output size and check type
int n = 0;
int has_names = 0;
SEXP x_names = PROTECT(Rf_getAttrib(x, R_NamesSymbol));
for (int j = 0; j < m; ++j) {
SEXP x_j = VECTOR_ELT(x, j);
if (!is_vector(x_j) && x_j != R_NilValue) {
stop_bad_element_type(x_j, j + 1, "a vector", NULL, ".x");
}
n += Rf_length(x_j);
if (!has_names) {
if (!Rf_isNull(Rf_getAttrib(x_j, R_NamesSymbol))) {
// Sub-element is named
has_names = 1;
} else if (Rf_length(x_j) == 1 && !Rf_isNull(x_names)) {
// Element is a "scalar" and has name in parent
SEXP name = STRING_ELT(x_names, j);
if (name != NA_STRING && strcmp(CHAR(name), "") != 0)
has_names = 1;
}
}
}
SEXP out = PROTECT(Rf_allocVector(VECSXP, n));
SEXP names = PROTECT(Rf_allocVector(STRSXP, n));
if (has_names)
Rf_setAttrib(out, R_NamesSymbol, names);
int i = 0;
for (int j = 0; j < m; ++j) {
SEXP x_j = VECTOR_ELT(x, j);
int n_j = Rf_length(x_j);
SEXP names_j = PROTECT(Rf_getAttrib(x_j, R_NamesSymbol));
int has_names_j = !Rf_isNull(names_j);
for (int k = 0; k < n_j; ++k, ++i) {
switch(TYPEOF(x_j)) {
case LGLSXP: SET_VECTOR_ELT(out, i, Rf_ScalarLogical(LOGICAL(x_j)[k])); break;
case INTSXP: SET_VECTOR_ELT(out, i, Rf_ScalarInteger(INTEGER(x_j)[k])); break;
case REALSXP: SET_VECTOR_ELT(out, i, Rf_ScalarReal(REAL(x_j)[k])); break;
case CPLXSXP: SET_VECTOR_ELT(out, i, Rf_ScalarComplex(COMPLEX(x_j)[k])); break;
case STRSXP: SET_VECTOR_ELT(out, i, Rf_ScalarString(STRING_ELT(x_j, k))); break;
case RAWSXP: SET_VECTOR_ELT(out, i, Rf_ScalarRaw(RAW(x_j)[k])); break;
case VECSXP: SET_VECTOR_ELT(out, i, VECTOR_ELT(x_j, k)); break;
default:
Rf_error("Internal error: `flatten_impl()` should have failed earlier");
}
if (has_names) {
if (has_names_j) {
SET_STRING_ELT(names, i, has_names_j ? STRING_ELT(names_j, k) : Rf_mkChar(""));
} else if (n_j == 1) {
SET_STRING_ELT(names, i, !Rf_isNull(x_names) ? STRING_ELT(x_names, j) : Rf_mkChar(""));
}
}
if (i % 1024 == 0)
R_CheckUserInterrupt();
}
UNPROTECT(1);
}
UNPROTECT(3);
return out;
}
SEXP vflatten_impl(SEXP x, SEXP type_) {
if (TYPEOF(x) != VECSXP) {
stop_bad_type(x, "a list", NULL, ".x");
}
int m = Rf_length(x);
SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_)));
// Determine output size and type
int n = 0;
int has_names = 0;
for (int j = 0; j < m; ++j) {
SEXP x_j = VECTOR_ELT(x, j);
n += Rf_length(x_j);
if (!has_names && !Rf_isNull(Rf_getAttrib(x_j, R_NamesSymbol))) {
has_names = 1;
}
}
SEXP out = PROTECT(Rf_allocVector(type, n));
SEXP names = PROTECT(Rf_allocVector(STRSXP, n));
if (has_names)
Rf_setAttrib(out, R_NamesSymbol, names);
UNPROTECT(1);
int i = 0;
for (int j = 0; j < m; ++j) {
SEXP x_j = VECTOR_ELT(x, j);
int n_j = Rf_length(x_j);
SEXP names_j = PROTECT(Rf_getAttrib(x_j, R_NamesSymbol));
int has_names_j = !Rf_isNull(names_j);
for (int k = 0; k < n_j; ++k, ++i) {
set_vector_value(out, i, x_j, k);
if (has_names)
SET_STRING_ELT(names, i, has_names_j ? STRING_ELT(names_j, k) : Rf_mkChar(""));
if (i % 1024 == 0)
R_CheckUserInterrupt();
}
UNPROTECT(1);
}
UNPROTECT(1);
return out;
}
purrr/src/backports.h 0000644 0001762 0000144 00000000245 14304371054 014356 0 ustar ligges users #ifndef BACKPORTS_H
#define BACKPORTS_H
#include
#if defined(R_VERSION) && R_VERSION < R_Version(3, 2, 0)
SEXP Rf_installChar(SEXP x);
#endif
#endif
purrr/src/backports.c 0000644 0001762 0000144 00000000317 14304371054 014351 0 ustar ligges users #define R_NO_REMAP
#include
#include
#include
#if defined(R_VERSION) && R_VERSION < R_Version(3, 2, 0)
SEXP Rf_installChar(SEXP x) {
return Rf_install(CHAR(x));
}
#endif
purrr/src/init.c 0000644 0001762 0000144 00000002711 14355573666 013347 0 ustar ligges users #include
#include
#include // for NULL
#include
// Compile with `-fvisibility=hidden -DHAVE_VISIBILITY_ATTRIBUTE` if you link to this library
#include
#define export attribute_visible extern
#include "cleancall.h"
/* .Call calls */
extern SEXP coerce_impl(SEXP, SEXP);
extern SEXP pluck_impl(SEXP, SEXP, SEXP, SEXP);
extern SEXP flatten_impl(SEXP);
extern SEXP map_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP map2_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP pmap_impl(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
extern SEXP transpose_impl(SEXP, SEXP);
extern SEXP vflatten_impl(SEXP, SEXP);
static const R_CallMethodDef CallEntries[] = {
CLEANCALL_METHOD_RECORD,
{"coerce_impl", (DL_FUNC) &coerce_impl, 2},
{"pluck_impl", (DL_FUNC) &pluck_impl, 4},
{"flatten_impl", (DL_FUNC) &flatten_impl, 1},
{"map_impl", (DL_FUNC) &map_impl, 6},
{"map2_impl", (DL_FUNC) &map2_impl, 6},
{"pmap_impl", (DL_FUNC) &pmap_impl, 8},
{"transpose_impl", (DL_FUNC) &transpose_impl, 2},
{"vflatten_impl", (DL_FUNC) &vflatten_impl, 2},
{"purrr_eval", (DL_FUNC) &Rf_eval, 2},
{NULL, NULL, 0}
};
export void R_init_purrr(DllInfo *dll)
{
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
cleancall_init();
}
purrr/src/utils.c 0000644 0001762 0000144 00000002133 14317567435 013535 0 ustar ligges users #define R_NO_REMAP
#include
#include
SEXP sym_protect(SEXP x) {
if (TYPEOF(x) == LANGSXP || TYPEOF(x) == SYMSXP) {
SEXP quote_prim = Rf_eval(Rf_install("quote"), R_BaseEnv);
return(Rf_lang2(quote_prim, x));
} else {
return x;
}
}
bool is_vector(SEXP x) {
switch (TYPEOF(x)) {
case LGLSXP:
case INTSXP:
case REALSXP:
case CPLXSXP:
case STRSXP:
case RAWSXP:
case VECSXP:
return true;
default:
return false;
}
}
SEXP list6(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x) {
PROTECT(s);
s = Rf_cons(s, Rf_list5(t, u, v, w, x));
UNPROTECT(1);
return s;
}
SEXP lang7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y) {
PROTECT(s);
s = Rf_lcons(s, list6(t, u, v, w, x, y));
UNPROTECT(1);
return s;
}
SEXP list7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y) {
PROTECT(s);
s = Rf_cons(s, list6(t, u, v, w, x, y));
UNPROTECT(1);
return s;
}
SEXP lang8(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y, SEXP z) {
PROTECT(s);
s = Rf_lcons(s, list7(t, u, v, w, x, y, z));
UNPROTECT(1);
return s;
}
purrr/src/coerce.c 0000644 0001762 0000144 00000011111 14462253072 013617 0 ustar ligges users #define R_NO_REMAP
#include
#include
#include
#include "conditions.h"
void cant_coerce(SEXP from, SEXP to, int i) {
const char* to_friendly;
switch(TYPEOF(to)) {
case INTSXP:
to_friendly = "an integer";
break;
case REALSXP:
to_friendly = "a double";
break;
case STRSXP:
to_friendly = "a string";
break;
case LGLSXP:
to_friendly = "a logical";
break;
case RAWSXP:
to_friendly = "a raw vector";
break;
default:
to_friendly = Rf_type2char(TYPEOF(to));
}
Rf_errorcall(
R_NilValue,
"Can't coerce from %s to %s.",
rlang_obj_type_friendly_full(from, false, false),
to_friendly
);
}
int real_to_logical(double x, SEXP from, SEXP to, int i) {
if (R_IsNA(x)) {
return NA_LOGICAL;
} else if (x == 0) {
return 0;
} else if (x == 1) {
return 1;
} else {
cant_coerce(from, to, i);
return 0;
}
}
int real_to_integer(double x, SEXP from, SEXP to, int i) {
if (R_IsNA(x)) {
return NA_INTEGER;
}
int out = x;
if (out == x) {
return out;
} else {
cant_coerce(from, to, i);
return 0;
}
}
int integer_to_logical(double x, SEXP from, SEXP to, int i) {
if (x == NA_INTEGER) {
return NA_LOGICAL;
} else if (x == 0) {
return 0;
} else if (x == 1) {
return 1;
} else {
cant_coerce(from, to, i);
return 0;
}
}
double logical_to_real(int x) {
return (x == NA_LOGICAL) ? NA_REAL : x;
}
double integer_to_real(int x) {
return (x == NA_INTEGER) ? NA_REAL : x;
}
void deprecate_to_char(const char* type_char) {
SEXP type = PROTECT(Rf_mkString(type_char));
SEXP fun = PROTECT(Rf_lang3(Rf_install(":::"), Rf_install("purrr"), Rf_install("deprecate_to_char")));
SEXP call = PROTECT(Rf_lang2(fun, type));
Rf_eval(call, R_GlobalEnv);
UNPROTECT(3);
}
SEXP logical_to_char(int x, SEXP from, SEXP to, int i) {
if (x == NA_LOGICAL) {
return NA_STRING;
} else {
if (i == 0)
deprecate_to_char("logical");
return Rf_mkChar(x ? "TRUE" : "FALSE");
}
}
SEXP integer_to_char(int x, int i) {
if (i == 0)
deprecate_to_char("integer");
if (x == NA_INTEGER)
return NA_STRING;
char buf[100];
snprintf(buf, 100, "%d", x);
return Rf_mkChar(buf);
}
SEXP double_to_char(double x, int i) {
if (i == 0)
deprecate_to_char("double");
if (!R_finite(x)) {
if (R_IsNA(x)) {
return NA_STRING;
} else if (R_IsNaN(x)) {
return Rf_mkChar("NaN");
} else if (x > 0) {
return Rf_mkChar("Inf");
} else {
return Rf_mkChar("-Inf");
}
}
char buf[100];
snprintf(buf, 100, "%f", x);
return Rf_mkChar(buf);
}
void set_vector_value(SEXP to, int i, SEXP from, int j) {
switch(TYPEOF(to)) {
case LGLSXP:
switch(TYPEOF(from)) {
case LGLSXP: LOGICAL(to)[i] = LOGICAL(from)[j]; break;
case INTSXP: LOGICAL(to)[i] = integer_to_logical(INTEGER(from)[j], from, to, i); break;
case REALSXP: LOGICAL(to)[i] = real_to_logical(REAL(from)[j], from, to, i); break;
default: cant_coerce(from, to, i);
}
break;
case INTSXP:
switch(TYPEOF(from)) {
case LGLSXP: INTEGER(to)[i] = LOGICAL(from)[j]; break;
case INTSXP: INTEGER(to)[i] = INTEGER(from)[j]; break;
case REALSXP: INTEGER(to)[i] = real_to_integer(REAL(from)[j], from, to, i); break;
default: cant_coerce(from, to, i);
}
break;
case REALSXP:
switch(TYPEOF(from)) {
case LGLSXP: REAL(to)[i] = logical_to_real(LOGICAL(from)[j]); break;
case INTSXP: REAL(to)[i] = integer_to_real(INTEGER(from)[j]); break;
case REALSXP: REAL(to)[i] = REAL(from)[j]; break;
default: cant_coerce(from, to, i);
}
break;
case STRSXP:
switch(TYPEOF(from)) {
case LGLSXP: SET_STRING_ELT(to, i, logical_to_char(LOGICAL(from)[j], from, to, i)); break;
case INTSXP: SET_STRING_ELT(to, i, integer_to_char(INTEGER(from)[j], i)); break;
case REALSXP: SET_STRING_ELT(to, i, double_to_char(REAL(from)[j], i)); break;
case STRSXP: SET_STRING_ELT(to, i, STRING_ELT(from, j)); break;
default: cant_coerce(from, to, i);
}
break;
case VECSXP:
SET_VECTOR_ELT(to, i, from);
break;
case RAWSXP:
switch(TYPEOF(from)) {
case RAWSXP: RAW(to)[i] = RAW(from)[j]; break;
default: cant_coerce(from, to, i);
}
break ;
default: cant_coerce(from, to, i);
}
}
SEXP coerce_impl(SEXP x, SEXP type_) {
int n = Rf_length(x);
SEXPTYPE type = Rf_str2type(CHAR(Rf_asChar(type_)));
SEXP out = PROTECT(Rf_allocVector(type, n));
for (int i = 0; i < n; ++i) {
set_vector_value(out, i, x, i);
}
UNPROTECT(1);
return out;
}
purrr/src/pluck.c 0000644 0001762 0000144 00000023003 14311066210 013465 0 ustar ligges users #define R_NO_REMAP
#include
#include
#include
#include
#include "backports.h"
#include "coerce.h"
#include "conditions.h"
static int check_double_index_finiteness(double val, SEXP index, int i, bool strict);
static int check_double_index_length(double val, int n, int i, bool strict);
static int check_character_index(SEXP string, int i, bool strict);
static int check_names(SEXP names, int i, bool strict);
static int check_unbound_value(SEXP val, SEXP index_i, bool strict);
static int check_s4_slot(SEXP val, SEXP index_i, bool strict);
static int check_obj_length(SEXP n, bool strict);
int obj_length(SEXP x, bool strict);
SEXP obj_names(SEXP x, bool strict);
// S3 objects must implement a `length()` method in the case of a
// numeric index and a `names()` method for the character case
int find_offset(SEXP x, SEXP index, int i, bool strict) {
int n = obj_length(x, strict);
if (n < 0) {
return -1;
}
int index_n = Rf_length(index);
if (index_n != 1) {
stop_bad_element_length(index, i + 1, 1, "Index", NULL, false);
}
switch (TYPEOF(index)) {
case INTSXP:
case REALSXP: {
int n_protect = 0;
double val;
if (TYPEOF(index) == INTSXP) {
// Coerce instead of cast to standardise missing value
index = PROTECT(Rf_coerceVector(index, REALSXP));
++n_protect;
}
val = REAL(index)[0];
if (check_double_index_finiteness(val, index, i, strict)) {
goto numeric_index_error;
}
if (val < 0) {
val = n + val + 1;
}
if (check_double_index_length(val, n, i, strict)) {
goto numeric_index_error;
}
UNPROTECT(n_protect);
return val - 1;
numeric_index_error:
UNPROTECT(n_protect);
return -1;
}
case STRSXP: {
// Protection is needed because names could be generated in the S3 case
SEXP names = PROTECT(obj_names(x, strict));
if (check_names(names, i, strict)) {
UNPROTECT(1);
return -1;
}
SEXP string = STRING_ELT(index, 0);
if (check_character_index(string, i, strict)) {
UNPROTECT(1);
return -1;
}
const char* val = Rf_translateCharUTF8(string);
int n_names = Rf_length(names);
for (int j = 0; j < n_names; ++j) {
if (STRING_ELT(names, j) == NA_STRING) {
continue;
}
const char* names_j = Rf_translateCharUTF8(STRING_ELT(names, j));
if (strcmp(names_j, val) == 0) {
UNPROTECT(1);
return j;
}
}
if (strict) {
r_abort("Can't find name `%s` in vector.", val);
} else {
UNPROTECT(1);
return -1;
}
}
default:
stop_bad_element_type(index, i + 1, "a character or numeric vector", "Index", NULL);
}
}
SEXP extract_vector(SEXP x, SEXP index_i, int i, bool strict) {
int offset = find_offset(x, index_i, i, strict);
if (offset < 0) {
return R_NilValue;
}
if (OBJECT(x)) {
// We check `offset` pass the original index to support unordered
// vector classes
SEXP extract_call = PROTECT(Rf_lang3(Rf_install("[["), x, index_i));
SEXP out = Rf_eval(extract_call, R_GlobalEnv);
UNPROTECT(1);
return out;
}
switch (TYPEOF(x)) {
case LGLSXP: return Rf_ScalarLogical(LOGICAL(x)[offset]);
case INTSXP: return Rf_ScalarInteger(INTEGER(x)[offset]);
case REALSXP: return Rf_ScalarReal(REAL(x)[offset]);
case STRSXP: return Rf_ScalarString(STRING_ELT(x, offset));
case VECSXP: return VECTOR_ELT(x, offset);
case RAWSXP: return Rf_ScalarRaw(RAW(x)[offset]) ;
case CPLXSXP: return Rf_ScalarComplex(COMPLEX_ELT(x, offset));
default:
r_abort(
"Internal error: found in extract_vector()",
Rf_type2char(TYPEOF(x))
);
}
return R_NilValue;
}
SEXP extract_env(SEXP x, SEXP index_i, int i, bool strict) {
if (TYPEOF(index_i) != STRSXP) {
stop_bad_element_type(index_i, i + 1, "a string", "Index", NULL);
}
if (Rf_length(index_i) != 1) {
stop_bad_element_length(index_i, i + 1, 1, "Index", NULL, false);
}
SEXP index = STRING_ELT(index_i, 0);
if (check_character_index(index, i, strict)) {
return R_NilValue;
}
SEXP sym = Rf_installChar(index);
SEXP out = Rf_findVarInFrame3(x, sym, TRUE);
if (check_unbound_value(out, index_i, strict)) {
return R_NilValue;
}
return out;
}
SEXP extract_s4(SEXP x, SEXP index_i, int i, bool strict) {
if (TYPEOF(index_i) != STRSXP) {
stop_bad_element_type(index_i, i + 1, "a string", "Index", NULL);
}
if (Rf_length(index_i) != 1) {
stop_bad_element_length(index_i, i + 1, 1, "Index", NULL, false);
}
SEXP index = STRING_ELT(index_i, 0);
if (check_character_index(index, i, strict)) {
return R_NilValue;
}
if (check_s4_slot(x, index_i, strict)) {
return R_NilValue;
}
SEXP sym = Rf_installChar(index);
return Rf_getAttrib(x, sym);
}
SEXP extract_fn(SEXP x, SEXP clo) {
SEXP expr = PROTECT(Rf_lang2(clo, x));
SEXP out = Rf_eval(expr, R_GlobalEnv);
UNPROTECT(1);
return out;
}
static bool is_function(SEXP x) {
switch (TYPEOF(x)) {
case CLOSXP:
case BUILTINSXP:
case SPECIALSXP:
return true;
default:
return false;
}
}
SEXP pluck_impl(SEXP x, SEXP index, SEXP missing, SEXP strict_arg) {
if (TYPEOF(index) != VECSXP) {
stop_bad_type(index, "a list", NULL, "where");
}
PROTECT_INDEX idx;
PROTECT_WITH_INDEX(x, &idx);
int n = Rf_length(index);
bool strict = Rf_asLogical(strict_arg);
for (int i = 0; i < n; ++i) {
SEXP index_i = VECTOR_ELT(index, i);
if (is_function(index_i)) {
x = extract_fn(x, index_i);
REPROTECT(x, idx);
continue;
}
// Assume all S3 objects implement the vector interface
if (OBJECT(x) && TYPEOF(x) != S4SXP) {
x = extract_vector(x, index_i, i, strict);
REPROTECT(x, idx);
continue;
}
switch (TYPEOF(x)) {
case NILSXP:
if (strict) {
r_abort("Can't pluck from NULL at level %d.", i + 1);
}
find_offset(x, index_i, i, strict);
// Leave the indexing loop early
goto end;
case LGLSXP:
case INTSXP:
case REALSXP:
case CPLXSXP:
case STRSXP:
case RAWSXP:
case VECSXP:
x = extract_vector(x, index_i, i, strict);
REPROTECT(x, idx);
break;
case ENVSXP:
x = extract_env(x, index_i, i, strict);
REPROTECT(x, idx);
break;
case S4SXP:
x = extract_s4(x, index_i, i, strict);
REPROTECT(x, idx);
break;
default:
r_abort(
"Can't pluck from %s at level %d.",
rlang_obj_type_friendly_full(x, true, false), i + 1
);
}
}
end:
UNPROTECT(1);
return x == R_NilValue ? missing : x;
}
/* Type checking */
static int check_double_index_finiteness(double val, SEXP index, int i, bool strict) {
if (R_finite(val)) {
return 0;
}
if (strict) {
r_abort(
"Index %d must be finite, not %s.",
i + 1, Rf_translateCharUTF8(Rf_asChar(index))
);
} else {
return -1;
}
}
static int check_double_index_length(double val, int n, int i, bool strict) {
if (val == 0) {
if (strict) {
r_abort("Index %d is zero.", i + 1);
} else {
return -1;
}
} else if (val < 0) {
if (strict) {
// Negative values have already been subtracted from end
r_abort(
"Negative index %d must be greater than or equal to %d, not %.0f.",
i + 1, -n, val - n - 1
);
} else {
return -1;
}
} else if (val > n) {
if (strict) {
r_abort(
"Index %d exceeds the length of plucked object (%.0f > %d).",
i + 1, val, n
);
} else {
return -1;
}
}
return 0;
}
static int check_character_index(SEXP string, int i, bool strict) {
if (string == NA_STRING) {
if (strict) {
r_abort("Index %d can't be NA.", i + 1);
} else {
return -1;
}
}
// "" matches nothing
const char* val = CHAR(string);
if (val[0] == '\0') {
if (strict) {
r_abort("Index %d can't be an empty string (\"\").", i + 1);
} else {
return -1;
}
}
return 0;
}
static int check_names(SEXP names, int i, bool strict) {
if (TYPEOF(names) == STRSXP) {
return 0;
}
if (strict) {
r_abort("Index %d is attempting to pluck from an unnamed vector using a string name.", i + 1);
} else {
return -1;
}
}
static int check_unbound_value(SEXP val, SEXP index_i, bool strict) {
if (val != R_UnboundValue) {
return 0;
}
if (strict) {
r_abort(
"Can't find object `%s` in environment.",
Rf_translateCharUTF8(Rf_asChar(index_i))
);
} else {
return -1;
}
}
static int check_s4_slot(SEXP val, SEXP index_i, bool strict) {
if (R_has_slot(val, index_i)) {
return 0;
}
if (strict) {
r_abort(
"Can't find slot `%s`.",
Rf_translateCharUTF8(Rf_asChar(index_i))
);
} else {
return -1;
}
}
static int check_obj_length(SEXP n, bool strict) {
if (TYPEOF(n) != INTSXP || Rf_length(n) != 1) {
if (strict) {
r_abort("Length of S3 object must be a scalar integer.");
} else {
return -1;
}
}
return 0;
}
int obj_length(SEXP x, bool strict) {
if (!OBJECT(x)) {
return Rf_length(x);
}
SEXP length_call = PROTECT(Rf_lang2(Rf_install("length"), x));
SEXP n = PROTECT(Rf_eval(length_call, R_GlobalEnv));
if (check_obj_length(n, strict)) {
UNPROTECT(2);
return -1;
}
UNPROTECT(2);
return INTEGER(n)[0];
}
SEXP obj_names(SEXP x, bool strict) {
if (!OBJECT(x)) {
return Rf_getAttrib(x, R_NamesSymbol);
}
SEXP names_call = PROTECT(Rf_lang2(Rf_install("names"), x));
SEXP names = Rf_eval(names_call, R_GlobalEnv);
UNPROTECT(1);
return names;
}
purrr/src/utils.h 0000644 0001762 0000144 00000000405 14317567435 013542 0 ustar ligges users #ifndef UTILS_H
#define UTILS_H
#include
SEXP sym_protect(SEXP x);
bool is_vector(SEXP x);
SEXP lang7(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y);
SEXP lang8(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w, SEXP x, SEXP y, SEXP z);
#endif
purrr/src/map.c 0000644 0001762 0000144 00000011752 14355573666 013166 0 ustar ligges users #define R_NO_REMAP
#include
#include
#include
#include "coerce.h"
#include "conditions.h"
#include "utils.h"
// Including before "cleancall.h" because we want to register
// exiting handlers ourselves, rather than letting cli register them for us.
#include
#include "cleancall.h"
static
void cb_progress_done(SEXP bar) {
cli_progress_done(bar);
R_ReleaseObject(bar);
}
// call must involve i
SEXP call_loop(SEXP env,
SEXP call,
SEXPTYPE type,
SEXP progress,
int n,
SEXP names,
int* p_i,
int force) {
SEXP bar = cli_progress_bar(n, progress);
R_PreserveObject(bar);
r_call_on_exit((void (*)(void*)) cb_progress_done, (void*) bar);
SEXP out = PROTECT(Rf_allocVector(type, n));
Rf_setAttrib(out, R_NamesSymbol, names);
for (int i = 0; i < n; ++i) {
*p_i = i + 1;
if (CLI_SHOULD_TICK) {
cli_progress_set(bar, i);
}
if (i % 1024 == 0) {
R_CheckUserInterrupt();
}
SEXP res = PROTECT(R_forceAndCall(call, force, env));
if (type != VECSXP && Rf_length(res) != 1) {
Rf_errorcall(R_NilValue, "Result must be length 1, not %i.", Rf_length(res));
}
set_vector_value(out, i, res, 0);
UNPROTECT(1);
}
*p_i = 0;
UNPROTECT(1);
return out;
}
SEXP map_impl(SEXP env,
SEXP ffi_type,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i) {
static SEXP call = NULL;
if (call == NULL) {
SEXP x_sym = Rf_install(".x");
SEXP f_sym = Rf_install(".f");
SEXP i_sym = Rf_install("i");
// Constructs a call like f(x[[i]], ...) - don't want to substitute
// actual values for f or x, because they may be long, which creates
// bad tracebacks()
SEXP x_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, x_sym, i_sym));
call = Rf_lang3(f_sym, x_i_sym, R_DotsSymbol);
R_PreserveObject(call);
UNPROTECT(1);
}
SEXPTYPE type = Rf_str2type(CHAR(STRING_ELT(ffi_type, 0)));
int n = INTEGER_ELT(ffi_n, 0);
int* p_i = INTEGER(i);
int force = 1;
return call_loop(
env,
call,
type,
progress,
n,
names,
p_i,
force
);
}
SEXP map2_impl(SEXP env,
SEXP ffi_type,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i) {
static SEXP call = NULL;
if (call == NULL) {
SEXP x_sym = Rf_install(".x");
SEXP y_sym = Rf_install(".y");
SEXP f_sym = Rf_install(".f");
SEXP i_sym = Rf_install("i");
// Constructs a call like f(x[[i]], y[[i]], ...)
SEXP x_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, x_sym, i_sym));
SEXP y_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, y_sym, i_sym));
call = Rf_lang4(f_sym, x_i_sym, y_i_sym, R_DotsSymbol);
R_PreserveObject(call);
UNPROTECT(2);
}
SEXPTYPE type = Rf_str2type(CHAR(STRING_ELT(ffi_type, 0)));
int n = INTEGER_ELT(ffi_n, 0);
int* p_i = INTEGER(i);
int force = 2;
return call_loop(
env,
call,
type,
progress,
n,
names,
p_i,
force
);
}
SEXP pmap_impl(SEXP env,
SEXP ffi_type,
SEXP progress,
SEXP ffi_n,
SEXP names,
SEXP i,
SEXP call_names,
SEXP ffi_call_n) {
// Construct call like f(.l[[1]][[i]], .l[[2]][[i]], ...)
//
// Currently accessing S3 vectors in a list like .l[[c(1, i)]] will not
// preserve the class (cf. #358).
//
// We construct the call backwards because can only add to the front of a
// linked list. That makes PROTECTion tricky because we need to update it
// each time to point to the start of the linked list.
SEXP l_sym = Rf_install(".l");
SEXP f_sym = Rf_install(".f");
SEXP i_sym = Rf_install("i");
SEXP call = Rf_lang1(R_DotsSymbol);
PROTECT_INDEX call_shelter;
PROTECT_WITH_INDEX(call, &call_shelter);
bool has_call_names = call_names != R_NilValue;
const SEXP* v_call_names = has_call_names ? STRING_PTR(call_names) : NULL;
int call_n = INTEGER_ELT(ffi_call_n, 0);
for (int j = call_n - 1; j >= 0; --j) {
// Construct call like .l[[j]][[i]]
SEXP j_val = PROTECT(Rf_ScalarInteger(j + 1));
SEXP l_j_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, l_sym, j_val));
SEXP l_j_i_sym = PROTECT(Rf_lang3(R_Bracket2Symbol, l_j_sym, i_sym));
call = Rf_lcons(l_j_i_sym, call);
REPROTECT(call, call_shelter);
if (has_call_names) {
const char* call_name = CHAR(v_call_names[j]);
if (call_name[0] != '\0') {
SET_TAG(call, Rf_install(call_name));
}
}
UNPROTECT(3);
}
call = Rf_lcons(f_sym, call);
REPROTECT(call, call_shelter);
SEXPTYPE type = Rf_str2type(CHAR(STRING_ELT(ffi_type, 0)));
int n = INTEGER_ELT(ffi_n, 0);
int* p_i = INTEGER(i);
int force = call_n;
SEXP out = call_loop(
env,
call,
type,
progress,
n,
names,
p_i,
force
);
UNPROTECT(1);
return out;
}
purrr/src/Makevars 0000644 0001762 0000144 00000000035 14304371054 013706 0 ustar ligges users PKG_CFLAGS = $(C_VISIBILITY)
purrr/src/conditions.c 0000644 0001762 0000144 00000011463 14350333562 014541 0 ustar ligges users #define R_NO_REMAP
#include
#include "utils.h"
#include
SEXP current_env(void) {
static SEXP call = NULL;
if (!call) {
// `sys.frame(sys.nframe())` doesn't work because `sys.nframe()`
// returns the number of the frame in which evaluation occurs. It
// doesn't return the number of frames on the stack. So we'd need
// to evaluate it in the last frame on the stack which is what we
// are looking for to begin with. We use instead this workaround:
// Call `sys.frame()` from a closure to push a new frame on the
// stack, and use negative indexing to get the previous frame.
ParseStatus status;
SEXP code = PROTECT(Rf_mkString("sys.frame(-1)"));
SEXP parsed = PROTECT(R_ParseVector(code, -1, &status, R_NilValue));
SEXP body = VECTOR_ELT(parsed, 0);
SEXP fn = PROTECT(Rf_allocSExp(CLOSXP));
SET_FORMALS(fn, R_NilValue);
SET_BODY(fn, body);
SET_CLOENV(fn, R_BaseEnv);
call = Rf_lang1(fn);
R_PreserveObject(call);
UNPROTECT(3);
}
return Rf_eval(call, R_BaseEnv);
}
void r_abort0(SEXP env, char* buf) {
SEXP message = PROTECT(Rf_mkString(buf));
SEXP fn = PROTECT(
Rf_lang3(Rf_install("::"), Rf_install("rlang"), Rf_install("abort"))
);
SEXP call = PROTECT(Rf_lang3(fn, message, env));
SEXP node = CDDR(call);
SET_TAG(node, Rf_install("call"));
Rf_eval(call, R_BaseEnv);
while (1); // No return
}
#define BUFSIZE 8192
void r_abort(const char* fmt, ...) {
char buf[BUFSIZE];
va_list dots;
va_start(dots, fmt);
vsnprintf(buf, BUFSIZE, fmt, dots);
va_end(dots);
buf[BUFSIZE - 1] = '\0';
SEXP env = PROTECT(current_env());
r_abort0(env, buf);
}
void r_abort_call(SEXP env, const char* fmt, ...) {
char buf[BUFSIZE];
va_list dots;
va_start(dots, fmt);
vsnprintf(buf, BUFSIZE, fmt, dots);
va_end(dots);
buf[BUFSIZE - 1] = '\0';
r_abort0(env, buf);
}
const char* rlang_obj_type_friendly_full(SEXP x, bool value, bool length) {
const char* (*rlang_ptr)(SEXP x, bool value, bool length) = NULL;
if (rlang_ptr == NULL) {
rlang_ptr = (const char* (*)(SEXP, bool, bool))
R_GetCCallable("rlang", "rlang_obj_type_friendly_full");
}
return rlang_ptr(x, value, length);
}
void stop_bad_type(SEXP x, const char* expected, const char* what, const char* arg) {
SEXP fn = Rf_lang3(Rf_install(":::"),
Rf_install("purrr"),
Rf_install("stop_bad_type"));
SEXP call = Rf_lang5(PROTECT(fn),
PROTECT(sym_protect(x)),
PROTECT(Rf_mkString(expected)),
what ? PROTECT(Rf_mkString(what)) : R_NilValue,
arg ? PROTECT(Rf_mkString(arg)) : R_NilValue);
PROTECT(call);
SEXP node = CDR(CDR(CDR(call)));
SET_TAG(node, Rf_install("what"));
node = CDR(node);
SET_TAG(node, Rf_install("arg"));
SEXP env = PROTECT(current_env());
Rf_eval(call, env);
while (1); // No return
}
void stop_bad_element_type(SEXP x, R_xlen_t index, const char* expected, const char* what, const char* arg) {
SEXP fn = Rf_lang3(Rf_install(":::"),
Rf_install("purrr"),
Rf_install("stop_bad_element_type"));
SEXP call = Rf_lang6(PROTECT(fn),
PROTECT(sym_protect(x)),
PROTECT(Rf_ScalarReal(index)),
PROTECT(Rf_mkString(expected)),
what ? PROTECT(Rf_mkString(what)) : R_NilValue,
arg ? PROTECT(Rf_mkString(arg)) : R_NilValue);
PROTECT(call);
SEXP node = CDR(CDR(CDR(CDR(call))));
SET_TAG(node, Rf_install("what"));
node = CDR(node);
SET_TAG(node, Rf_install("arg"));
SEXP env = PROTECT(current_env());
Rf_eval(call, env);
while (1); // No return
}
void stop_bad_element_length(SEXP x,
R_xlen_t index,
R_xlen_t expected_length,
const char* what,
const char* arg,
bool recycle) {
SEXP fn = Rf_lang3(Rf_install(":::"),
Rf_install("purrr"),
Rf_install("stop_bad_element_length"));
SEXP call = lang7(PROTECT(fn),
PROTECT(sym_protect(x)),
PROTECT(Rf_ScalarReal(index)),
PROTECT(Rf_ScalarReal(expected_length)),
what ? PROTECT(Rf_mkString(what)) : R_NilValue,
arg ? PROTECT(Rf_mkString(arg)) : R_NilValue,
PROTECT(Rf_ScalarLogical(recycle)));
PROTECT(call);
SEXP node = CDR(CDR(CDR(CDR(call))));
SET_TAG(node, Rf_install("what"));
node = CDR(node);
SET_TAG(node, Rf_install("arg"));
node = CDR(node);
SET_TAG(node, Rf_install("recycle"));
SEXP env = PROTECT(current_env());
Rf_eval(call, env);
while (1); // No return
}
purrr/src/coerce.h 0000644 0001762 0000144 00000000253 14304371054 013625 0 ustar ligges users #ifndef COERCE_H
#define COERCE_H
// Set value of to[i] to from[j], coercing vectors using usual rules.
void set_vector_value(SEXP to, int i, SEXP from, int j);
#endif
purrr/src/cleancall.h 0000644 0001762 0000144 00000002675 14355573666 014340 0 ustar ligges users #ifndef CLEANCALL_H
#define CLEANCALL_H
#include
#include
#include
#ifdef __cplusplus
extern "C" {
#endif
// --------------------------------------------------------------------
// Internals
// --------------------------------------------------------------------
typedef union {void* p; DL_FUNC fn;} fn_ptr;
#if (defined(R_VERSION) && R_VERSION < R_Version(3, 4, 0))
SEXP R_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot);
DL_FUNC R_ExternalPtrAddrFn(SEXP s);
#endif
// --------------------------------------------------------------------
// API for packages that embed cleancall
// --------------------------------------------------------------------
// The R API does not have a setter for external function pointers
SEXP cleancall_MakeExternalPtrFn(DL_FUNC p, SEXP tag, SEXP prot);
void cleancall_SetExternalPtrAddrFn(SEXP s, DL_FUNC p);
#define CLEANCALL_METHOD_RECORD \
{"cleancall_call", (DL_FUNC) &cleancall_call, 2}
SEXP cleancall_call(SEXP args, SEXP env);
void cleancall_init(void);
// --------------------------------------------------------------------
// Public API
// --------------------------------------------------------------------
#define R_CLEANCALL_SUPPORT 1
SEXP r_with_cleanup_context(SEXP (*fn)(void* data), void* data);
void r_call_on_exit(void (*fn)(void* data), void* data);
void r_call_on_early_exit(void (*fn)(void* data), void* data);
#ifdef __cplusplus
}
#endif
#endif
purrr/src/conditions.h 0000644 0001762 0000144 00000001434 14350334141 014535 0 ustar ligges users #ifndef CONDITIONS_H
#define CONDITIONS_H
#include
void __attribute__ ((noreturn)) stop_bad_type(SEXP x, const char* expected, const char* what, const char* arg) __attribute__((noreturn));
void __attribute__ ((noreturn)) stop_bad_element_type(SEXP x, R_xlen_t index, const char* expected, const char* what, const char* arg) __attribute__((noreturn));
void __attribute__ ((noreturn)) stop_bad_element_length(SEXP x, R_xlen_t index, R_xlen_t expected_length, const char* what, const char* arg, bool recycle) __attribute__((noreturn));
SEXP current_env(void);
void __attribute__ ((noreturn)) r_abort(const char* fmt, ...);
void __attribute__ ((noreturn)) r_abort_call(SEXP env, const char* fmt, ...);
const char* rlang_obj_type_friendly_full(SEXP x, bool value, bool length);
#endif
purrr/src/transpose.c 0000644 0001762 0000144 00000005442 14311066210 014374 0 ustar ligges users #define R_NO_REMAP
#include
#include
#include "conditions.h"
#include "utils.h"
SEXP transpose_impl(SEXP x, SEXP names_template) {
if (TYPEOF(x) != VECSXP) {
stop_bad_type(x, "a list", NULL, ".l");
}
int n = Rf_length(x);
if (n == 0) {
return Rf_allocVector(VECSXP, 0);
}
int has_template = !Rf_isNull(names_template);
SEXP x1 = VECTOR_ELT(x, 0);
if (!Rf_isVector(x1)) {
stop_bad_element_type(x1, 1, "a vector", NULL, NULL);
}
int m = has_template ? Rf_length(names_template) : Rf_length(x1);
// Create space for output
SEXP out = PROTECT(Rf_allocVector(VECSXP, m));
SEXP names1 = PROTECT(Rf_getAttrib(x, R_NamesSymbol));
for (int j = 0; j < m; ++j) {
SEXP xj = PROTECT(Rf_allocVector(VECSXP, n));
if (!Rf_isNull(names1)) {
Rf_setAttrib(xj, R_NamesSymbol, names1);
}
SET_VECTOR_ELT(out, j, xj);
UNPROTECT(1);
}
SEXP names2 = has_template ? names_template : Rf_getAttrib(x1, R_NamesSymbol);
if (!Rf_isNull(names2)) {
Rf_setAttrib(out, R_NamesSymbol, names2);
}
// Fill output
for (int i = 0; i < n; ++i) {
SEXP xi = VECTOR_ELT(x, i);
if (!Rf_isVector(xi)) {
stop_bad_element_type(xi, i + 1, "a vector", NULL, NULL);
}
// find mapping between names and index. Use -1 to indicate not found
SEXP names_i = Rf_getAttrib(xi, R_NamesSymbol);
SEXP index;
if (!Rf_isNull(names2) && !Rf_isNull(names_i)) {
index = PROTECT(Rf_match(names_i, names2, 0));
// Rf_match returns 1-based index; convert to 0-based for C
for (int i = 0; i < m; ++i) {
INTEGER(index)[i] = INTEGER(index)[i] - 1;
}
} else {
index = PROTECT(Rf_allocVector(INTSXP, m));
int mi = Rf_length(xi);
if (m != mi) {
Rf_warningcall(R_NilValue, "Element %d must be length %d, not %d", i + 1, m, mi);
}
for (int i = 0; i < m; ++i) {
INTEGER(index)[i] = (i < mi) ? i : -1;
}
}
int* pIndex = INTEGER(index);
for (int j = 0; j < m; ++j) {
int pos = pIndex[j];
if (pos == -1)
continue;
switch(TYPEOF(xi)) {
case LGLSXP:
SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarLogical(LOGICAL(xi)[pos]));
break;
case INTSXP:
SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarInteger(INTEGER(xi)[pos]));
break;
case REALSXP:
SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarReal(REAL(xi)[pos]));
break;
case STRSXP:
SET_VECTOR_ELT(VECTOR_ELT(out, j), i, Rf_ScalarString(STRING_ELT(xi, pos)));
break;
case VECSXP:
SET_VECTOR_ELT(VECTOR_ELT(out, j), i, VECTOR_ELT(xi, pos));
break;
default:
stop_bad_type(xi, "a vector", "Transposed element", NULL);
}
}
UNPROTECT(1);
}
UNPROTECT(2);
return out;
}
purrr/vignettes/ 0000755 0001762 0000144 00000000000 14464464653 013454 5 ustar ligges users purrr/vignettes/base.Rmd 0000644 0001762 0000144 00000035261 14325501250 015016 0 ustar ligges users ---
title: "purrr <-> base R"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{purrr <-> base R}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width = 7,
fig.height = 4.5,
fig.align = "center"
)
options(tibble.print_min = 6, tibble.print_max = 6)
modern_r <- getRversion() >= "4.1.0"
```
# Introduction
This vignette compares purrr's functionals to their base R equivalents, focusing primarily on the map family and related functions.
This helps those familiar with base R understand better what purrr does, and shows purrr users how you might express the same ideas in base R code.
We'll start with a rough overview of the major differences, give a rough translation guide, and then show a few examples.
```{r setup}
library(purrr)
library(tibble)
```
## Key differences
There are two primary differences between the base apply family and the purrr map family: purrr functions are named more consistently, and more fully explore the space of input and output variants.
- purrr functions consistently use `.` as prefix to avoid [inadvertently matching arguments](https://adv-r.hadley.nz/functionals.html#argument-names) of the purrr function, instead of the function that you're trying to call.
Base functions use a variety of techniques including upper case (e.g. `lapply(X, FUN, ...)`) or require anonymous functions (e.g. `Map()`).
- All map functions are type stable: you can predict the type of the output using little information about the inputs.
In contrast, the base functions `sapply()` and `mapply()` automatically simplify making the return value hard to predict.
- The map functions all start with the data, followed by the function, then any additional constant argument.
Most base apply functions also follow this pattern, but `mapply()` starts with the function, and `Map()` has no way to supply additional constant arguments.
- purrr functions provide all combinations of input and output variants, and include variants specifically for the common two argument case.
## Direct translations
The following sections give a high-level translation between base R commands and their purrr equivalents.
See function documentation for the details.
### `Map` functions
Here `x` denotes a vector and `f` denotes a function
| Output | Input | Base R | purrr |
|------------------|------------------|------------------|-------------------|
| List | 1 vector | `lapply()` | `map()` |
| List | 2 vectors | `mapply()`, `Map()` | `map2()` |
| List | \>2 vectors | `mapply()`, `Map()` | `pmap()` |
| Atomic vector of desired type | 1 vector | `vapply()` | `map_lgl()` (logical), `map_int()` (integer), `map_dbl()` (double), `map_chr()` (character), `map_raw()` (raw) |
| Atomic vector of desired type | 2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `map2_lgl()` (logical), `map2_int()` (integer), `map2_dbl()` (double), `map2_chr()` (character), `map2_raw()` (raw) |
| Atomic vector of desired type | \>2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `pmap_lgl()` (logical), `pmap_int()` (integer), `pmap_dbl()` (double), `pmap_chr()` (character), `pmap_raw()` (raw) |
| Side effect only | 1 vector | loops | `walk()` |
| Side effect only | 2 vectors | loops | `walk2()` |
| Side effect only | \>2 vectors | loops | `pwalk()` |
| Data frame (`rbind` outputs) | 1 vector | `lapply()` then `rbind()` | `map_dfr()` |
| Data frame (`rbind` outputs) | 2 vectors | `mapply()`/`Map()` then `rbind()` | `map2_dfr()` |
| Data frame (`rbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `rbind()` | `pmap_dfr()` |
| Data frame (`cbind` outputs) | 1 vector | `lapply()` then `cbind()` | `map_dfc()` |
| Data frame (`cbind` outputs) | 2 vectors | `mapply()`/`Map()` then `cbind()` | `map2_dfc()` |
| Data frame (`cbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `cbind()` | `pmap_dfc()` |
| Any | Vector and its names | `l/s/vapply(X, function(x) f(x, names(x)))` or `mapply/Map(f, x, names(x))` | `imap()`, `imap_*()` (`lgl`, `dbl`, `dfr`, and etc. just like for `map()`, `map2()`, and `pmap()`) |
| Any | Selected elements of the vector | `l/s/vapply(X[index], FUN, ...)` | `map_if()`, `map_at()` |
| List | Recursively apply to list within list | `rapply()` | `map_depth()` |
| List | List only | `lapply()` | `lmap()`, `lmap_at()`, `lmap_if()` |
### Extractor shorthands
Since a common use case for map functions is list extracting components, purrr provides a handful of shortcut functions for various uses of `[[`.
| Input | base R | purrr |
|-------------------|--------------------------|---------------------------|
| Extract by name | `` lapply(x, `[[`, "a") `` | `map(x, "a")` |
| Extract by position | `` lapply(x, `[[`, 3) `` | `map(x, 3)` |
| Extract deeply | `lapply(x, \(y) y[[1]][["x"]][[3]])` | `map(x, list(1, "x", 3))` |
| Extract with default value | `lapply(x, function(y) tryCatch(y[[3]], error = function(e) NA))` | `map(x, 3, .default = NA)` |
### Predicates
Here `p`, a predicate, denotes a function that returns `TRUE` or `FALSE` indicating whether an object fulfills a criterion, e.g. `is.character()`.
| Description | base R | purrr |
|-----------------------------|--------------------|-----------------------|
| Find a matching element | `Find(p, x)` | `detect(x, p)`, |
| Find position of matching element | `Position(p, x)` | `detect_index(x, p)` |
| Do all elements of a vector satisfy a predicate? | `all(sapply(x, p))` | `every(x, p)` |
| Does any elements of a vector satisfy a predicate? | `any(sapply(x, p))` | `some(x, p)` |
| Does a list contain an object? | `any(sapply(x, identical, obj))` | `has_element(x, obj)` |
| Keep elements that satisfy a predicate | `x[sapply(x, p)]` | `keep(x, p)` |
| Discard elements that satisfy a predicate | `x[!sapply(x, p)]` | `discard(x, p)` |
| Negate a predicate function | `function(x) !p(x)` | `negate(p)` |
### Other vector transforms
| Description | base R | purrr |
|-----------------------------|--------------------|-----------------------|
| Accumulate intermediate results of a vector reduction | `Reduce(f, x, accumulate = TRUE)` | `accumulate(x, f)` |
| Recursively combine two lists | `c(X, Y)`, but more complicated to merge recursively | `list_merge()`, `list_modify()` |
| Reduce a list to a single value by iteratively applying a binary function | `Reduce(f, x)` | `reduce(x, f)` |
## Examples
### Varying inputs
#### One input
Suppose we would like to generate a list of samples of 5 from normal distributions with different means:
```{r}
means <- 1:4
```
There's little difference when generating the samples:
- Base R uses `lapply()`:
```{r}
set.seed(2020)
samples <- lapply(means, rnorm, n = 5, sd = 1)
str(samples)
```
- purrr uses `map()`:
```{r}
set.seed(2020)
samples <- map(means, rnorm, n = 5, sd = 1)
str(samples)
```
#### Two inputs
Lets make the example a little more complicated by also varying the standard deviations:
```{r}
means <- 1:4
sds <- 1:4
```
- This is relatively tricky in base R because we have to adjust a number of `mapply()`'s defaults.
```{r}
set.seed(2020)
samples <- mapply(
rnorm,
mean = means,
sd = sds,
MoreArgs = list(n = 5),
SIMPLIFY = FALSE
)
str(samples)
```
Alternatively, we could use `Map()` which doesn't simply, but also doesn't take any constant arguments, so we need to use an anonymous function:
```{r}
samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds)
```
In R 4.1 and up, you could use the shorter anonymous function form:
```{r, eval = modern_r}
samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds)
```
- Working with a pair of vectors is a common situation so purrr provides the `map2()` family of functions:
```{r}
set.seed(2020)
samples <- map2(means, sds, rnorm, n = 5)
str(samples)
```
#### Any number of inputs
We can make the challenge still more complex by also varying the number of samples:
```{r}
ns <- 4:1
```
- Using base R's `Map()` becomes more straightforward because there are no constant arguments.
```{r}
set.seed(2020)
samples <- Map(rnorm, mean = means, sd = sds, n = ns)
str(samples)
```
- In purrr, we need to switch from `map2()` to `pmap()` which takes a list of any number of arguments.
```{r}
set.seed(2020)
samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm)
str(samples)
```
### Outputs
Given the samples, imagine we want to compute their means.
A mean is a single number, so we want the output to be a numeric vector rather than a list.
- There are two options in base R: `vapply()` or `sapply()`.
`vapply()` requires you to specific the output type (so is relatively verbose), but will always return a numeric vector.
`sapply()` is concise, but if you supply an empty list you'll get a list instead of a numeric vector.
```{r}
# type stable
medians <- vapply(samples, median, FUN.VALUE = numeric(1L))
medians
# not type stable
medians <- sapply(samples, median)
```
- purrr is little more compact because we can use `map_dbl()`.
```{r}
medians <- map_dbl(samples, median)
medians
```
What if we want just the side effect, such as a plot or a file output, but not the returned values?
- In base R we can either use a for loop or hide the results of `lapply`.
```{r, fig.show='hide'}
# for loop
for (s in samples) {
hist(s, xlab = "value", main = "")
}
# lapply
invisible(lapply(samples, function(s) {
hist(s, xlab = "value", main = "")
}))
```
- In purrr, we can use `walk()`.
```{r, fig.show='hide'}
walk(samples, ~ hist(.x, xlab = "value", main = ""))
```
### Pipes
You can join multiple steps together either using the magrittr pipe:
```{r}
set.seed(2020)
means %>%
map(rnorm, n = 5, sd = 1) %>%
map_dbl(median)
```
Or the base pipe R:
```{r, eval = modern_r}
set.seed(2020)
means |>
lapply(rnorm, n = 5, sd = 1) |>
sapply(median)
```
(And of course you can mix and match the piping style with either base R or purrr.)
The pipe is particularly compelling when working with longer transformations.
For example, the following code splits `mtcars` up by `cyl`, fits a linear model, extracts the coefficients, and extracts the first one (the intercept).
```{r, eval = modern_r}
mtcars %>%
split(mtcars$cyl) %>%
map(\(df) lm(mpg ~ wt, data = df)) %>%
map(coef) %>%
map_dbl(1)
```
purrr/vignettes/other-langs.Rmd 0000644 0001762 0000144 00000003623 14310436312 016324 0 ustar ligges users ---
title: "Functional programming in other languages"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Functional programming in other languages}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
purrr draws inspiration from many related tools:
* List operations defined in the Haskell [prelude][haskell]
* Scala's [list methods][scala].
* Functional programming libraries for javascript:
[underscore.js](http://underscorejs.org),
[lodash](https://lodash.com) and
[lazy.js](http://danieltao.com/lazy.js/).
* [rlist](https://renkun-ken.github.io/rlist/), another R package to support working
with lists. Similar goals but somewhat different philosophy.
However, the goal of purrr is not to try and simulate a purer functional programming language in R; we don't want to implement a second-class version of Haskell in R. The goal is to give you similar expressiveness to an FP language, while allowing you to write code that looks and works like R:
* Instead of point free (tacit) style, we use the pipe, `%>%`, to write code
that can be read from left to right.
* Instead of currying, we use `...` to pass in extra arguments.
* Before R 4.1, anonymous functions were verbose, so we provide two convenient shorthands.
For unary functions, `~ .x + 1` is equivalent to `function(.x) .x + 1`.
* R is weakly typed, so we need `map` variants that describe the output type
(like `map_int()`, `map_dbl()`, etc) because we don't know the return type of `.f`.
* R has named arguments, so instead of providing different functions for
minor variations (e.g. `detect()` and `detectLast()`) we use a named
argument, `.right`. Type-stable functions are easy to reason about so
additional arguments will never change the type of the output.
[scala]:https://www.scala-lang.org/api/current/index.html
[haskell]:http://hackage.haskell.org/package/base-4.7.0.1/docs/Prelude.html#g:11
purrr/configure.win 0000644 0001762 0000144 00000000043 14311356421 014121 0 ustar ligges users #! /usr/bin/env sh
sh ./configure
purrr/R/ 0000755 0001762 0000144 00000000000 14460560176 011636 5 ustar ligges users purrr/R/reduce.R 0000644 0001762 0000144 00000042524 14460311734 013231 0 ustar ligges users #' Reduce a list to a single value by iteratively applying a binary function
#'
#' @description
#'
#' `reduce()` is an operation that combines the elements of a vector
#' into a single value. The combination is driven by `.f`, a binary
#' function that takes two values and returns a single value: reducing
#' `f` over `1:3` computes the value `f(f(1, 2), 3)`.
#'
#' @inheritParams map
#' @param .y For `reduce2()` and `accumulate2()`, an additional
#' argument that is passed to `.f`. If `init` is not set, `.y`
#' should be 1 element shorter than `.x`.
#' @param .f For `reduce()`, a 2-argument function. The function will be passed
#' the accumulated value as the first argument and the "next" value as the
#' second argument.
#'
#' For `reduce2()`, a 3-argument function. The function will be passed the
#' accumulated value as the first argument, the next value of `.x` as the
#' second argument, and the next value of `.y` as the third argument.
#'
#' The reduction terminates early if `.f` returns a value wrapped in
#' a [done()].
#'
#' @param .init If supplied, will be used as the first value to start
#' the accumulation, rather than using `.x[[1]]`. This is useful if
#' you want to ensure that `reduce` returns a correct value when `.x`
#' is empty. If missing, and `.x` is empty, will throw an error.
#' @param .dir The direction of reduction as a string, one of
#' `"forward"` (the default) or `"backward"`. See the section about
#' direction below.
#'
#' @section Direction:
#'
#' When `.f` is an associative operation like `+` or `c()`, the
#' direction of reduction does not matter. For instance, reducing the
#' vector `1:3` with the binary function `+` computes the sum `((1 +
#' 2) + 3)` from the left, and the same sum `(1 + (2 + 3))` from the
#' right.
#'
#' In other cases, the direction has important consequences on the
#' reduced value. For instance, reducing a vector with `list()` from
#' the left produces a left-leaning nested list (or tree), while
#' reducing `list()` from the right produces a right-leaning list.
#'
#' @section Life cycle:
#'
#' `reduce_right()` is soft-deprecated as of purrr 0.3.0. Please use
#' the `.dir` argument of `reduce()` instead. Note that the algorithm
#' has changed. Whereas `reduce_right()` computed `f(f(3, 2), 1)`,
#' `reduce(.dir = \"backward\")` computes `f(1, f(2, 3))`. This is the
#' standard way of reducing from the right.
#'
#' To update your code with the same reduction as `reduce_right()`,
#' simply reverse your vector and use a left reduction:
#'
#' ```{r, eval = FALSE}
#' # Before:
#' reduce_right(1:3, f)
#'
#' # After:
#' reduce(rev(1:3), f)
#' ```
#'
#' `reduce2_right()` is soft-deprecated as of purrr 0.3.0 without
#' replacement. It is not clear what algorithmic properties should a
#' right reduction have in this case. Please reach out if you know
#' about a use case for a right reduction with a ternary function.
#'
#' @seealso [accumulate()] for a version that returns all intermediate
#' values of the reduction.
#' @examples
#' # Reducing `+` computes the sum of a vector while reducing `*`
#' # computes the product:
#' 1:3 |> reduce(`+`)
#' 1:10 |> reduce(`*`)
#'
#' # By ignoring the input vector (nxt), you can turn output of one step into
#' # the input for the next. This code takes 10 steps of a random walk:
#' reduce(1:10, \(acc, nxt) acc + rnorm(1), .init = 0)
#'
#' # When the operation is associative, the direction of reduction
#' # does not matter:
#' reduce(1:4, `+`)
#' reduce(1:4, `+`, .dir = "backward")
#'
#' # However with non-associative operations, the reduced value will
#' # be different as a function of the direction. For instance,
#' # `list()` will create left-leaning lists when reducing from the
#' # right, and right-leaning lists otherwise:
#' str(reduce(1:4, list))
#' str(reduce(1:4, list, .dir = "backward"))
#'
#' # reduce2() takes a ternary function and a second vector that is
#' # one element smaller than the first vector:
#' paste2 <- function(x, y, sep = ".") paste(x, y, sep = sep)
#' letters[1:4] |> reduce(paste2)
#' letters[1:4] |> reduce2(c("-", ".", "-"), paste2)
#'
#' x <- list(c(0, 1), c(2, 3), c(4, 5))
#' y <- list(c(6, 7), c(8, 9))
#' reduce2(x, y, paste)
#'
#'
#' # You can shortcircuit a reduction and terminate it early by
#' # returning a value wrapped in a done(). In the following example
#' # we return early if the result-so-far, which is passed on the LHS,
#' # meets a condition:
#' paste3 <- function(out, input, sep = ".") {
#' if (nchar(out) > 4) {
#' return(done(out))
#' }
#' paste(out, input, sep = sep)
#' }
#' letters |> reduce(paste3)
#'
#' # Here the early return branch checks the incoming inputs passed on
#' # the RHS:
#' paste4 <- function(out, input, sep = ".") {
#' if (input == "j") {
#' return(done(out))
#' }
#' paste(out, input, sep = sep)
#' }
#' letters |> reduce(paste4)
#' @export
reduce <- function(.x, .f, ..., .init, .dir = c("forward", "backward")) {
reduce_impl(.x, .f, ..., .init = .init, .dir = .dir)
}
#' @rdname reduce
#' @export
reduce2 <- function(.x, .y, .f, ..., .init) {
reduce2_impl(.x, .y, .f, ..., .init = .init, .left = TRUE)
}
reduce_impl <- function(.x,
.f,
...,
.init,
.dir,
.acc = FALSE,
.purrr_error_call = caller_env()) {
left <- arg_match0(.dir, c("forward", "backward")) == "forward"
out <- reduce_init(.x, .init, left = left, error_call = .purrr_error_call)
idx <- reduce_index(.x, .init, left = left)
if (.acc) {
acc_out <- accum_init(out, idx, left = left)
acc_idx <- accum_index(acc_out, left = left)
}
.f <- as_mapper(.f, ...)
# Left-reduce passes the result-so-far on the left, right-reduce
# passes it on the right. A left-reduce produces left-leaning
# computation trees while right-reduce produces right-leaning trees.
if (left) {
fn <- .f
} else {
fn <- function(x, y, ...) .f(y, x, ...)
}
for (i in seq_along(idx)) {
prev <- out
elt <- .x[[idx[[i]]]]
out <- forceAndCall(2, fn, out, elt, ...)
if (is_done_box(out)) {
return(reduce_early(out, prev, .acc, acc_out, acc_idx[[i]], left))
}
if (.acc) {
acc_out[[acc_idx[[i]]]] <- out
}
}
if (.acc) {
acc_out
} else {
out
}
}
reduce_early <- function(out, prev, acc, acc_out, acc_idx, left = TRUE) {
if (is_done_box(out, empty = TRUE)) {
out <- prev
offset <- if (left) -1L else 1L
} else {
out <- unbox(out)
offset <- 0L
}
if (!acc) {
return(out)
}
acc_idx <- acc_idx + offset
acc_out[[acc_idx]] <- out
if (left) {
acc_out[seq_len(acc_idx)]
} else {
acc_out[seq(acc_idx, length(acc_out))]
}
}
reduce_init <- function(x, init, left = TRUE, error_call = caller_env()) {
if (!missing(init)) {
init
} else {
if (is_empty(x)) {
cli::cli_abort(
"Must supply {.arg .init} when {.arg .x} is empty.",
arg = ".init",
call = error_call
)
} else if (left) {
x[[1]]
} else {
x[[length(x)]]
}
}
}
reduce_index <- function(x, init, left = TRUE) {
n <- length(x)
if (left) {
if (missing(init)) {
seq_len2(2L, n)
} else {
seq_len(n)
}
} else {
if (missing(init)) {
rev(seq_len(n - 1L))
} else {
rev(seq_len(n))
}
}
}
accum_init <- function(first, idx, left) {
len <- length(idx) + 1L
out <- new_list(len)
if (left) {
out[[1]] <- first
} else {
out[[len]] <- first
}
out
}
accum_index <- function(out, left) {
n <- length(out)
if (left) {
seq_len2(2, n)
} else {
rev(seq_len(n - 1L))
}
}
reduce2_impl <- function(.x,
.y,
.f,
...,
.init,
.left = TRUE,
.acc = FALSE,
.purrr_error_call = caller_env()) {
out <- reduce_init(.x, .init, left = .left, error_call = .purrr_error_call)
x_idx <- reduce_index(.x, .init, left = .left)
y_idx <- reduce_index(.y, NULL, left = .left)
if (length(x_idx) != length(y_idx)) {
cli::cli_abort(
"{.arg .y} must have length {length(x_idx)}, not {length(y_idx)}.",
arg = ".y",
call = .purrr_error_call)
}
.f <- as_mapper(.f, ...)
if (.acc) {
acc_out <- accum_init(out, x_idx, left = .left)
acc_idx <- accum_index(acc_out, left = .left)
}
for (i in seq_along(x_idx)) {
prev <- out
x_i <- x_idx[[i]]
y_i <- y_idx[[i]]
out <- forceAndCall(3, .f, out, .x[[x_i]], .y[[y_i]], ...)
if (is_done_box(out)) {
return(reduce_early(out, prev, .acc, acc_out, acc_idx[[i]]))
}
if (.acc) {
acc_out[[acc_idx[[i]]]] <- out
}
}
if (.acc) {
acc_out
} else {
out
}
}
seq_len2 <- function(start, end) {
if (start > end) {
return(integer(0))
}
start:end
}
#' Accumulate intermediate results of a vector reduction
#'
#' @description
#'
#' `accumulate()` sequentially applies a 2-argument function to elements of a
#' vector. Each application of the function uses the initial value or result
#' of the previous application as the first argument. The second argument is
#' the next value of the vector. The results of each application are
#' returned in a list. The accumulation can optionally terminate before
#' processing the whole vector in response to a `done()` signal returned by
#' the accumulation function.
#'
#' By contrast to `accumulate()`, `reduce()` applies a 2-argument function in
#' the same way, but discards all results except that of the final function
#' application.
#'
#' `accumulate2()` sequentially applies a function to elements of two lists, `.x` and `.y`.
#'
#' @inheritParams map
#'
#' @param .y For `accumulate2()` `.y` is the second argument of the pair. It
#' needs to be 1 element shorter than the vector to be accumulated (`.x`).
#' If `.init` is set, `.y` needs to be one element shorted than the
#' concatenation of the initial value and `.x`.
#'
#' @param .f For `accumulate()` `.f` is 2-argument function. The function will
#' be passed the accumulated result or initial value as the first argument.
#' The next value in sequence is passed as the second argument.
#'
#' For `accumulate2()`, a 3-argument function. The
#' function will be passed the accumulated result as the first
#' argument. The next value in sequence from `.x` is passed as the second argument. The
#' next value in sequence from `.y` is passed as the third argument.
#'
#' The accumulation terminates early if `.f` returns a value wrapped in
#' a [done()].
#'
#' @param .init If supplied, will be used as the first value to start
#' the accumulation, rather than using `.x[[1]]`. This is useful if
#' you want to ensure that `reduce` returns a correct value when `.x`
#' is empty. If missing, and `.x` is empty, will throw an error.
#' @param .dir The direction of accumulation as a string, one of
#' `"forward"` (the default) or `"backward"`. See the section about
#' direction below.
#' @param .simplify If `NA`, the default, the accumulated list of
#' results is simplified to an atomic vector if possible.
#' If `TRUE`, the result is simplified, erroring if not possible.
#' If `FALSE`, the result is not simplified, always returning a list.
#' @param .ptype If `simplify` is `NA` or `TRUE`, optionally supply a vector
#' prototype to enforce the output type.
#' @return A vector the same length of `.x` with the same names as `.x`.
#'
#' If `.init` is supplied, the length is extended by 1. If `.x` has
#' names, the initial value is given the name `".init"`, otherwise
#' the returned vector is kept unnamed.
#'
#' If `.dir` is `"forward"` (the default), the first element is the
#' initial value (`.init` if supplied, or the first element of `.x`)
#' and the last element is the final reduced value. In case of a
#' right accumulation, this order is reversed.
#'
#' The accumulation terminates early if `.f` returns a value wrapped
#' in a [done()]. If the done box is empty, the last value is
#' used instead and the result is one element shorter (but always
#' includes the initial value, even when terminating at the first
#' iteration).
#'
#' @inheritSection reduce Direction
#'
#' @section Life cycle:
#'
#' `accumulate_right()` is soft-deprecated in favour of the `.dir`
#' argument as of rlang 0.3.0. Note that the algorithm has
#' slightly changed: the accumulated value is passed to the right
#' rather than the left, which is consistent with a right reduction.
#'
#' @seealso [reduce()] when you only need the final reduced value.
#' @examples
#' # With an associative operation, the final value is always the
#' # same, no matter the direction. You'll find it in the first element for a
#' # backward (left) accumulation, and in the last element for forward
#' # (right) one:
#' 1:5 |> accumulate(`+`)
#' 1:5 |> accumulate(`+`, .dir = "backward")
#'
#' # The final value is always equal to the equivalent reduction:
#' 1:5 |> reduce(`+`)
#'
#' # It is easier to understand the details of the reduction with
#' # `paste()`.
#' accumulate(letters[1:5], paste, sep = ".")
#'
#' # Note how the intermediary reduced values are passed to the left
#' # with a left reduction, and to the right otherwise:
#' accumulate(letters[1:5], paste, sep = ".", .dir = "backward")
#'
#' # By ignoring the input vector (nxt), you can turn output of one step into
#' # the input for the next. This code takes 10 steps of a random walk:
#' accumulate(1:10, \(acc, nxt) acc + rnorm(1), .init = 0)
#'
#' # `accumulate2()` is a version of `accumulate()` that works with
#' # 3-argument functions and one additional vector:
#' paste2 <- function(acc, nxt, sep = ".") paste(acc, nxt, sep = sep)
#' letters[1:4] |> accumulate(paste2)
#' letters[1:4] |> accumulate2(c("-", ".", "-"), paste2)
#'
#' # You can shortcircuit an accumulation and terminate it early by
#' # returning a value wrapped in a done(). In the following example
#' # we return early if the result-so-far, which is passed on the LHS,
#' # meets a condition:
#' paste3 <- function(out, input, sep = ".") {
#' if (nchar(out) > 4) {
#' return(done(out))
#' }
#' paste(out, input, sep = sep)
#' }
#' letters |> accumulate(paste3)
#'
#' # Note how we get twice the same value in the accumulation. That's
#' # because we have returned it twice. To prevent this, return an empty
#' # done box to signal to accumulate() that it should terminate with the
#' # value of the last iteration:
#' paste3 <- function(out, input, sep = ".") {
#' if (nchar(out) > 4) {
#' return(done())
#' }
#' paste(out, input, sep = sep)
#' }
#' letters |> accumulate(paste3)
#'
#' # Here the early return branch checks the incoming inputs passed on
#' # the RHS:
#' paste4 <- function(out, input, sep = ".") {
#' if (input == "f") {
#' return(done())
#' }
#' paste(out, input, sep = sep)
#' }
#' letters |> accumulate(paste4)
#'
#'
#' # Simulating stochastic processes with drift
#' \dontrun{
#' library(dplyr)
#' library(ggplot2)
#'
#' map(1:5, \(i) rnorm(100)) |>
#' set_names(paste0("sim", 1:5)) |>
#' map(\(l) accumulate(l, \(acc, nxt) .05 + acc + nxt)) |>
#' map(\(x) tibble(value = x, step = 1:100)) |>
#' list_rbind(id = "simulation") |>
#' ggplot(aes(x = step, y = value)) +
#' geom_line(aes(color = simulation)) +
#' ggtitle("Simulations of a random walk with drift")
#' }
#' @export
accumulate <- function(.x, .f, ..., .init, .dir = c("forward", "backward"), .simplify = NA, .ptype = NULL) {
.dir <- arg_match0(.dir, c("forward", "backward"))
.f <- as_mapper(.f, ...)
res <- reduce_impl(.x, .f, ..., .init = .init, .dir = .dir, .acc = TRUE)
names(res) <- accumulate_names(names(.x), .init, .dir)
res <- list_simplify_internal(res, .simplify, .ptype)
res
}
#' @rdname accumulate
#' @export
accumulate2 <- function(.x, .y, .f, ..., .init, .simplify = NA, .ptype = NULL) {
res <- reduce2_impl(.x, .y, .f, ..., .init = .init, .acc = TRUE)
res <- list_simplify_internal(res, .simplify, .ptype)
res
}
accumulate_names <- function(nms, init, dir) {
if (is_null(nms)) {
return(NULL)
}
if (!missing(init)) {
nms <- c(".init", nms)
}
if (dir == "backward") {
nms <- rev(nms)
}
nms
}
#' Reduce from the right (retired)
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' These functions were deprecated in purrr 0.3.0. Please use the
#' `.dir` argument of [reduce()] instead, or reverse your vectors
#' and use a left reduction.
#'
#' @inheritParams reduce
#'
#' @keywords internal
#' @export
reduce_right <- function(.x, .f, ..., .init) {
lifecycle::deprecate_warn(
when = "0.3.0",
what = "reduce_right()",
with = "reduce(.dir)",
always = TRUE
)
.x <- rev(.x) # Compatibility
reduce_impl(.x, .f, ..., .dir = "forward", .init = .init)
}
#' @rdname reduce_right
#' @export
reduce2_right <- function(.x, .y, .f, ..., .init) {
lifecycle::deprecate_warn(
when = "0.3.0",
what = "reduce2_right()",
with = I("reverse your vectors and use `reduce2()`"),
always = TRUE
)
reduce2_impl(.x, .y, .f, ..., .init = .init, .left = FALSE)
}
#' @rdname reduce_right
#' @export
accumulate_right <- function(.x, .f, ..., .init) {
lifecycle::deprecate_warn(
when = "0.3.0",
what = "accumulate_right()",
with = "accumulate(.dir)",
always = TRUE
)
# Note the order of arguments is switched
f <- function(y, x) {
.f(x, y, ...)
}
accumulate(.x, f, .init = .init, .dir = "backward")
}
purrr/R/cleancall.R 0000644 0001762 0000144 00000000150 14355573666 013706 0 ustar ligges users call_with_cleanup <- function(ptr, ...) {
.Call(cleancall_call, pairlist(ptr, ...), parent.frame())
}
purrr/R/adverb-safely.R 0000644 0001762 0000144 00000003764 14355342401 014507 0 ustar ligges users #' Wrap a function to capture errors
#'
#' Creates a modified version of `.f` that always succeeds. It returns a list
#' with components `result` and `error`. If the function succeeds, `result`
#' contains the returned value and `error` is `NULL`. If an error occurred,
#' `error` is an `error` object and `result` is either `NULL` or `otherwise`.
#'
#' # Adverbs
#' This function is called an adverb because it modifies the effect of a
#' function (a verb). If you'd like to include a function created an adverb
#' in a package, be sure to read [faq-adverbs-export].
#'
#' @param .f A function to modify, specified in one of the following ways:
#' * A named function, e.g. `mean`.
#' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`.
#' * A formula, e.g. `~ .x + 1`. Only recommended if you require backward
#' compatibility with older versions of R.
#' @param otherwise Default value to use when an error occurs.
#' @param quiet Hide errors (`TRUE`, the default), or display them
#' as they occur?
#' @returns A function that takes the same arguments as `.f`, but returns
#' a different value, as described above.
#' @family adverbs
#' @export
#' @examples
#' safe_log <- safely(log)
#' safe_log(10)
#' safe_log("a")
#'
#' list("a", 10, 100) |>
#' map(safe_log) |>
#' transpose()
#'
#' # This is a bit easier to work with if you supply a default value
#' # of the same type and use the simplify argument to transpose():
#' safe_log <- safely(log, otherwise = NA_real_)
#' list("a", 10, 100) |>
#' map(safe_log) |>
#' transpose() |>
#' simplify_all()
safely <- function(.f, otherwise = NULL, quiet = TRUE) {
.f <- as_mapper(.f)
force(otherwise)
check_bool(quiet)
function(...) capture_error(.f(...), otherwise, quiet)
}
capture_error <- function(code, otherwise = NULL, quiet = TRUE) {
tryCatch(
list(result = code, error = NULL),
error = function(e) {
if (!quiet)
message("Error: ", conditionMessage(e))
list(result = otherwise, error = e)
}
)
}
purrr/R/lmap.R 0000644 0001762 0000144 00000005451 14350157731 012714 0 ustar ligges users #' Apply a function to list-elements of a list
#'
#' @description
#' `lmap()`, `lmap_at()` and `lmap_if()` are similar to `map()`, `map_at()` and
#' `map_if()`, except instead of mapping over `.x[[i]]`, they instead map over
#' `.x[i]`.
#'
#' This has several advantages:
#'
#' * It makes it possible to work with functions that exclusively take a list.
#' * It allows `.f` to access the attributes of the encapsulating list,
#' like [names()].
#' * It allows `.f` to return a larger or small list than it receives
#' changing the size of the output.
#'
#' @param .x A list or data frame.
#' @param .f A function that takes a length-1 list and returns a list (of any
#' length.)
#' @inheritParams map_if
#' @inheritParams map_at
#' @inheritParams map
#' @return A list or data frame, matching `.x`. There are no guarantees about
#' the length.
#' @family map variants
#' @export
#' @examples
#' set.seed(1014)
#'
#' # Let's write a function that returns a larger list or an empty list
#' # depending on some condition. It also uses the input name to name the
#' # output
#' maybe_rep <- function(x) {
#' n <- rpois(1, 2)
#' set_names(rep_len(x, n), paste0(names(x), seq_len(n)))
#' }
#'
#' # The output size varies each time we map f()
#' x <- list(a = 1:4, b = letters[5:7], c = 8:9, d = letters[10])
#' x |> lmap(maybe_rep) |> str()
#'
#' # We can apply f() on a selected subset of x
#' x |> lmap_at(c("a", "d"), maybe_rep) |> str()
#'
#' # Or only where a condition is satisfied
#' x |> lmap_if(is.character, maybe_rep) |> str()
lmap <- function(.x, .f, ...) {
lmap_helper(.x, rep(TRUE, length(.x)), .f, ...)
}
#' @rdname lmap
#' @export
lmap_if <- function(.x, .p, .f, ..., .else = NULL) {
where <- where_if(.x, .p)
lmap_helper(.x, where, .f, ..., .else = .else)
}
#' @rdname lmap
#' @export
lmap_at <- function(.x, .at, .f, ...) {
where <- where_at(.x, .at, user_env = caller_env())
lmap_helper(.x, where, .f, ...)
}
lmap_helper <- function(.x,
.ind,
.f,
...,
.else = NULL,
.purrr_error_call = caller_env()) {
.f <- rlang::as_function(.f, call = .purrr_error_call)
if (!is.null(.else)) {
.else <- rlang::as_function(.else, call = .purrr_error_call)
}
out <- vector("list", length(.x))
for (i in seq_along(.x)) {
if (.ind[[i]]) {
res <- .f(.x[i], ...)
} else if (is.null(.else)) {
res <- .x[i]
} else {
res <- .else(.x[i], ...)
}
if (!is.list(res)) {
cli::cli_abort(
"{.code .f(.x[[{i}]])} must return a list, not {.obj_type_friendly {res}}.",
call = .purrr_error_call
)
}
out[[i]] <- res
}
if (is.data.frame(.x)) {
out <- lapply(out, as.data.frame)
list_cbind(out)
} else {
list_flatten(out)
}
}
purrr/R/detect.R 0000644 0001762 0000144 00000005060 14460311734 013224 0 ustar ligges users #' Find the value or position of the first match
#'
#' @inheritParams keep
#' @inheritParams map
#' @param .dir If `"forward"`, the default, starts at the beginning of
#' the vector and move towards the end; if `"backward"`, starts at
#' the end of the vector and moves towards the beginning.
#' @param .right `r lifecycle::badge("deprecated")` Please use `.dir` instead.
#' @param .default The value returned when nothing is detected.
#' @return `detect` the value of the first item that matches the
#' predicate; `detect_index` the position of the matching item.
#' If not found, `detect` returns `NULL` and `detect_index`
#' returns 0.
#'
#' @seealso [keep()] for keeping all matching values.
#' @export
#' @examples
#' is_even <- function(x) x %% 2 == 0
#'
#' 3:10 |> detect(is_even)
#' 3:10 |> detect_index(is_even)
#'
#' 3:10 |> detect(is_even, .dir = "backward")
#' 3:10 |> detect_index(is_even, .dir = "backward")
#'
#'
#' # Since `.f` is passed to as_mapper(), you can supply a
#' # lambda-formula or a pluck object:
#' x <- list(
#' list(1, foo = FALSE),
#' list(2, foo = TRUE),
#' list(3, foo = TRUE)
#' )
#'
#' detect(x, "foo")
#' detect_index(x, "foo")
#'
#'
#' # If you need to find all values, use keep():
#' keep(x, "foo")
#'
#' # If you need to find all positions, use map_lgl():
#' which(map_lgl(x, "foo"))
detect <- function(.x, .f, ..., .dir = c("forward", "backward"), .right = NULL, .default = NULL) {
.f <- as_predicate(.f, ..., .mapper = TRUE)
.dir <- arg_match0(.dir, c("forward", "backward"))
for (i in index(.x, .dir, .right, "detect")) {
if (.f(.x[[i]], ...)) {
return(.x[[i]])
}
}
.default
}
#' @export
#' @rdname detect
detect_index <- function(.x, .f, ..., .dir = c("forward", "backward"), .right = NULL) {
.f <- as_predicate(.f, ..., .mapper = TRUE)
.dir <- arg_match0(.dir, c("forward", "backward"))
for (i in index(.x, .dir, .right, "detect_index")) {
if (.f(.x[[i]], ...)) {
return(i)
}
}
0L
}
index <- function(x, dir, right = NULL, fn) {
if (!is_null(right)) {
lifecycle::deprecate_warn(
when = "0.3.0",
what = paste0(fn, "(.right)"),
with = paste0(fn, "(.dir)"),
always = TRUE
)
dir <- if (right) "backward" else "forward"
}
idx <- seq_along(x)
if (dir == "backward") {
idx <- rev(idx)
}
idx
}
#' Does a list contain an object?
#'
#' @inheritParams map
#' @param .y Object to test for
#' @export
#' @examples
#' x <- list(1:10, 5, 9.9)
#' x |> has_element(1:10)
#' x |> has_element(3)
has_element <- function(.x, .y) {
some(.x, identical, .y)
}
purrr/R/superseded-simplify.R 0000644 0001762 0000144 00000006050 14330525021 015741 0 ustar ligges users #' Coerce a list to a vector
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' These functions were superseded in purrr 1.0.0 in favour of
#' `list_simplify()` which has more consistent semantics based on vctrs
#' principles:
#'
#' * `as_vector(x)` is now `list_simplify(x)`
#' * `simplify(x)` is now `list_simplify(x, strict = FALSE)`
#' * `simplify_all(x)` is `map(x, list_simplify, strict = FALSE)`
#'
#' Superseded functions will not go away, but will only receive critical
#' bug fixes.
#'
#' @param .x A list of vectors
#' @param .type Can be a vector mold specifying both the type and the
#' length of the vectors to be concatenated, such as `numeric(1)`
#' or `integer(4)`. Alternatively, it can be a string describing
#' the type, one of: "logical", "integer", "double", "complex",
#' "character" or "raw".
#' @export
#' @keywords internal
#' @examples
#' # was
#' as.list(letters) |> as_vector("character")
#' # now
#' as.list(letters) |> list_simplify(ptype = character())
#'
#' # was:
#' list(1:2, 3:4, 5:6) |> as_vector(integer(2))
#' # now:
#' list(1:2, 3:4, 5:6) |> list_c(ptype = integer())
as_vector <- function(.x, .type = NULL) {
# 1.0.0
lifecycle::signal_stage("superseded", "as_vector()", "list_simplify()")
as_vector_(.x, .type)
}
as_vector_ <- function(.x, .type = NULL) {
if (can_simplify(.x, .type)) {
unlist(.x)
} else {
cli::cli_abort(
"Can't coerce {.arg .x} to a vector.",
arg = ".x"
)
}
}
#' @export
#' @rdname as_vector
simplify <- function(.x, .type = NULL) {
# 1.0.0
lifecycle::signal_stage("superseded", "simplify()", I("`list_simplify(strict = FALSE)`"))
if (can_simplify(.x, .type)) {
unlist(.x)
} else {
.x
}
}
#' @export
#' @rdname as_vector
simplify_all <- function(.x, .type = NULL) {
# 1.0.0
lifecycle::signal_stage("superseded", "simplify_all()", I("`map(xs, \\(x) list_simplify(strict = FALSE))`"))
map(.x, simplify)
}
# Simplify a list of atomic vectors of the same type to a vector
#
# simplify_list(list(1, 2, 3))
can_simplify <- function(x, type = NULL) {
is_atomic <- vapply(x, is.atomic, logical(1))
if (!all(is_atomic)) return(FALSE)
mode <- unique(vapply(x, typeof, character(1)))
if (length(mode) > 1 &&
!all(c("double", "integer") %in% mode)) {
return(FALSE)
}
# This can be coerced safely. If type is supplied, perform
# additional check
is.null(type) || can_coerce(x, type)
}
can_coerce <- function(x, type) {
actual <- typeof(x[[1]])
if (is_mold(type)) {
lengths <- unique(map_int(x, length))
if (length(lengths) > 1 || !(lengths == length(type))) {
return(FALSE)
} else {
type <- typeof(type)
}
}
if (actual == "integer" && type %in% c("integer", "double", "numeric")) {
return(TRUE)
}
if (actual %in% c("integer", "double") && type == "numeric") {
return(TRUE)
}
actual == type
}
# is a mold? As opposed to a string
is_mold <- function(type) {
modes <- c("numeric", "logical", "integer", "double", "complex",
"character", "raw")
length(type) > 1 || (!type %in% modes)
}
purrr/R/modify-tree.R 0000644 0001762 0000144 00000004344 14350140332 014174 0 ustar ligges users #' Recursively modify a list
#'
#' `modify_tree()` allows you to recursively modify a list, supplying functions
#' that either modify each leaf or each node (or both).
#'
#' @param x A list.
#' @param ... Reserved for future use. Must be empty
#' @param leaf A function applied to each leaf.
#' @param is_node A predicate function that determines whether an element is
#' a node (by returning `TRUE`) or a leaf (by returning `FALSE`). The
#' default value, `NULL`, treats simple lists as nodes and everything else
#' (including richer objects like data frames and linear models) as leaves,
#' using [vctrs::vec_is_list()]. To recurse into all objects built on lists
#' use [is.list()].
#' @param pre,post Functions applied to each node. `pre` is applied on the
#' way "down", i.e. before the leaves are transformed with `leaf`, while
#' `post` is applied on the way "up", i.e. after the leaves are transformed.
#' @family modify variants
#' @export
#' @examples
#' x <- list(list(a = 2:1, c = list(b1 = 2), b = list(c2 = 3, c1 = 4)))
#' x |> str()
#'
#' # Transform each leaf
#' x |> modify_tree(leaf = \(x) x + 100) |> str()
#'
#' # Recursively sort the nodes
#' sort_named <- function(x) {
#' nms <- names(x)
#' if (!is.null(nms)) {
#' x[order(nms)]
#' } else {
#' x
#' }
#' }
#' x |> modify_tree(post = sort_named) |> str()
modify_tree <- function(x,
...,
leaf = identity,
is_node = NULL,
pre = identity,
post = identity) {
check_dots_empty()
leaf <- rlang::as_function(leaf)
is_node <- as_is_node(is_node)
post <- rlang::as_function(post)
pre <- rlang::as_function(pre)
worker <- function(x) {
if (is_node(x)) {
out <- pre(x)
out <- modify(out, worker)
out <- post(out)
} else {
out <- leaf(x)
}
out
}
worker(x)
}
as_is_node <- function(f, error_call = caller_env(), error_arg = caller_arg(f)) {
if (is.null(f)) {
vec_is_list
} else {
is_node_f <- rlang::as_function(f, call = error_call, arg = error_arg)
as_predicate(
is_node_f,
.mapper = FALSE,
.purrr_error_call = error_call,
.purrr_error_arg = error_arg
)
}
}
purrr/R/adverb-compose.R 0000644 0001762 0000144 00000004571 14460311734 014670 0 ustar ligges users #' Compose multiple functions together to create a new function
#'
#' Create a new function that is the composition of multiple functions,
#' i.e. `compose(f, g)` is equivalent to `function(...) f(g(...))`.
#'
#' @param ... Functions to apply in order (from right to left by
#' default). Formulas are converted to functions in the usual way.
#'
#' [Dynamic dots][rlang::dyn-dots] are supported. In particular, if
#' your functions are stored in a list, you can splice that in with
#' `!!!`.
#' @param .dir If `"backward"` (the default), the functions are called
#' in the reverse order, from right to left, as is conventional in
#' mathematics. If `"forward"`, they are called from left to right.
#' @inheritSection safely Adverbs
#' @family adverbs
#' @return A function
#' @export
#' @examples
#' not_null <- compose(`!`, is.null)
#' not_null(4)
#' not_null(NULL)
#'
#' add1 <- function(x) x + 1
#' compose(add1, add1)(8)
#'
#' fn <- compose(\(x) paste(x, "foo"), \(x) paste(x, "bar"))
#' fn("input")
#'
#' # Lists of functions can be spliced with !!!
#' fns <- list(
#' function(x) paste(x, "foo"),
#' \(x) paste(x, "bar")
#' )
#' fn <- compose(!!!fns)
#' fn("input")
compose <- function(..., .dir = c("backward", "forward")) {
.dir <- arg_match0(.dir, c("backward", "forward"))
fns <- map(list2(...), rlang::as_closure, env = caller_env())
if (!length(fns)) {
# Return the identity function
return(compose(function(x, ...) x))
}
if (.dir == "backward") {
n <- length(fns)
first_fn <- fns[[n]]
fns <- rev(fns[-n])
} else {
first_fn <- fns[[1]]
fns <- fns[-1]
}
composed <- function() {
env <- env(caller_env(), `_fn` = first_fn)
first_call <- sys.call()
first_call[[1]] <- quote(`_fn`)
env$`_out` <- .Call(purrr_eval, first_call, env)
call <- quote(`_fn`(`_out`))
for (fn in fns) {
env$`_fn` <- fn
env$`_out` <- .Call(purrr_eval, call, env)
}
env$`_out`
}
formals(composed) <- formals(first_fn)
structure(
composed,
class = c("purrr_function_compose", "function"),
first_fn = first_fn,
fns = fns
)
}
#' @export
print.purrr_function_compose <- function(x, ...) {
cat("\n")
first <- attr(x, "first_fn")
cat("1. ")
print(first, ...)
fns <- attr(x, "fns")
for (i in seq_along(fns)) {
cat(sprintf("\n%d. ", i + 1))
print(fns[[i]], ...)
}
invisible(x)
}
purrr/R/package-purrr.R 0000644 0001762 0000144 00000000317 14330525020 014506 0 ustar ligges users #' @keywords internal
#' @import rlang
#' @import vctrs
#' @importFrom cli cli_progress_bar
#' @importFrom lifecycle deprecated
#' @useDynLib purrr, .registration = TRUE
"_PACKAGE"
the <- new_environment()
purrr/R/map-if-at.R 0000644 0001762 0000144 00000004727 14350157731 013543 0 ustar ligges users #' Apply a function to each element of a vector conditionally
#'
#' @description
#' The functions `map_if()` and `map_at()` take `.x` as input, apply
#' the function `.f` to some of the elements of `.x`, and return a
#' list of the same length as the input.
#'
#' * `map_if()` takes a predicate function `.p` as input to determine
#' which elements of `.x` are transformed with `.f`.
#'
#' * `map_at()` takes a vector of names or positions `.at` to specify
#' which elements of `.x` are transformed with `.f`.
#'
#' @inheritParams map
#' @param .p A single predicate function, a formula describing such a
#' predicate function, or a logical vector of the same length as `.x`.
#' Alternatively, if the elements of `.x` are themselves lists of
#' objects, a string indicating the name of a logical element in the
#' inner lists. Only those elements where `.p` evaluates to
#' `TRUE` will be modified.
#' @param .else A function applied to elements of `.x` for which `.p`
#' returns `FALSE`.
#' @export
#' @family map variants
#' @examples
#' # Use a predicate function to decide whether to map a function:
#' iris |> map_if(is.factor, as.character) |> str()
#'
#' # Specify an alternative with the `.else` argument:
#' iris |> map_if(is.factor, as.character, .else = as.integer) |> str()
#'
#' # Use numeric vector of positions select elements to change:
#' iris |> map_at(c(4, 5), is.numeric) |> str()
#'
#' # Use vector of names to specify which elements to change:
#' iris |> map_at("Species", toupper) |> str()
map_if <- function(.x, .p, .f, ..., .else = NULL) {
where <- where_if(.x, .p)
out <- vector("list", length(.x))
out[where] <- map(.x[where], .f, ...)
if (is_null(.else)) {
out[!where] <- .x[!where]
} else {
out[!where] <- map(.x[!where], .else, ...)
}
set_names(out, names(.x))
}
#' @rdname map_if
#' @param .at A logical, integer, or character vector giving the elements
#' to select. Alternatively, a function that takes a vector of names,
#' and returns a logical, integer, or character vector of elements to select.
#'
#' `r lifecycle::badge("deprecated")`: if the tidyselect package is
#' installed, you can use `vars()` and tidyselect helpers to select
#' elements.
#' @export
map_at <- function(.x, .at, .f, ..., .progress = FALSE) {
where <- where_at(.x, .at, user_env = caller_env())
out <- vector("list", length(.x))
out[where] <- map(.x[where], .f, ..., .progress = .progress)
out[!where] <- .x[!where]
set_names(out, names(.x))
}
purrr/R/utils.R 0000644 0001762 0000144 00000007274 14355125340 013124 0 ustar ligges users where_at <- function(x,
at,
user_env,
error_arg = caller_arg(at),
error_call = caller_env()) {
if (is_formula(at)) {
at <- rlang::as_function(at, arg = error_arg, call = error_call)
}
if (is.function(at)) {
at <- at(names2(x))
}
if (is_quosures(at)) {
lifecycle::deprecate_soft(
when = "1.0.0",
what = I("Using `vars()` in .at"),
user_env = user_env
)
check_installed("tidyselect", "for using tidyselect in `map_at()`.")
at <- tidyselect::vars_select(.vars = names2(x), !!!at)
}
if (is.numeric(at) || is.logical(at) || is.character(at)) {
if (is.character(at)) {
at <- intersect(at, names2(x))
}
loc <- vec_as_location(
at,
length(x),
names2(x),
missing = "error",
arg = "at",
call = error_call
)
seq_along(x) %in% loc
} else {
cli::cli_abort(
"{.arg {error_arg}} must be a numeric vector, character vector, or function, not {.obj_type_friendly {at}}.",
arg = error_arg,
call = error_call
)
}
}
where_if <- function(.x, .p, ..., .purrr_error_call = caller_env()) {
if (is_logical(.p)) {
stopifnot(length(.p) == length(.x))
.p
} else {
.p <- as_predicate(.p, ..., .mapper = TRUE, .purrr_error_call = NULL)
map_(.x, .p, ..., .type = "logical", .purrr_error_call = .purrr_error_call)
}
}
as_predicate <- function(.fn,
...,
.mapper,
.allow_na = FALSE,
.purrr_error_call = caller_env(),
.purrr_error_arg = caller_arg(.fn)) {
force(.purrr_error_call)
force(.purrr_error_arg)
if (.mapper) {
.fn <- as_mapper(.fn, ...)
}
function(...) {
out <- .fn(...)
if (!is_bool(out)) {
if (is_na(out) && .allow_na) {
# Always return a logical NA
return(NA)
}
cli::cli_abort(
"{.fn { .purrr_error_arg }} must return a single `TRUE` or `FALSE`, not {.obj_type_friendly {out}}.",
arg = .purrr_error_arg,
call = .purrr_error_call
)
}
out
}
}
paste_line <- function(...) {
paste(chr(...), collapse = "\n")
}
`list_slice2<-` <- function(x, i, value) {
if (is.null(value)) {
x[i] <- list(NULL)
} else {
x[[i]] <- value
}
x
}
vctrs_list_compat <- function(x,
user_env,
error_call = caller_env(),
error_arg = caller_arg(x)) {
out <- vctrs_vec_compat(x, user_env)
vec_check_list(out, call = error_call, arg = error_arg)
out
}
# When we want to use vctrs, but treat lists like purrr does
# Treat data frames and S3 scalar lists like bare lists.
# But ensure rcrd vctrs retain their class.
vctrs_vec_compat <- function(x, user_env) {
if (inherits(x, "by")) {
class(x) <- NULL
}
if (is.null(x)) {
list()
} else if (is.pairlist(x)) {
lifecycle::deprecate_soft(
when = "1.0.0",
what = I("Use of pairlists in map functions"),
details = "Please coerce explicitly with `as.list()`",
user_env = user_env
)
as.list(x)
} else if (is.array(x) && length(dim(x)) > 1) {
dim(x) <- NULL
x
} else if (is_call(x) || is.expression(x)) {
lifecycle::deprecate_soft(
when = "1.0.0",
what = I("Use of calls and pairlists in map functions"),
details = "Please coerce explicitly with `as.list()`",
user_env = user_env
)
as.list(x)
} else if (isS4(x)) {
set_names(lapply(seq_along(x), function(i) x[[i]]), names(x))
} else if (is.data.frame(x) || (is.list(x) && !vec_is(x))) {
unclass(x)
} else {
x
}
}
purrr/R/reexport-rlang.R 0000644 0001762 0000144 00000002061 14310436312 014715 0 ustar ligges users #' @export
rlang::set_names
#' @export
rlang::exec
#' @export
rlang::zap
#' @export
rlang::`%||%`
#' @export
rlang::done
#' @export
rlang::rep_along
# Predicates ---------------------------------------------------
#' @export
rlang::is_bare_list
#' @export
rlang::is_bare_atomic
#' @export
rlang::is_bare_vector
#' @export
rlang::is_bare_double
#' @export
rlang::is_bare_integer
#' @export
rlang::is_bare_numeric
#' @export
rlang::is_bare_character
#' @export
rlang::is_bare_logical
#' @export
rlang::is_list
#' @export
rlang::is_atomic
#' @export
rlang::is_vector
#' @export
rlang::is_integer
#' @export
rlang::is_double
#' @export
rlang::is_character
#' @export
rlang::is_logical
#' @export
rlang::is_null
#' @export
rlang::is_function
#' @export
rlang::is_scalar_list
#' @export
rlang::is_scalar_atomic
#' @export
rlang::is_scalar_vector
#' @export
rlang::is_scalar_double
#' @export
rlang::is_scalar_character
#' @export
rlang::is_scalar_logical
#' @export
rlang::is_scalar_integer
#' @export
rlang::is_empty
#' @export
rlang::is_formula
purrr/R/list-transpose.R 0000644 0001762 0000144 00000012025 14326303247 014743 0 ustar ligges users #' Transpose a list
#'
#' @description
#' `list_transpose()` turns a list-of-lists "inside-out". For instance it turns a pair of
#' lists into a list of pairs, or a list of pairs into a pair of lists. For
#' example, if you had a list of length `n` where each component had values `a`
#' and `b`, `list_transpose()` would make a list with elements `a` and
#' `b` that contained lists of length `n`.
#'
#' It's called transpose because `x[["a"]][["b"]]` is equivalent to
#' `list_transpose(x)[["b"]][["a"]]`, i.e. transposing a list flips the order of
#' indices in a similar way to transposing a matrix.
#'
#' @param x A list of vectors to transpose.
#' @param template A "template" that describes the output list. Can either be
#' a character vector (where elements are extracted by name), or an integer
#' vector (where elements are extracted by position). Defaults to the names
#' of the first element of `x`, or if they're not present, the integer
#' indices.
#' @param simplify Should the result be [simplified][list_simplify]?
#' * `TRUE`: simplify or die trying.
#' * `NA`: simplify if possible.
#' * `FALSE`: never try to simplify, always leaving as a list.
#'
#' Alternatively, a named list specifying the simplification by output
#' element.
#' @param ptype An optional vector prototype used to control the simplification.
#' Alternatively, a named list specifying the prototype by output element.
#' @param default A default value to use if a value is absent or `NULL`.
#' Alternatively, a named list specifying the default by output element.
#' @inheritParams rlang::args_dots_empty
#' @export
#' @examples
#' # list_transpose() is useful in conjunction with safely()
#' x <- list("a", 1, 2)
#' y <- x |> map(safely(log))
#' y |> str()
#' # Put all the errors and results together
#' y |> list_transpose() |> str()
#' # Supply a default result to further simplify
#' y |> list_transpose(default = list(result = NA)) |> str()
#'
#' # list_transpose() will try to simplify by default:
#' x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6))
#' x |> list_transpose()
#' # this makes list_tranpose() not completely symmetric
#' x |> list_transpose() |> list_transpose()
#'
#' # use simplify = FALSE to always return lists:
#' x |> list_transpose(simplify = FALSE) |> str()
#' x |>
#' list_transpose(simplify = FALSE) |>
#' list_transpose(simplify = FALSE) |> str()
#'
#' # Provide an explicit template if you know which elements you want to extract
#' ll <- list(
#' list(x = 1, y = "one"),
#' list(z = "deux", x = 2)
#' )
#' ll |> list_transpose()
#' ll |> list_transpose(template = c("x", "y", "z"))
#' ll |> list_transpose(template = 1)
#'
#' # And specify a default if you want to simplify
#' ll |> list_transpose(template = c("x", "y", "z"), default = NA)
list_transpose <- function(x,
...,
template = NULL,
simplify = NA,
ptype = NULL,
default = NULL) {
vec_check_list(x)
check_dots_empty()
if (length(x) == 0) {
template <- integer()
} else {
template <- template %||% vec_index(x[[1]])
}
if (!is.character(template) && !is.numeric(template)) {
cli::cli_abort(
"{.arg template} must be a character or numeric vector, not {.obj_type_friendly {template}}.",
arg = template
)
}
simplify <- match_template(simplify, template)
default <- match_template(default, template)
ptype <- match_template(ptype, template)
out <- rep_along(template, list())
if (is.character(template)) {
names(out) <- template
}
for (i in seq_along(template)) {
idx <- template[[i]]
res <- map(x, idx, .default = default[[i]])
res <- list_simplify_internal(res,
simplify = simplify[[i]] %||% NA,
ptype = ptype[[i]],
error_arg = result_index(idx)
)
out[[i]] <- res
}
out
}
result_index <- function(idx) {
if (is.character(idx)) {
paste0("result$", idx)
} else {
paste0("result[[", idx, "]]")
}
}
match_template <- function(x, template, error_arg = caller_arg(x), error_call = caller_env()) {
if (is.character(template)) {
if (is_bare_list(x) && is_named(x)) {
extra_names <- setdiff(names(x), template)
if (length(extra_names)) {
cli::cli_abort(
"{.arg {error_arg}} contains unknown names: {.str {extra_names}}.",
arg = error_arg,
call = error_call
)
}
out <- rep_named(template, list(NULL))
out[names(x)] <- x
out
} else {
rep_named(template, list(x))
}
} else if (is.numeric(template)) {
if (is_bare_list(x) && length(x) > 0) {
if (length(x) != length(template)) {
cli::cli_abort(
"Length of {.arg {error_arg}} ({length(x)}) and {.arg template} ({length(template)}) must be the same when transposing by position.",
arg = error_arg,
call = error_call
)
}
x
} else {
rep_along(template, list(x))
}
} else {
abort("Invalid `template`", .internal = TRUE)
}
}
purrr/R/deprec-cross.R 0000644 0001762 0000144 00000015262 14311356421 014347 0 ustar ligges users #' Produce all combinations of list elements
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' These functions were deprecated in purrr 1.0.0 because they
#' are slow and buggy, and we no longer think they are the right
#' approach to solving this problem. Please use `tidyr::expand_grid()`
#' instead.
#'
#' Here is an example of equivalent usages for `cross()` and
#' `expand_grid()`:
#'
#' ```{r}
#' data <- list(
#' id = c("John", "Jane"),
#' sep = c("! ", "... "),
#' greeting = c("Hello.", "Bonjour.")
#' )
#'
#' # With deprecated `cross()`
#' data |> cross() |> map_chr(\(...) paste0(..., collapse = ""))
#'
#' # With `expand_grid()`
#' tidyr::expand_grid(!!!data) |> pmap_chr(paste)
#' ```
#'
#' @details
#' `cross2()` returns the product set of the elements of
#' `.x` and `.y`. `cross3()` takes an additional
#' `.z` argument. `cross()` takes a list `.l` and
#' returns the cartesian product of all its elements in a list, with
#' one combination by element. `cross_df()` is like
#' `cross()` but returns a data frame, with one combination by
#' row.
#'
#' `cross()`, `cross2()` and `cross3()` return the
#' cartesian product is returned in wide format. This makes it more
#' amenable to mapping operations. `cross_df()` returns the output
#' in long format just as `expand.grid()` does. This is adapted
#' to rowwise operations.
#'
#' When the number of combinations is large and the individual
#' elements are heavy memory-wise, it is often useful to filter
#' unwanted combinations on the fly with `.filter`. It must be
#' a predicate function that takes the same number of arguments as the
#' number of crossed objects (2 for `cross2()`, 3 for
#' `cross3()`, `length(.l)` for `cross()`) and
#' returns `TRUE` or `FALSE`. The combinations where the
#' predicate function returns `TRUE` will be removed from the
#' result.
#' @seealso [expand.grid()]
#' @param .x,.y,.z Lists or atomic vectors.
#' @param .l A list of lists or atomic vectors. Alternatively, a data
#' frame. `cross_df()` requires all elements to be named.
#' @param .filter A predicate function that takes the same number of
#' arguments as the number of variables to be combined.
#' @return `cross2()`, `cross3()` and `cross()`
#' always return a list. `cross_df()` always returns a data
#' frame. `cross()` returns a list where each element is one
#' combination so that the list can be directly mapped
#' over. `cross_df()` returns a data frame where each row is one
#' combination.
#' @keywords internal
#' @export
#' @examples
#' # We build all combinations of names, greetings and separators from our
#' # list of data and pass each one to paste()
#' data <- list(
#' id = c("John", "Jane"),
#' greeting = c("Hello.", "Bonjour."),
#' sep = c("! ", "... ")
#' )
#'
#' data |>
#' cross() |>
#' map(lift(paste))
#'
#' # cross() returns the combinations in long format: many elements,
#' # each representing one combination. With cross_df() we'll get a
#' # data frame in long format: crossing three objects produces a data
#' # frame of three columns with each row being a particular
#' # combination. This is the same format that expand.grid() returns.
#' args <- data |> cross_df()
#'
#' # In case you need a list in long format (and not a data frame)
#' # just run as.list() after cross_df()
#' args |> as.list()
#'
#' # This format is often less practical for functional programming
#' # because applying a function to the combinations requires a loop
#' out <- vector("character", length = nrow(args))
#' for (i in seq_along(out))
#' out[[i]] <- invoke("paste", map(args, i))
#' out
#'
#' # It's easier to transpose and then use invoke_map()
#' args |> transpose() |> map_chr(\(x) exec(paste, !!!x))
#'
#' # Unwanted combinations can be filtered out with a predicate function
#' filter <- function(x, y) x >= y
#' cross2(1:5, 1:5, .filter = filter) |> str()
#'
#' # To give names to the components of the combinations, we map
#' # setNames() on the product:
#' x <- seq_len(3)
#' cross2(x, x, .filter = `==`) |>
#' map(setNames, c("x", "y"))
#'
#' # Alternatively we can encapsulate the arguments in a named list
#' # before crossing to get named components:
#' list(x = x, y = x) |>
#' cross(.filter = `==`)
cross <- function(.l, .filter = NULL) {
lifecycle::deprecate_soft(
"1.0.0",
"purrr::cross()",
"tidyr::expand_grid()",
details = c(i = "See .")
)
if (is_empty(.l)) {
return(.l)
}
if (!is.null(.filter)) {
.filter <- as_mapper(.filter)
}
n <- length(.l)
lengths <- lapply(.l, length)
names <- names(.l)
factors <- cumprod(lengths)
total_length <- factors[n]
factors <- c(1, factors[-n])
out <- replicate(total_length, vector("list", n), simplify = FALSE)
for (i in seq_along(out)) {
for (j in seq_len(n)) {
index <- floor((i - 1) / factors[j]) %% length(.l[[j]]) + 1
out[[i]][[j]] <- .l[[j]][[index]]
}
names(out[[i]]) <- names
# Filter out unwanted elements. We set them to NULL instead of
# completely removing them so we don't mess up the loop indexing.
# NULL elements are removed later on.
if (!is.null(.filter)) {
is_to_filter <- do.call(".filter", unname(out[[i]]))
if (!is_bool(is_to_filter)) {
cli::cli_abort(
"The filter function must return a single `TRUE` or `FALSE`, not {.obj_type_friendly {is_to_filter}}."
)
}
if (is_to_filter) {
out[i] <- list(NULL)
}
}
}
# Remove filtered elements
compact(out)
}
#' @export
#' @rdname cross
cross2 <- function(.x, .y, .filter = NULL) {
lifecycle::deprecate_soft(
"1.0.0",
"purrr::cross2()",
"tidyr::expand_grid()",
details = c(i = "See .")
)
cross(list(.x, .y), .filter = .filter)
}
#' @export
#' @rdname cross
cross3 <- function(.x, .y, .z, .filter = NULL) {
lifecycle::deprecate_soft(
"1.0.0",
"purrr::cross3()",
"tidyr::expand_grid()",
details = c(i = "See .")
)
cross(list(.x, .y, .z), .filter = .filter)
}
#' @rdname cross
#' @export
cross_df <- function(.l, .filter = NULL) {
lifecycle::deprecate_soft(
"1.0.0",
"purrr::cross_df()",
"tidyr::expand_grid()",
details = c(i = "See .")
)
check_installed("tibble")
cross(.l, .filter = .filter) %>%
transpose() %>%
simplify_all() %>%
tibble::as_tibble()
}
#' @export
#' @usage NULL
#' @rdname cross
cross_n <- function(...) {
lifecycle::deprecate_stop("0.2.3", "purrr::cross_n()")
cross(...)
}
#' @export
#' @usage NULL
#' @rdname cross
cross_d <- function(...) {
lifecycle::deprecate_stop("0.2.3", "purrr::cross_d()")
cross_df(...)
}
purrr/R/deprec-map.R 0000644 0001762 0000144 00000000517 14326047353 013777 0 ustar ligges users #' Map at depth
#'
#' This function is defunct and has been replaced by [map_depth()].
#' See also [modify_depth()] for a version that preserves the types of
#' the elements of the tree.
#'
#' @export
#' @keywords internal
at_depth <- function(.x, .depth, .f, ...) {
lifecycle::deprecate_stop("0.3.0", "at_depth()", "map_depth()")
}
purrr/R/adverb-quietly.R 0000644 0001762 0000144 00000002412 14350140332 014677 0 ustar ligges users #' Wrap a function to capture side-effects
#'
#' Create a modified version of `.f` that captures side-effects along with
#' the return value of the function and returns a list containing
#' the `result`, `output`, `messages` and `warnings`.
#'
#' @inheritParams safely
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' f <- function() {
#' print("Hi!")
#' message("Hello")
#' warning("How are ya?")
#' "Gidday"
#' }
#' f()
#'
#' f_quiet <- quietly(f)
#' str(f_quiet())
quietly <- function(.f) {
.f <- as_mapper(.f)
function(...) capture_output(.f(...))
}
capture_output <- function(code) {
warnings <- character()
wHandler <- function(w) {
warnings <<- c(warnings, conditionMessage(w))
invokeRestart("muffleWarning")
}
messages <- character()
mHandler <- function(m) {
messages <<- c(messages, conditionMessage(m))
invokeRestart("muffleMessage")
}
temp <- file()
sink(temp)
on.exit({
sink()
close(temp)
})
result <- withCallingHandlers(
code,
warning = wHandler,
message = mHandler
)
output <- paste0(readLines(temp, warn = FALSE), collapse = "\n")
list(
result = result,
output = output,
warnings = warnings,
messages = messages
)
}
purrr/R/map-mapper.R 0000644 0001762 0000144 00000006422 14460274444 014024 0 ustar ligges users #' Convert an object into a mapper function
#'
#' `as_mapper` is the powerhouse behind the varied function
#' specifications that most purrr functions allow. It is an S3
#' generic. The default method forwards its arguments to
#' [rlang::as_function()].
#'
#' @param .f A function, formula, or vector (not necessarily atomic).
#'
#' If a __function__, it is used as is.
#'
#' If a __formula__, e.g. `~ .x + 2`, it is converted to a function. There
#' are three ways to refer to the arguments:
#'
#' * For a single argument function, use `.`
#' * For a two argument function, use `.x` and `.y`
#' * For more arguments, use `..1`, `..2`, `..3` etc
#'
#' This syntax allows you to create very compact anonymous
#' functions. Note that formula functions conceptually take dots
#' (that's why you can use `..1` etc). They silently ignore
#' additional arguments that are not used in the formula expression.
#'
#' If __character vector__, __numeric vector__, or __list__, it is
#' converted to an extractor function. Character vectors index by
#' name and numeric vectors index by position; use a list to index
#' by position and name at different levels. If a component is not
#' present, the value of `.default` will be returned.
#' @param .default,.null Optional additional argument for extractor functions
#' (i.e. when `.f` is character, integer, or list). Returned when
#' value is absent (does not exist) or empty (has length 0).
#' `.null` is deprecated; please use `.default` instead.
#' @param ... Additional arguments passed on to methods.
#' @export
#' @examples
#' as_mapper(\(x) x + 1)
#' as_mapper(1)
#'
#' as_mapper(c("a", "b", "c"))
#' # Equivalent to function(x) x[["a"]][["b"]][["c"]]
#'
#' as_mapper(list(1, "a", 2))
#' # Equivalent to function(x) x[[1]][["a"]][[2]]
#'
#' as_mapper(list(1, attr_getter("a")))
#' # Equivalent to function(x) attr(x[[1]], "a")
#'
#' as_mapper(c("a", "b", "c"), .default = NA)
as_mapper <- function(.f, ...) {
UseMethod("as_mapper")
}
#' @export
as_mapper.default <- function(.f, ...) {
if (typeof(.f) %in% c("special", "builtin")) {
.f <- rlang::as_closure(.f)
# Workaround until fixed in rlang
if (is_reference(fn_env(.f), base_env())) {
environment(.f) <- global_env()
}
.f
} else {
rlang::as_function(.f)
}
}
#' @export
#' @rdname as_mapper
as_mapper.character <- function(.f, ..., .null, .default = NULL) {
.default <- find_extract_default(.null, .default)
plucker(as.list(.f), .default)
}
#' @export
#' @rdname as_mapper
as_mapper.numeric <- function(.f, ..., .null, .default = NULL) {
.default <- find_extract_default(.null, .default)
plucker(as.list(.f), .default)
}
#' @export
#' @rdname as_mapper
as_mapper.list <- function(.f, ..., .null, .default = NULL) {
.default <- find_extract_default(.null, .default)
plucker(.f, .default)
}
find_extract_default <- function(.null, .default) {
if (!missing(.null)) {
# warning("`.null` is deprecated; please use `.default` instead", call. = FALSE)
.null
} else {
.default
}
}
plucker <- function(i, default) {
x <- NULL # supress global variables check NOTE
i <- as.list(i)
# Use metaprogramming to create function that prints nicely
new_function(
exprs(x = , ... = ),
expr(pluck_raw(x, !!i, .default = !!default))
)
}
purrr/R/map-depth.R 0000644 0001762 0000144 00000011541 14350140332 013624 0 ustar ligges users #' Map/modify elements at given depth
#'
#' `map_depth()` calls `map(.y, .f)` on all `.y` at the specified `.depth` in
#' `.x`. `modify_depth()` calls `modify(.y, .f)` on `.y` at the specified
#' `.depth` in `.x`.
#'
#' @inheritParams map
#' @param .depth Level of `.x` to map on. Use a negative value to
#' count up from the lowest level of the list.
#'
#' * `map_depth(x, 0, fun)` is equivalent to `fun(x)`.
#' * `map_depth(x, 1, fun)` is equivalent to `x <- map(x, fun)`
#' * `map_depth(x, 2, fun)` is equivalent to `x <- map(x, \(y) map(y, fun))`
#' @param .ragged If `TRUE`, will apply to leaves, even if they're not
#' at depth `.depth`. If `FALSE`, will throw an error if there are
#' no elements at depth `.depth`.
#' @inheritParams modify_tree
#' @seealso [modify_tree()] for a recursive version of `modify_depth()` that
#' allows you to apply a function to every leaf or every node.
#' @family map variants
#' @family modify variants
#' @export
#' @examples
#' # map_depth() -------------------------------------------------
#' # Use `map_depth()` to recursively traverse nested vectors and map
#' # a function at a certain depth:
#' x <- list(a = list(foo = 1:2, bar = 3:4), b = list(baz = 5:6))
#' x |> str()
#' x |> map_depth(2, \(y) paste(y, collapse = "/")) |> str()
#'
#' # Equivalent to:
#' x |> map(\(y) map(y, \(z) paste(z, collapse = "/"))) |> str()
#'
#' # When ragged is TRUE, `.f()` will also be passed leaves at depth < `.depth`
#' x <- list(1, list(1, list(1, list(1, 1))))
#' x |> str()
#' x |> map_depth(4, \(x) length(unlist(x)), .ragged = TRUE) |> str()
#' x |> map_depth(3, \(x) length(unlist(x)), .ragged = TRUE) |> str()
#' x |> map_depth(2, \(x) length(unlist(x)), .ragged = TRUE) |> str()
#' x |> map_depth(1, \(x) length(unlist(x)), .ragged = TRUE) |> str()
#' x |> map_depth(0, \(x) length(unlist(x)), .ragged = TRUE) |> str()
#'
#' # modify_depth() -------------------------------------------------
#' l1 <- list(
#' obj1 = list(
#' prop1 = list(param1 = 1:2, param2 = 3:4),
#' prop2 = list(param1 = 5:6, param2 = 7:8)
#' ),
#' obj2 = list(
#' prop1 = list(param1 = 9:10, param2 = 11:12),
#' prop2 = list(param1 = 12:14, param2 = 15:17)
#' )
#' )
#'
#' # In the above list, "obj" is level 1, "prop" is level 2 and "param"
#' # is level 3. To apply sum() on all params, we map it at depth 3:
#' l1 |> modify_depth(3, sum) |> str()
#'
#' # modify() lets us pluck the elements prop1/param2 in obj1 and obj2:
#' l1 |> modify(c("prop1", "param2")) |> str()
#'
#' # But what if we want to pluck all param2 elements? Then we need to
#' # act at a lower level:
#' l1 |> modify_depth(2, "param2") |> str()
#'
#' # modify_depth() can be with other purrr functions to make them operate at
#' # a lower level. Here we ask pmap() to map paste() simultaneously over all
#' # elements of the objects at the second level. paste() is effectively
#' # mapped at level 3.
#' l1 |> modify_depth(2, \(x) pmap(x, paste, sep = " / ")) |> str()
map_depth <- function(.x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL) {
force(.ragged)
.depth <- check_depth(.depth, pluck_depth(.x, .is_node))
.f <- as_mapper(.f, ...)
.is_node <- as_is_node(.is_node)
map_depth_rec(map, .x, .depth, .f, ..., .ragged = .ragged, .is_node = .is_node)
}
#' @rdname map_depth
#' @export
modify_depth <- function(.x, .depth, .f, ..., .ragged = .depth < 0, .is_node = NULL) {
force(.ragged)
.depth <- check_depth(.depth, pluck_depth(.x, .is_node))
.f <- as_mapper(.f, ...)
.is_node <- as_is_node(.is_node)
map_depth_rec(modify, .x, .depth, .f, ..., .ragged = .ragged, .is_node = .is_node)
}
map_depth_rec <- function(.fmap,
.x,
.depth,
.f,
...,
.ragged,
.is_node,
.purrr_error_call = caller_env()) {
if (.depth == 0) {
if (identical(.fmap, map)) {
return(.f(.x, ...))
} else {
.x[] <- .f(.x, ...)
return(.x)
}
}
if (!.is_node(.x)) {
if (.ragged) {
return(.fmap(.x, .f, ...))
} else {
cli::cli_abort("List not deep enough", call = .purrr_error_call)
}
}
if (.depth == 1) {
.fmap(.x, .f, ...)
} else {
.fmap(.x, function(x) {
map_depth_rec(
.fmap = .fmap,
.x = x,
.depth = .depth - 1,
.f = .f,
...,
.ragged = .ragged,
.is_node = .is_node,
.purrr_error_call = .purrr_error_call
)
})
}
}
check_depth <- function(depth, max_depth, error_call = caller_env()) {
check_number_whole(depth, call = error_call)
if (depth < 0) {
if (-depth > max_depth) {
cli::cli_abort(
"Negative {.arg .depth} ({depth}) must be greater than -{max_depth}.",
arg = ".depth",
call = error_call
)
}
depth <- max_depth + depth
}
depth
}
purrr/R/imap.R 0000644 0001762 0000144 00000003434 14311356421 012702 0 ustar ligges users #' Apply a function to each element of a vector, and its index
#'
#' `imap(x, ...)`, an indexed map, is short hand for
#' `map2(x, names(x), ...)` if `x` has names, or `map2(x, seq_along(x), ...)`
#' if it does not. This is useful if you need to compute on both the value
#' and the position of an element.
#'
#' @param .f A function, specified in one of the following ways:
#'
#' * A named function, e.g. `paste`.
#' * An anonymous function, e.g. `\(x, idx) x + idx` or
#' `function(x, idx) x + idx`.
#' * A formula, e.g. `~ .x + .y`. You must use `.x` to refer to the
#' current element and `.y` to refer to the current index. Only recommended
#' if you require backward compatibility with older versions of R.
#' @inheritParams map
#' @return A vector the same length as `.x`.
#' @export
#' @family map variants
#' @examples
#' imap_chr(sample(10), paste)
#'
#' imap_chr(sample(10), \(x, idx) paste0(idx, ": ", x))
#'
#' iwalk(mtcars, \(x, idx) cat(idx, ": ", median(x), "\n", sep = ""))
imap <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
map2(.x, vec_index(.x), .f, ...)
}
#' @rdname imap
#' @export
imap_lgl <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
map2_lgl(.x, vec_index(.x), .f, ...)
}
#' @rdname imap
#' @export
imap_chr <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
map2_chr(.x, vec_index(.x), .f, ...)
}
#' @rdname imap
#' @export
imap_int <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
map2_int(.x, vec_index(.x), .f, ...)
}
#' @rdname imap
#' @export
imap_dbl <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
map2_dbl(.x, vec_index(.x), .f, ...)
}
#' @export
#' @rdname imap
iwalk <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
walk2(.x, vec_index(.x), .f, ...)
}
vec_index <- function(x) {
names(x) %||% seq_along(x)
}
purrr/R/pluck.R 0000644 0001762 0000144 00000013603 14355042456 013101 0 ustar ligges users #' Safely get or set an element deep within a nested data structure
#'
#' @description
#' `pluck()` implements a generalised form of `[[` that allow you to index
#' deeply and flexibly into data structures. It always succeeds, returning
#' `.default` if the index you are trying to access does not exist or is `NULL`.
#'
#' `pluck<-()` is the assignment equivalent, allowing you to modify an object
#' deep within a nested data structure.
#'
#' `pluck_exists()` tells you whether or not an object exists using the
#' same rules as pluck (i.e. a `NULL` element is equivalent to an absent
#' element).
#'
#' @param .x,x A vector or environment
#' @param ... A list of accessors for indexing into the object. Can be
#' an positive integer, a negative integer (to index from the right),
#' a string (to index into names), or an accessor function
#' (except for the assignment variants which only support names and
#' positions). If the object being indexed is an S4 object,
#' accessing it by name will return the corresponding slot.
#'
#' [Dynamic dots][rlang::dyn-dots] are supported. In particular, if
#' your accessors are stored in a list, you can splice that in with
#' `!!!`.
#' @param .default Value to use if target is `NULL` or absent.
#'
#' @details
#' * You can pluck or chuck with standard accessors like integer
#' positions and string names, and also accepts arbitrary accessor
#' functions, i.e. functions that take an object and return some
#' internal piece.
#'
#' This is often more readable than a mix of operators and accessors
#' because it reads linearly and is free of syntactic
#' cruft. Compare: \code{accessor(x[[1]])$foo} to `pluck(x, 1,
#' accessor, "foo")`.
#'
#' * These accessors never partial-match. This is unlike `$` which
#' will select the `disp` object if you write `mtcars$di`.
#'
#' @seealso [attr_getter()] for creating attribute getters suitable
#' for use with `pluck()` and `chuck()`. [modify_in()] for
#' applying a function to a pluck location.
#' @export
#' @examples
#' # Let's create a list of data structures:
#' obj1 <- list("a", list(1, elt = "foo"))
#' obj2 <- list("b", list(2, elt = "bar"))
#' x <- list(obj1, obj2)
#'
#' # pluck() provides a way of retrieving objects from such data
#' # structures using a combination of numeric positions, vector or
#' # list names, and accessor functions.
#'
#' # Numeric positions index into the list by position, just like `[[`:
#' pluck(x, 1)
#' # same as x[[1]]
#'
#' # Index from the back
#' pluck(x, -1)
#' # same as x[[2]]
#'
#' pluck(x, 1, 2)
#' # same as x[[1]][[2]]
#'
#' # Supply names to index into named vectors:
#' pluck(x, 1, 2, "elt")
#' # same as x[[1]][[2]][["elt"]]
#'
#' # By default, pluck() consistently returns `NULL` when an element
#' # does not exist:
#' pluck(x, 10)
#' try(x[[10]])
#'
#' # You can also supply a default value for non-existing elements:
#' pluck(x, 10, .default = NA)
#'
#' # The map() functions use pluck() by default to retrieve multiple
#' # values from a list:
#' map_chr(x, 1)
#' map_int(x, c(2, 1))
#'
#' # pluck() also supports accessor functions:
#' my_element <- function(x) x[[2]]$elt
#' pluck(x, 1, my_element)
#' pluck(x, 2, my_element)
#'
#' # Even for this simple data structure, this is more readable than
#' # the alternative form because it requires you to read both from
#' # right-to-left and from left-to-right in different parts of the
#' # expression:
#' my_element(x[[1]])
#'
#' # If you have a list of accessors, you can splice those in with `!!!`:
#' idx <- list(1, my_element)
#' pluck(x, !!!idx)
pluck <- function(.x, ..., .default = NULL) {
check_dots_unnamed()
pluck_raw(.x, list2(...), .default = .default)
}
#' @rdname pluck
#' @inheritParams modify_in
#' @export
`pluck<-` <- function(.x, ..., value) {
assign_in(.x, list2(...), value)
}
#' @rdname pluck
#' @export
pluck_exists <- function(.x, ...) {
check_dots_unnamed()
!is_zap(pluck_raw(.x, list2(...), .default = zap()))
}
pluck_raw <- function(.x, index, .default = NULL) {
.Call(
pluck_impl,
x = .x,
index = index,
missing = .default,
strict = FALSE
)
}
#' Get an element deep within a nested data structure, failing if it doesn't
#' exist
#'
#' `chuck()` implements a generalised form of `[[` that allow you to index
#' deeply and flexibly into data structures. If the index you are trying to
#' access does not exist (or is `NULL`), it will throw (i.e. chuck) an error.
#'
#' @seealso [pluck()] for a quiet equivalent.
#' @inheritParams pluck
#' @export
#' @examples
#' x <- list(a = 1, b = 2)
#'
#' # When indexing an element that doesn't exist `[[` sometimes returns NULL:
#' x[["y"]]
#' # and sometimes errors:
#' try(x[[3]])
#'
#' # chuck() consistently errors:
#' try(chuck(x, "y"))
#' try(chuck(x, 3))
chuck <- function(.x, ...) {
check_dots_unnamed()
.Call(
pluck_impl,
x = .x,
index = list2(...),
missing = NULL,
strict = TRUE
)
}
#' Create an attribute getter function
#'
#' `attr_getter()` generates an attribute accessor function; i.e., it
#' generates a function for extracting an attribute with a given
#' name. Unlike the base R `attr()` function with default options, it
#' doesn't use partial matching.
#'
#' @param attr An attribute name as string.
#'
#' @seealso [pluck()]
#' @examples
#' # attr_getter() takes an attribute name and returns a function to
#' # access the attribute:
#' get_rownames <- attr_getter("row.names")
#' get_rownames(mtcars)
#'
#' # These getter functions are handy in conjunction with pluck() for
#' # extracting deeply into a data structure. Here we'll first
#' # extract by position, then by attribute:
#' obj1 <- structure("obj", obj_attr = "foo")
#' obj2 <- structure("obj", obj_attr = "bar")
#' x <- list(obj1, obj2)
#'
#' pluck(x, 1, attr_getter("obj_attr")) # From first object
#' pluck(x, 2, attr_getter("obj_attr")) # From second object
#' @export
attr_getter <- function(attr) {
force(attr)
function(x) attr(x, attr, exact = TRUE)
}
purrr/R/map-raw.R 0000644 0001762 0000144 00000002176 14314671330 013324 0 ustar ligges users #' Functions that return raw vectors
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' These functions were deprecated in purrr 1.0.0 because they are of limited
#' use and you can now use `map_vec()` instead. They are variants of [map()],
#' [map2()], [imap()], [pmap()], and [flatten()] that return raw vectors.
#'
#' @keywords internal
#' @export
map_raw <- function(.x, .f, ...) {
lifecycle::deprecate_soft("1.0.0", "map_raw()", "map_vec()")
map_("raw", .x, .f, ...)
}
#' @export
#' @rdname map_raw
map2_raw <- function(.x, .y, .f, ...) {
lifecycle::deprecate_soft("1.0.0", "map2_raw()", "map2_vec()")
map2_("raw", .x, .y, .f, ...)
}
#' @rdname map_raw
#' @export
imap_raw <- function(.x, .f, ...) {
lifecycle::deprecate_soft("1.0.0", "imap_raw()", "imap_vec()")
map2_("raw", .x, vec_index(.x), .f, ...)
}
#' @export
#' @rdname map_raw
pmap_raw <- function(.l, .f, ...) {
lifecycle::deprecate_soft("1.0.0", "pmap_raw()", "pmap_vec()")
pmap_("raw", .l, .f, ...)
}
#' @export
#' @rdname map_raw
flatten_raw <- function(.x) {
lifecycle::deprecate_soft("1.0.0", "flatten_raw()")
.Call(vflatten_impl, .x, "raw")
}
purrr/R/reexport-pipe.R 0000644 0001762 0000144 00000000214 14311066210 014542 0 ustar ligges users #' Pipe operator
#'
#' @name %>%
#' @rdname pipe
#' @keywords internal
#' @export
#' @importFrom magrittr %>%
#' @usage lhs \%>\% rhs
NULL
purrr/R/adverb-slowly.R 0000644 0001762 0000144 00000001525 14326311377 014554 0 ustar ligges users #' Wrap a function to wait between executions
#'
#' `slowly()` takes a function and modifies it to wait a given
#' amount of time between each call.
#'
#' @inheritParams insistently
#' @param rate A [rate][rate-helpers] object. Defaults to a constant delay.
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' # For these example, we first create a custom rate
#' # with a low waiting time between attempts:
#' rate <- rate_delay(0.1)
#'
#' # slowly() causes a function to sleep for a given time between calls:
#' slow_runif <- slowly(\(x) runif(1), rate = rate, quiet = FALSE)
#' out <- map(1:5, slow_runif)
slowly <- function(f, rate = rate_delay(), quiet = TRUE) {
f <- as_mapper(f)
check_rate(rate)
check_bool(quiet)
function(...) {
rate_sleep(rate, quiet = quiet)
f(...)
}
}
purrr/R/head-tail.R 0000644 0001762 0000144 00000001454 14310436312 013601 0 ustar ligges users #' Find head/tail that all satisfies a predicate.
#'
#' @inheritParams map_if
#' @inheritParams map
#' @return A vector the same type as `.x`.
#' @export
#' @examples
#' pos <- function(x) x >= 0
#' head_while(5:-5, pos)
#' tail_while(5:-5, negate(pos))
#'
#' big <- function(x) x > 100
#' head_while(0:10, big)
#' tail_while(0:10, big)
head_while <- function(.x, .p, ...) {
# Find location of first FALSE
.p <- as_predicate(.p, ..., .mapper = TRUE)
loc <- detect_index(.x, negate(.p), ...)
if (loc == 0) return(.x)
.x[seq_len(loc - 1)]
}
#' @export
#' @rdname head_while
tail_while <- function(.x, .p, ...) {
.p <- as_predicate(.p, ..., .mapper = TRUE)
# Find location of last FALSE
loc <- detect_index(.x, negate(.p), ..., .dir = "backward")
if (loc == 0) return(.x)
.x[-seq_len(loc)]
}
purrr/R/progress-bars.R 0000644 0001762 0000144 00000004470 14355342401 014547 0 ustar ligges users #' Progress bars in purrr
#'
#' @description
#' purrr's map functions have a `.progress` argument that you can use to
#' create a progress bar. `.progress` can be:
#'
#' * `FALSE`, the default: does not create a progress bar.
#' * `TRUE`: creates a basic unnamed progress bar.
#' * A string: creates a basic progress bar with the given name.
#' * A named list of progress bar parameters, as described below.
#'
#' It's good practice to name your progress bars, to make it clear what
#' calculation or process they belong to. We recommend keeping the names
#' under 20 characters, so the whole progress bar fits comfortably even on
#' on narrower displays.
#'
#' ## Progress bar parameters
#'
#' * `clear`: whether to remove the progress bar from the screen after
#' termination. Defaults to `TRUE`.
#' * `format`: format string. This overrides the default format string of
#' the progress bar type. It must be given for the `custom` type.
#' Format strings may contain R expressions to evaluate in braces.
#' They support cli [pluralization][cli::pluralization], and
#' [styling][inline-markup] and they can contain special
#' [progress variables][cli::progress-variables].
#' * `format_done`: format string for successful termination. By default
#' the same as `format`.
#' * `format_failed`: format string for unsuccessful termination.
#' By default the same as `format`.
#' * `name`: progress bar name. This is by default the empty string and it
#' is displayed at the beginning of the progress bar.
#' * `show_after`: numeric scalar. Only show the progress bar after this
#' number of seconds. It overrides the `cli.progress_show_after`
#' global option.
#' * `type`: progress bar type. Currently supported types are:
#' * `iterator`: the default, a for loop or a mapping function,
#' * `tasks`: a (typically small) number of tasks,
#' * `download`: download of one file,
#' * `custom`: custom type, `format` must not be `NULL` for this type.
#' The default display is different for each progress bar type.
#'
#' ## Further documentation
#'
#' purrr's progress bars are powered by cli, so see
#' [Introduction to progress bars in cli](https://cli.r-lib.org/articles/progress.html)
#' and [Advanced cli progress bars](https://cli.r-lib.org/articles/progress-advanced.html)
#' for more details.
#'
#' @name progress_bars
NULL
purrr/R/arrays.R 0000644 0001762 0000144 00000005150 14311356421 013252 0 ustar ligges users #' Coerce array to list
#'
#' `array_branch()` and `array_tree()` enable arrays to be
#' used with purrr's functionals by turning them into lists. The
#' details of the coercion are controlled by the `margin`
#' argument. `array_tree()` creates an hierarchical list (a tree)
#' that has as many levels as dimensions specified in `margin`,
#' while `array_branch()` creates a flat list (by analogy, a
#' branch) along all mentioned dimensions.
#'
#' When no margin is specified, all dimensions are used by
#' default. When `margin` is a numeric vector of length zero, the
#' whole array is wrapped in a list.
#' @param array An array to coerce into a list.
#' @param margin A numeric vector indicating the positions of the
#' indices to be to be enlisted. If `NULL`, a full margin is
#' used. If `numeric(0)`, the array as a whole is wrapped in a
#' list.
#' @name array-coercion
#' @export
#' @examples
#' # We create an array with 3 dimensions
#' x <- array(1:12, c(2, 2, 3))
#'
#' # A full margin for such an array would be the vector 1:3. This is
#' # the default if you don't specify a margin
#'
#' # Creating a branch along the full margin is equivalent to
#' # as.list(array) and produces a list of size length(x):
#' array_branch(x) |> str()
#'
#' # A branch along the first dimension yields a list of length 2
#' # with each element containing a 2x3 array:
#' array_branch(x, 1) |> str()
#'
#' # A branch along the first and third dimensions yields a list of
#' # length 2x3 whose elements contain a vector of length 2:
#' array_branch(x, c(1, 3)) |> str()
#'
#' # Creating a tree from the full margin creates a list of lists of
#' # lists:
#' array_tree(x) |> str()
#'
#' # The ordering and the depth of the tree are controlled by the
#' # margin argument:
#' array_tree(x, c(3, 1)) |> str()
array_branch <- function(array, margin = NULL) {
dims <- dim(array) %||% length(array)
margin <- margin %||% seq_along(dims)
if (length(margin) == 0) {
list(array)
} else if (is.null(dim(array))) {
if (!identical(as.integer(margin), 1L)) {
cli::cli_abort(
"{.arg margin} must be `NULL` or `1` with 1D arrays, not {.str {margin}}.",
arg = "margin"
)
}
as.list(array)
} else {
list_flatten(apply(array, margin, list))
}
}
#' @rdname array-coercion
#' @export
array_tree <- function(array, margin = NULL) {
dims <- dim(array) %||% length(array)
margin <- margin %||% seq_along(dims)
if (length(margin) > 1) {
new_margin <- ifelse(margin[-1] > margin[[1]], margin[-1] - 1, margin[-1])
apply(array, margin[[1]], array_tree, new_margin)
} else {
array_branch(array, margin)
}
}
purrr/R/deprec-utils.R 0000644 0001762 0000144 00000003350 14313331715 014352 0 ustar ligges users #' Infix attribute accessor
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 0.3.0. Instead, lease use the `%@%`
#' operator exported in rlang. It has an interface more consistent with `@`:
#' uses NSE, supports S4 fields, and has an assignment variant.
#'
#' @param x Object
#' @param name Attribute name
#' @export
#' @name get-attr
#' @keywords internal
`%@%` <- function(x, name) {
lifecycle::deprecate_warn("0.3.0", I("%@%"), I("rlang::%@%"), always = TRUE)
attr(x, name, exact = TRUE)
}
#' Generate random sample from a Bernoulli distribution
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 because it's not related to the
#' core purpose of purrr.
#'
#' @param n Number of samples
#' @param p Probability of getting `TRUE`
#' @return A logical vector
#' @keywords internal
#' @export
#' @examples
#' rbernoulli(10)
#' rbernoulli(100, 0.1)
rbernoulli <- function(n, p = 0.5) {
lifecycle::deprecate_soft("1.0.0", "rbernoulli()")
stats::runif(n) > (1 - p)
}
#' Generate random sample from a discrete uniform distribution
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 because it's not related to the
#' core purpose of purrr.
#'
#' @param n Number of samples to draw.
#' @param a,b Range of the distribution (inclusive).
#' @keywords internal
#' @export
#' @examples
#' table(rdunif(1e3, 10))
#' table(rdunif(1e3, 10, -5))
rdunif <- function(n, b, a = 1) {
lifecycle::deprecate_soft("1.0.0", "rdunif()")
stopifnot(is.numeric(a), length(a) == 1)
stopifnot(is.numeric(b), length(b) == 1)
a1 <- min(a, b)
b1 <- max(a, b)
sample(b1 - a1 + 1, n, replace = TRUE) + a1 - 1
}
purrr/R/deprec-invoke.R 0000644 0001762 0000144 00000012411 14314671330 014504 0 ustar ligges users #' Invoke functions.
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' These functions were superded in purrr 0.3.0 and deprecated in purrr 1.0.0.
#'
#' * `invoke()` is deprecated in favour of the simpler `exec()` function
#' reexported from rlang. `exec()` evaluates a function call built
#' from its inputs and supports [dynamic dots][rlang::dyn-dots]:
#'
#' ```R
#' # Before:
#' invoke(mean, list(na.rm = TRUE), x = 1:10)
#'
#' # After
#' exec(mean, 1:10, !!!list(na.rm = TRUE))
#' ```
#'
#' * `invoke_map()` is deprecated because it's harder to understand than the
#' corresponding code using `map()`/`map2()` and `exec()`:
#'
#' ```R
#' # Before:
#' invoke_map(fns, list(args))
#' invoke_map(fns, list(args1, args2))
#'
#' # After:
#' map(fns, exec, !!!args)
#' map2(fns, list(args1, args2), \(fn, args) exec(fn, !!!args))
#' ```
#' @param .f For `invoke`, a function; for `invoke_map` a
#' list of functions.
#' @param .x For `invoke`, an argument-list; for `invoke_map` a
#' list of argument-lists the same length as `.f` (or length 1).
#' The default argument, `list(NULL)`, will be recycled to the
#' same length as `.f`, and will call each function with no
#' arguments (apart from any supplied in `...`.
#' @param ... Additional arguments passed to each function.
#' @param .env Environment in which [do.call()] should
#' evaluate a constructed expression. This only matters if you pass
#' as `.f` the name of a function rather than its value, or as
#' `.x` symbols of objects rather than their values.
#' @keywords internal
#' @examples
#' # was
#' invoke(runif, list(n = 10))
#' invoke(runif, n = 10)
#' # now
#' exec(runif, n = 10)
#'
#' # was
#' args <- list("01a", "01b")
#' invoke(paste, args, sep = "-")
#' # now
#' exec(paste, !!!args, sep = "-")
#'
#' # was
#' funs <- list(runif, rnorm)
#' funs |> invoke_map(n = 5)
#' funs |> invoke_map(list(list(n = 10), list(n = 5)))
#'
#' # now
#' funs |> map(exec, n = 5)
#' funs |> map2(list(list(n = 10), list(n = 5)), function(f, args) exec(f, !!!args))
#'
#' # or use pmap + a tibble
#' df <- tibble::tibble(
#' fun = list(runif, rnorm),
#' args = list(list(n = 10), list(n = 5))
#' )
#' df |> pmap(function(fun, args) exec(fun, !!!args))
#'
#'
#' # was
#' list(m1 = mean, m2 = median) |> invoke_map(x = rcauchy(100))
#' # now
#' list(m1 = mean, m2 = median) |> map(function(f) f(rcauchy(100)))
#'
#' @export
invoke <- function(.f, .x = NULL, ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke()", "exec()")
.env <- .env %||% parent.frame()
args <- c(as.list(.x), list(...))
do.call(.f, args, envir = .env)
}
as_invoke_function <- function(f) {
if (is.function(f)) {
list(f)
} else {
f
}
}
#' @rdname invoke
#' @export
invoke_map <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_map()", I("map() + exec()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
invoke_map_lgl <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_lgl()", I("map_lgl() + exec()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_lgl(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
invoke_map_int <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_int()", I("map_int() + exec()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_int(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
invoke_map_dbl <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_dbl()", I("map_dbl() + exec()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_dbl(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
invoke_map_chr <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_chr()", I("map_chr() + exec()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_chr(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
invoke_map_raw <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_raw()", I("map_raw() + exec()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_("raw", .f, .x, invoke, ...)
}
#' @rdname invoke
#' @export
invoke_map_dfr <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_df()", I("map() + exec() + list_rbind()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_dfr(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
invoke_map_dfc <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_dfc()", I("map() + exec() + list_cbind()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_dfc(.f, .x, invoke, ..., .env = .env)
}
#' @rdname invoke
#' @export
#' @usage NULL
invoke_map_df <- function(.f, .x = list(NULL), ..., .env = NULL) {
lifecycle::deprecate_soft("1.0.0", "invoke_df()", I("map() + exec() + list_rbind()"))
.env <- .env %||% parent.frame()
.f <- as_invoke_function(.f)
map2_dfr(.f, .x, invoke, ..., .env = .env)
}
purrr/R/map.R 0000644 0001762 0000144 00000016750 14460311734 012541 0 ustar ligges users #' Apply a function to each element of a vector
#'
#' @description
#' The map functions transform their input by applying a function to
#' each element of a list or atomic vector and returning an object of
#' the same length as the input.
#'
#' * `map()` always returns a list. See the [modify()] family for
#' versions that return an object of the same type as the input.
#'
#' * `map_lgl()`, `map_int()`, `map_dbl()` and `map_chr()` return an
#' atomic vector of the indicated type (or die trying). For these functions,
#' `.f` must return a length-1 vector of the appropriate type.
#'
#' * `map_vec()` simplifies to the common type of the output. It works with
#' most types of simple vectors like Date, POSIXct, factors, etc.
#'
#' * `walk()` calls `.f` for its side-effect and returns
#' the input `.x`.
#'
#' @param .x A list or atomic vector.
#' @param .f A function, specified in one of the following ways:
#'
#' * A named function, e.g. `mean`.
#' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`.
#' * A formula, e.g. `~ .x + 1`. You must use `.x` to refer to the first
#' argument. Only recommended if you require backward compatibility with
#' older versions of R.
#' * A string, integer, or list, e.g. `"idx"`, `1`, or `list("idx", 1)` which
#' are shorthand for `\(x) pluck(x, "idx")`, `\(x) pluck(x, 1)`, and
#' `\(x) pluck(x, "idx", 1)` respectively. Optionally supply `.default` to
#' set a default value if the indexed element is `NULL` or does not exist.
#'
#' @param ... Additional arguments passed on to the mapped function.
#'
#' We now generally recommend against using `...` to pass additional
#' (constant) arguments to `.f`. Instead use a shorthand anonymous function:
#'
#' ```R
#' # Instead of
#' x |> map(f, 1, 2, collapse = ",")
#' # do:
#' x |> map(\(x) f(x, 1, 2, collapse = ","))
#' ```
#'
#' This makes it easier to understand which arguments belong to which
#' function and will tend to yield better error messages.
#'
#' @param .progress Whether to show a progress bar. Use `TRUE` to turn on
#' a basic progress bar, use a string to give it a name, or see
#' [progress_bars] for more details.
#' @returns
#' The output length is determined by the length of the input.
#' The output names are determined by the input names.
#' The output type is determined by the suffix:
#'
#' * No suffix: a list; `.f()` can return anything.
#'
#' * `_lgl()`, `_int()`, `_dbl()`, `_chr()` return a logical, integer, double,
#' or character vector respectively; `.f()` must return a compatible atomic
#' vector of length 1.
#'
#' * `_vec()` return an atomic or S3 vector, the same type that `.f` returns.
#' `.f` can return pretty much any type of vector, as long as its length 1.
#'
#' * `walk()` returns the input `.x` (invisibly). This makes it easy to
#' use in a pipe. The return value of `.f()` is ignored.
#'
#' Any errors thrown by `.f` will be wrapped in an error with class
#' [purrr_error_indexed].
#' @export
#' @family map variants
#' @seealso [map_if()] for applying a function to only those elements
#' of `.x` that meet a specified condition.
#' @examples
#' # Compute normal distributions from an atomic vector
#' 1:10 |>
#' map(rnorm, n = 10)
#'
#' # You can also use an anonymous function
#' 1:10 |>
#' map(\(x) rnorm(10, x))
#'
#' # Simplify output to a vector instead of a list by computing the mean of the distributions
#' 1:10 |>
#' map(rnorm, n = 10) |> # output a list
#' map_dbl(mean) # output an atomic vector
#'
#' # Using set_names() with character vectors is handy to keep track
#' # of the original inputs:
#' set_names(c("foo", "bar")) |> map_chr(paste0, ":suffix")
#'
#' # Working with lists
#' favorite_desserts <- list(Sophia = "banana bread", Eliott = "pancakes", Karina = "chocolate cake")
#' favorite_desserts |> map_chr(\(food) paste(food, "rocks!"))
#'
#' # Extract by name or position
#' # .default specifies value for elements that are missing or NULL
#' l1 <- list(list(a = 1L), list(a = NULL, b = 2L), list(b = 3L))
#' l1 |> map("a", .default = "???")
#' l1 |> map_int("b", .default = NA)
#' l1 |> map_int(2, .default = NA)
#'
#' # Supply multiple values to index deeply into a list
#' l2 <- list(
#' list(num = 1:3, letters[1:3]),
#' list(num = 101:103, letters[4:6]),
#' list()
#' )
#' l2 |> map(c(2, 2))
#'
#' # Use a list to build an extractor that mixes numeric indices and names,
#' # and .default to provide a default value if the element does not exist
#' l2 |> map(list("num", 3))
#' l2 |> map_int(list("num", 3), .default = NA)
#'
#' # Working with data frames
#' # Use map_lgl(), map_dbl(), etc to return a vector instead of a list:
#' mtcars |> map_dbl(sum)
#'
#' # A more realistic example: split a data frame into pieces, fit a
#' # model to each piece, summarise and extract R^2
#' mtcars |>
#' split(mtcars$cyl) |>
#' map(\(df) lm(mpg ~ wt, data = df)) |>
#' map(summary) |>
#' map_dbl("r.squared")
map <- function(.x, .f, ..., .progress = FALSE) {
map_("list", .x, .f, ..., .progress = .progress)
}
#' @rdname map
#' @export
map_lgl <- function(.x, .f, ..., .progress = FALSE) {
map_("logical", .x, .f, ..., .progress = .progress)
}
#' @rdname map
#' @export
map_int <- function(.x, .f, ..., .progress = FALSE) {
map_("integer", .x, .f, ..., .progress = .progress)
}
#' @rdname map
#' @export
map_dbl <- function(.x, .f, ..., .progress = FALSE) {
map_("double", .x, .f, ..., .progress = .progress)
}
#' @rdname map
#' @export
map_chr <- function(.x, .f, ..., .progress = FALSE) {
local_deprecation_user_env()
map_("character", .x, .f, ..., .progress = .progress)
}
map_ <- function(.type,
.x,
.f,
...,
.progress = FALSE,
.purrr_user_env = caller_env(2),
.purrr_error_call = caller_env()) {
.x <- vctrs_vec_compat(.x, .purrr_user_env)
vec_assert(.x, arg = ".x", call = .purrr_error_call)
n <- vec_size(.x)
names <- vec_names(.x)
.f <- as_mapper(.f, ...)
i <- 0L
with_indexed_errors(
i = i,
names = names,
error_call = .purrr_error_call,
call_with_cleanup(map_impl, environment(), .type, .progress, n, names, i)
)
}
#' @rdname map
#' @param .ptype If `NULL`, the default, the output type is the common type
#' of the elements of the result. Otherwise, supply a "prototype" giving
#' the desired type of output.
#' @export
map_vec <- function(.x, .f, ..., .ptype = NULL, .progress = FALSE) {
out <- map(.x, .f, ..., .progress = .progress)
simplify_impl(out, ptype = .ptype)
}
#' @rdname map
#' @export
walk <- function(.x, .f, ..., .progress = FALSE) {
map(.x, .f, ..., .progress = .progress)
invisible(.x)
}
with_indexed_errors <- function(expr, i, names = NULL, error_call = caller_env()) {
withCallingHandlers(
expr,
error = function(cnd) {
if (i == 0L) {
# Error happened before or after loop
} else {
message <- c(i = "In index: {i}.")
if (!is.null(names) && !is.na(names[[i]]) && names[[i]] != "") {
name <- names[[i]]
message <- c(message, i = "With name: {name}.")
} else {
name <- NULL
}
cli::cli_abort(
message,
location = i,
name = name,
parent = cnd,
call = error_call,
class = "purrr_error_indexed"
)
}
}
)
}
#' Indexed errors (`purrr_error_indexed`)
#'
#' @description
#'
#' ```{r, child = "man/rmd/indexed-error.Rmd"}
#' ```
#'
#' @keywords internal
#' @name purrr_error_indexed
NULL
purrr/R/adverb-possibly.R 0000644 0001762 0000144 00000001517 14350140332 015054 0 ustar ligges users #' Wrap a function to return a value instead of an error
#'
#' Create a modified version of `.f` that return a default value (`otherwise`)
#' whenever an error occurs.
#'
#' @inheritParams safely
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' # To replace errors with a default value, use possibly().
#' list("a", 10, 100) |>
#' map_dbl(possibly(log, NA_real_))
#'
#' # The default, NULL, will be discarded with `list_c()`
#' list("a", 10, 100) |>
#' map(possibly(log)) |>
#' list_c()
possibly <- function(.f, otherwise = NULL, quiet = TRUE) {
.f <- as_mapper(.f)
force(otherwise)
check_bool(quiet)
function(...) {
tryCatch(.f(...),
error = function(e) {
if (!quiet)
message("Error: ", conditionMessage(e))
otherwise
}
)
}
}
purrr/R/adverb-partial.R 0000644 0001762 0000144 00000016117 14326311377 014662 0 ustar ligges users #' Partially apply a function, filling in some arguments
#'
#' Partial function application allows you to modify a function by pre-filling
#' some of the arguments. It is particularly useful in conjunction with
#' functionals and other function operators.
#'
#' @details
#' `partial()` creates a function that takes `...` arguments. Unlike
#' [compose()] and other function operators like [negate()], it
#' doesn't reuse the function signature of `.f`. This is because
#' `partial()` explicitly supports NSE functions that use
#' `substitute()` on their arguments. The only way to support those is
#' to forward arguments through dots.
#'
#' Other unsupported patterns:
#'
#' - It is not possible to call `partial()` repeatedly on the same
#' argument to pre-fill it with a different expression.
#'
#' - It is not possible to refer to other arguments in pre-filled
#' argument.
#'
#' @param .f a function. For the output source to read well, this should be a
#' named function.
#' @param ... named arguments to `.f` that should be partially applied.
#'
#' Pass an empty `... = ` argument to specify the position of future
#' arguments relative to partialised ones. See
#' [rlang::call_modify()] to learn more about this syntax.
#'
#' These dots support quasiquotation. If you unquote a value, it is
#' evaluated only once at function creation time. Otherwise, it is
#' evaluated each time the function is called.
#' @param .env `r lifecycle::badge("deprecated")` The environments are
#' now captured via quosures.
#' @param .first `r lifecycle::badge("deprecated")` Please pass an
#' empty argument `... = ` to specify the position of future
#' arguments.
#' @param .lazy `r lifecycle::badge("deprecated")` Please unquote the
#' arguments that should be evaluated once at function creation time
#' with `!!`.
#'
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' # Partial is designed to replace the use of anonymous functions for
#' # filling in function arguments. Instead of:
#' compact1 <- function(x) discard(x, is.null)
#'
#' # we can write:
#' compact2 <- partial(discard, .p = is.null)
#'
#' # partial() works fine with functions that do non-standard
#' # evaluation
#' my_long_variable <- 1:10
#' plot2 <- partial(plot, my_long_variable)
#' plot2()
#' plot2(runif(10), type = "l")
#'
#' # Note that you currently can't partialise arguments multiple times:
#' my_mean <- partial(mean, na.rm = TRUE)
#' my_mean <- partial(my_mean, na.rm = FALSE)
#' try(my_mean(1:10))
#'
#'
#' # The evaluation of arguments normally occurs "lazily". Concretely,
#' # this means that arguments are repeatedly evaluated across invocations:
#' f <- partial(runif, n = rpois(1, 5))
#' f
#' f()
#' f()
#'
#' # You can unquote an argument to fix it to a particular value.
#' # Unquoted arguments are evaluated only once when the function is created:
#' f <- partial(runif, n = !!rpois(1, 5))
#' f
#' f()
#' f()
#'
#'
#' # By default, partialised arguments are passed before new ones:
#' my_list <- partial(list, 1, 2)
#' my_list("foo")
#'
#' # Control the position of these arguments by passing an empty
#' # `... = ` argument:
#' my_list <- partial(list, 1, ... = , 2)
#' my_list("foo")
partial <- function(.f,
...,
.env = deprecated(),
.lazy = deprecated(),
.first = deprecated()) {
args <- enquos(...)
fn_expr <- enexpr(.f)
.fn <- switch(typeof(.f),
builtin = ,
special = as_closure(.f),
closure = .f,
cli::cli_abort(
"{.arg .f} must be a function, not {.obj_type_friendly { .f }}.",
arg = ".f"
)
)
if (lifecycle::is_present(.env)) {
lifecycle::deprecate_warn("0.3.0", "partial(.env)", always = TRUE)
}
if (lifecycle::is_present(.lazy)) {
lifecycle::deprecate_warn("0.3.0", "partial(.lazy)", always = TRUE)
if (!.lazy) {
args <- map(args, ~ new_quosure(eval_tidy(.x , env = caller_env()), empty_env()))
}
}
if (lifecycle::is_present(.first)) {
lifecycle::deprecate_warn("0.3.0", "partial(.first)", always = TRUE)
}
env <- caller_env()
heterogeneous_envs <- !every(args, quo_is_same_env, env)
if (!heterogeneous_envs) {
args <- map(args, quo_get_expr)
}
# Reuse function symbol if possible
fn_sym <- if (is_symbol(fn_expr)) fn_expr else quote(.fn)
if (is_false(.first)) {
# For compatibility
call <- call_modify(call2(fn_sym), ... = , !!!args)
} else {
# Pass on `...` from parent function. It should be last, this way if
# `args` also contain a `...` argument, the position in `args`
# prevails.
call <- call_modify(call2(fn_sym), !!!args, ... = )
}
if (heterogeneous_envs) {
# Forward caller environment where S3 methods might be defined.
# See design note below.
call <- new_quosure(call, env)
# Unwrap quosured arguments if possible
call <- quo_invert(call)
# Derive a mask where dots can be forwarded
mask <- new_data_mask(env(!!fn_sym := .fn))
fn <- function(...) {
mask$... <- environment()$...
eval_tidy(call, mask)
}
} else {
body <- expr({
!!fn_sym <- !!.fn
!!call
})
fn <- new_function(pairlist2(... = ), body, env = env)
}
structure(
fn,
class = c("purrr_function_partial", "function"),
body = call
)
}
#' @export
print.purrr_function_partial <- function(x, ...) {
cat("\n")
body(x) <- partialised_body(x)
print(x, ...)
}
partialised_body <- function(x) attr(x, "body")
# For !!fn_sym <- !!.fn
utils::globalVariables("!<-")
# helpers -----------------------------------------------------------------
quo_invert <- function(call) {
call <- duplicate(call, shallow = TRUE)
if (is_quosure(call)) {
rest <- quo_get_expr(call)
} else {
rest <- call
}
if (!is_call(rest)) {
cli::cli_abort("Expected a call", .internal = TRUE)
}
first_quo <- NULL
# Find first quosured argument. We unwrap constant quosures which
# add no scoping information.
while (!is_null(rest)) {
elt <- node_car(rest)
if (is_quosure(elt)) {
if (quo_is_constant(elt)) {
# Unwrap constant quosures
node_poke_car(rest, quo_get_expr(elt))
} else if (is_null(first_quo)) {
# Record first quosured argument
first_quo <- elt
first_node <- rest
}
}
rest <- node_cdr(rest)
}
if (is_null(first_quo)) {
return(call)
}
# Take the wrapping quosure env as reference if there is one.
# Otherwise, take the first quosure detected in arguments.
if (is_quosure(call)) {
env <- quo_get_env(call)
call <- quo_get_expr(call)
} else {
env <- quo_get_env(first_quo)
}
rest <- first_node
while (!is_null(rest)) {
cur <- node_car(rest)
if (is_quosure(cur) && is_reference(quo_get_env(cur), env)) {
node_poke_car(rest, quo_get_expr(cur))
}
rest <- node_cdr(rest)
}
new_quosure(call, env)
}
quo_is_constant <- function(quo) {
is_reference(quo_get_env(quo), empty_env())
}
quo_is_same_env <- function(x, env) {
quo_env <- quo_get_env(x)
is_reference(quo_env, env) || is_reference(quo_env, empty_env())
}
purrr/R/superseded-map-df.R 0000644 0001762 0000144 00000012500 14330525021 015246 0 ustar ligges users #' Functions that return data frames
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' These [map()], [map2()], [imap()], and [pmap()] variants return data
#' frames by row-binding or column-binding the outputs together.
#'
#' The functions were superseded in purrr 1.0.0 because their names
#' suggest they work like `_lgl()`, `_int()`, etc which require length
#' 1 outputs, but actually they return results of any size because the results
#' are combined without any size checks. Additionally, they use
#' `dplyr::bind_rows()` and `dplyr::bind_cols()` which require dplyr to be
#' installed and have confusing semantics with edge cases. Superseded
#' functions will not go away, but will only receive critical bug fixes.
#'
#' Instead, we recommend using `map()`, `map2()`, etc with [list_rbind()] and
#' [list_cbind()]. These use [vctrs::vec_rbind()] and [vctrs::vec_cbind()]
#' under the hood, and have names that more clearly reflect their semantics.
#'
#' @param .id Either a string or `NULL`. If a string, the output will contain
#' a variable with that name, storing either the name (if `.x` is named) or
#' the index (if `.x` is unnamed) of the input. If `NULL`, the default, no
#' variable will be created.
#'
#' Only applies to `_dfr` variant.
#' @keywords internal
#' @export
#' @examples
#' # map ---------------------------------------------
#' # Was:
#' mtcars |>
#' split(mtcars$cyl) |>
#' map(\(df) lm(mpg ~ wt, data = df)) |>
#' map_dfr(\(mod) as.data.frame(t(as.matrix(coef(mod)))))
#'
#' # Now:
#' mtcars |>
#' split(mtcars$cyl) |>
#' map(\(df) lm(mpg ~ wt, data = df)) |>
#' map(\(mod) as.data.frame(t(as.matrix(coef(mod))))) |>
#' list_rbind()
#'
#' # map2 ---------------------------------------------
#'
#' ex_fun <- function(arg1, arg2){
#' col <- arg1 + arg2
#' x <- as.data.frame(col)
#' }
#' arg1 <- 1:4
#' arg2 <- 10:13
#'
#' # was
#' map2_dfr(arg1, arg2, ex_fun)
#' # now
#' map2(arg1, arg2, ex_fun) |> list_rbind()
#'
#' # was
#' map2_dfc(arg1, arg2, ex_fun)
#' # now
#' map2(arg1, arg2, ex_fun) |> list_cbind()
map_dfr <- function(.x, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "map_dfr()", I("`map()` + `list_rbind()`"))
check_installed("dplyr", "for `map_dfr()`.")
.f <- as_mapper(.f, ...)
res <- map(.x, .f, ...)
dplyr::bind_rows(res, .id = .id)
}
#' @rdname map_dfr
#' @usage NULL
#' @export
map_df <- function(.x, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "map_df()", I("`map()` + `list_rbind()`"))
check_installed("dplyr", "for `map_dfr()`.")
.f <- as_mapper(.f, ...)
res <- map(.x, .f, ...)
dplyr::bind_rows(res, .id = .id)
}
#' @rdname map_dfr
#' @export
map_dfc <- function(.x, .f, ...) {
# in 1.0.0
lifecycle::signal_stage("superseded", "map_dfc()", I("`map()` + `list_cbind()`"))
check_installed("dplyr", "for `map_dfc()`.")
.f <- as_mapper(.f, ...)
res <- map(.x, .f, ...)
dplyr::bind_cols(res)
}
#' @rdname map_dfr
#' @export
imap_dfr <- function(.x, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "imap_dfr()", I("`imap()` + `list_rbind()`"))
.f <- as_mapper(.f, ...)
res <- map2(.x, vec_index(.x), .f, ...)
dplyr::bind_rows(res, .id = .id)
}
#' @rdname map_dfr
#' @export
imap_dfc <- function(.x, .f, ...) {
# in 1.0.0
lifecycle::signal_stage("superseded", "imap_dfc()", I("`imap()` + `list_cbind()`"))
.f <- as_mapper(.f, ...)
res <- map2(.x, vec_index(.x), .f, ...)
dplyr::bind_cols(res)
}
#' @rdname map_dfr
#' @export
map2_dfr <- function(.x, .y, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "map2_dfr()", I("`map2()` + `list_rbind()`"))
check_installed("dplyr", "for `map2_dfr()`.")
.f <- as_mapper(.f, ...)
res <- map2(.x, .y, .f, ...)
dplyr::bind_rows(res, .id = .id)
}
#' @rdname map_dfr
#' @export
map2_dfc <- function(.x, .y, .f, ...) {
# in 1.0.0
lifecycle::signal_stage("superseded", "map2_dfc()", I("`map2()` + `list_cbind()`"))
check_installed("dplyr", "for `map2_dfc()`.")
.f <- as_mapper(.f, ...)
res <- map2(.x, .y, .f, ...)
dplyr::bind_cols(res)
}
#' @rdname map_dfr
#' @export
#' @usage NULL
map2_df <- function(.x, .y, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "map2_df()", I("`map2()` + `list_rbind()`"))
check_installed("dplyr", "for `map2_dfr()`.")
.f <- as_mapper(.f, ...)
res <- map2(.x, .y, .f, ...)
dplyr::bind_rows(res, .id = .id)
}
#' @rdname map_dfr
#' @export
pmap_dfr <- function(.l, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "pmap_dfr()", I("`pmap()` + `list_rbind()`"))
check_installed("dplyr", "for `pmap_dfr()`.")
.f <- as_mapper(.f, ...)
res <- pmap(.l, .f, ...)
dplyr::bind_rows(res, .id = .id)
}
#' @rdname map_dfr
#' @export
pmap_dfc <- function(.l, .f, ...) {
# in 1.0.0
lifecycle::signal_stage("superseded", "pmap_dfc()", I("`pmap()` + `list_cbind()`"))
check_installed("dplyr", "for `pmap_dfc()`.")
.f <- as_mapper(.f, ...)
res <- pmap(.l, .f, ...)
dplyr::bind_cols(res)
}
#' @rdname map_dfr
#' @export
#' @usage NULL
pmap_df <- function(.l, .f, ..., .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "pmap_df()", I("`pmap()` + `list_rbind()`"))
check_installed("dplyr", "for `pmap_dfr()`.")
.f <- as_mapper(.f, ...)
res <- pmap(.l, .f, ...)
dplyr::bind_rows(res, .id = .id)
}
purrr/R/adverb-auto-browse.R 0000644 0001762 0000144 00000003043 14310436312 015455 0 ustar ligges users #' Wrap a function so it will automatically `browse()` on error
#'
#' A function wrapped with `auto_browse()` will automatically enter an
#' interactive debugger using [browser()] when ever it encounters an error.
#'
#' @inheritParams safely
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' # For interactive usage, auto_browse() is useful because it automatically
#' # starts a browser() in the right place.
#' f <- function(x) {
#' y <- 20
#' if (x > 5) {
#' stop("!")
#' } else {
#' x
#' }
#' }
#' if (interactive()) {
#' map(1:6, auto_browse(f))
#' }
#'
auto_browse <- function(.f) {
if (is_primitive(.f)) {
cli::cli_abort(
"{.arg .f} must not be a primitive function.",
arg = ".f"
)
}
function(...) {
withCallingHandlers(
.f(...),
error = function(e) {
# 1: h(simpleError(msg, call))
# 2: .handleSimpleError(function (e) <...>
# 3: stop(...)
frame <- sys.frame(4)
browse_in_frame(frame)
},
warning = function(e) {
if (getOption("warn") >= 2) {
frame <- sys.frame(7)
browse_in_frame(frame)
}
}
)
}
}
browse_in_frame <- function(frame) {
# ESS should problably set `.Platform$GUI == "ESS"`
# In the meantime, check that ESSR is attached
if (is_attached("ESSR")) {
# Workaround ESS issue
with_env(frame, on.exit({
browser()
NULL
}))
return_from(frame)
} else {
eval_bare(quote(browser()), env = frame)
}
}
purrr/R/rate.R 0000644 0001762 0000144 00000013660 14326311377 012720 0 ustar ligges users #' Create delaying rate settings
#'
#' These helpers create rate settings that you can pass to [insistently()] and
#' [slowly()]. You can also use them in your own functions with [rate_sleep()].
#'
#' @param max_times Maximum number of requests to attempt.
#' @param jitter Whether to introduce a random jitter in the waiting time.
#' @examples
#' # A delay rate waits the same amount of time:
#' rate <- rate_delay(0.02)
#' for (i in 1:3) rate_sleep(rate, quiet = FALSE)
#'
#' # A backoff rate waits exponentially longer each time, with random
#' # jitter by default:
#' rate <- rate_backoff(pause_base = 0.2, pause_min = 0.005)
#' for (i in 1:3) rate_sleep(rate, quiet = FALSE)
#' @name rate-helpers
NULL
#' @rdname rate-helpers
#' @param pause Delay between attempts in seconds.
#' @export
rate_delay <- function(pause = 1,
max_times = Inf) {
check_number_decimal(pause, allow_infinite = TRUE, min = 0)
new_rate(
"purrr_rate_delay",
pause = pause,
max_times = max_times,
jitter = FALSE
)
}
#' @rdname rate-helpers
#' @param pause_base,pause_cap `rate_backoff()` uses an exponential
#' back-off so that each request waits `pause_base * 2^i` seconds,
#' up to a maximum of `pause_cap` seconds.
#' @param pause_min Minimum time to wait in the backoff; generally
#' only necessary if you need pauses less than one second (which may
#' not be kind to the server, use with caution!).
#' @export
rate_backoff <- function(pause_base = 1,
pause_cap = 60,
pause_min = 1,
max_times = 3,
jitter = TRUE) {
check_number_decimal(pause_base, min = 0)
check_number_decimal(pause_cap, allow_infinite = TRUE, min = 0)
check_number_decimal(pause_min, allow_infinite = TRUE, min = 0)
check_number_whole(max_times, min = 1)
check_bool(jitter)
new_rate(
"purrr_rate_backoff",
pause_base = pause_base,
pause_cap = pause_cap,
pause_min = pause_min,
max_times = max_times,
jitter = jitter
)
}
new_rate <- function(.subclass, ..., jitter = TRUE, max_times = 3) {
stopifnot(
is_bool(jitter),
is_number(max_times) || identical(max_times, Inf)
)
rate <- list(
...,
state = env(i = 0L),
jitter = jitter,
max_times = max_times
)
structure(
rate,
class = c(.subclass, "purrr_rate")
)
}
#' @rdname rate-helpers
#' @param x An object to test.
#' @export
is_rate <- function(x) {
inherits(x, "purrr_rate")
}
#' @export
print.purrr_rate_delay <- function(x, ...) {
cli::cli_text("")
cli::cli_bullets(c(
" " = "Attempts: {rate_count(x)}/{x$max_times}",
" " = "{.field pause}: {x$pause}"
))
invisible(x)
}
#' @export
print.purrr_rate_backoff <- function(x, ...) {
cli::cli_text("")
cli::cli_bullets(c(
" " = "Attempts: {rate_count(x)}/{x$max_times}",
" " = "{.field pause_base}: {x$pause_base}",
" " = "{.field pause_cap}: {x$pause_cap}",
" " = "{.field pause_min}: {x$pause_min}"
))
invisible(x)
}
#' Wait for a given time
#'
#' If the rate's internal counter exceeds the maximum number of times
#' it is allowed to sleep, `rate_sleep()` throws an error of class
#' `purrr_error_rate_excess`.
#'
#' Call `rate_reset()` to reset the internal rate counter to 0.
#'
#' @param rate A [rate][rate_backoff] object determining the waiting time.
#' @param quiet If `FALSE`, prints a message displaying how long until
#' the next request.
#'
#' @seealso [rate_backoff()], [insistently()]
#' @keywords internal
#' @export
rate_sleep <- function(rate, quiet = TRUE) {
stopifnot(is_rate(rate))
i <- rate_count(rate)
if (i > rate$max_times) {
stop_rate_expired(rate)
}
if (i == rate$max_times) {
stop_rate_excess(rate)
}
if (i == 0L) {
rate_bump_count(rate)
signal_rate_init(rate)
return(invisible())
}
on.exit(rate_bump_count(rate))
UseMethod("rate_sleep")
}
#' @export
rate_sleep.purrr_rate_backoff <- function(rate, quiet = TRUE) {
i <- rate_count(rate)
pause_max <- min(rate$pause_cap, rate$pause_base * 2^i)
if (rate$jitter) {
pause_max <- stats::runif(1, 0, pause_max)
}
length <- max(rate$pause_min, pause_max)
rate_sleep_impl(rate, length, quiet)
}
#' @export
rate_sleep.purrr_rate_delay <- function(rate, quiet = TRUE) {
rate_sleep_impl(rate, rate$pause, quiet)
}
rate_sleep_impl <- function(rate, length, quiet) {
if (!quiet) {
signal_rate_retry(rate, length, quiet)
}
Sys.sleep(length)
}
#' @rdname rate_sleep
#' @export
rate_reset <- function(rate) {
stopifnot(is_rate(rate))
rate$state$i <- 0L
invisible(rate)
}
rate_count <- function(rate) {
rate$state$i
}
rate_bump_count <- function(rate, n = 1L) {
rate$state$i <- rate$state$i + n
invisible(rate)
}
signal_rate_init <- function(rate) {
signal("", "purrr_condition_rate_init", rate = rate)
}
signal_rate_retry <- function(rate, length, quiet) {
msg <- sprintf("Retrying in %s seconds.", format(length, digits = 2))
class <- "purrr_message_rate_retry"
if (quiet) {
signal(msg, class, rate = rate, length = length)
} else {
inform(msg, class, rate = rate, length = length)
}
}
stop_rate_expired <- function(rate, error_call = caller_env()) {
cli::cli_abort(
c(
"This `rate` object has already be run more than `max_times` allows.",
i = "Do you need to reset it with `rate_reset()`?"
),
class = "purrr_error_rate_expired",
call = error_call
)
}
stop_rate_excess <- function(rate, error_call = caller_env()) {
i <- rate_count(rate)
# Bump counter to get an expired error next time around
rate_bump_count(rate)
cli::cli_abort(
"Request failed after {i} attempts.",
class = "purrr_error_rate_excess",
call = error_call
)
}
check_rate <- function(rate, error_call = caller_env()) {
if (!is_rate(rate)) {
cli::cli_abort(
"{.arg rate} must be a rate object, not {.obj_type_friendly {rate}}.",
arg = "rate",
call = error_call,
)
}
}
purrr/R/deprec-rerun.R 0000644 0001762 0000144 00000004111 14350157731 014346 0 ustar ligges users #' Re-run expressions multiple times
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 because we believe that NSE
#' functions are not a good fit for purrr. Also, `rerun(n, x)` can just as
#' easily be expressed as `map(1:n, \(i) x)`
#'
#' `rerun()` is a convenient way of generating sample data. It works similarly to
#' \code{\link{replicate}(..., simplify = FALSE)}.
#'
#' @param .n Number of times to run expressions
#' @param ... Expressions to re-run.
#' @return A list of length `.n`. Each element of `...` will be
#' re-run once for each `.n`.
#'
#' There is one special case: if there's a single unnamed input, the second
#' level list will be dropped. In this case, `rerun(n, x)` behaves like
#' `replicate(n, x, simplify = FALSE)`.
#' @export
#' @keywords internal
#' @examples
#' # old
#' 5 |> rerun(rnorm(5)) |> str()
#' # new
#' 1:5 |> map(\(i) rnorm(5)) |> str()
#'
#' # old
#' 5 |>
#' rerun(x = rnorm(5), y = rnorm(5)) |>
#' map_dbl(\(l) cor(l$x, l$y))
#' # new
#' 1:5 |>
#' map(\(i) list(x = rnorm(5), y = rnorm(5))) |>
#' map_dbl(\(l) cor(l$x, l$y))
rerun <- function(.n, ...) {
deprec_rerun(.n, ..., .purrr_user_env = caller_env())
dots <- quos(...)
# Special case: if single unnamed argument, insert directly into the output
# rather than wrapping in a list.
if (length(dots) == 1 && !is_named(dots)) {
dots <- dots[[1]]
eval_dots <- eval_tidy
} else {
eval_dots <- function(x) lapply(x, eval_tidy)
}
out <- vector("list", .n)
for (i in seq_len(.n)) {
out[[i]] <- eval_dots(dots)
}
out
}
deprec_rerun <- function(.n, ..., .purrr_user_env) {
n <- .n
old <- substitute(rerun(n, ...))
if (dots_n(...) == 1) {
new <- substitute(map(1:n, ~ ...))
} else {
new <- substitute(map(1:n, ~ list(...)))
}
lifecycle::deprecate_soft(
when = "1.0.0",
what = "rerun()",
with = "map()",
details = c(
" " = "# Previously",
" " = expr_deparse(old),
"",
" " = "# Now",
" " = expr_deparse(new)
),
user_env = .purrr_user_env
)
}
purrr/R/list-combine.R 0000644 0001762 0000144 00000005364 14344666512 014360 0 ustar ligges users #' Combine list elements into a single data structure
#'
#' @description
#' * `list_c()` combines elements into a vector by concatenating them together
#' with [vctrs::vec_c()].
#'
#' * `list_rbind()` combines elements into a data frame by row-binding them
#' together with [vctrs::vec_rbind()].
#'
#' * `list_cbind()` combines elements into a data frame by column-binding them
#' together with [vctrs::vec_cbind()].
#'
#' @param x A list. For `list_rbind()` and `list_cbind()` the list must
#' only contain only data frames or `NULL`.
#' @param ptype An optional prototype to ensure that the output type is always
#' the same.
#' @param names_to By default, `names(x)` are lost. To keep them, supply a
#' string to `names_to` and the names will be saved into a column with that
#' name. If `names_to` is supplied and `x` is not named, the position of
#' the elements will be used instead of the names.
#' @param size An optional integer size to ensure that every input has the
#' same size (i.e. number of rows).
#' @param name_repair One of `"unique"`, `"universal"`, or `"check_unique"`.
#' See [vctrs::vec_as_names()] for the meaning of these options.
#' @inheritParams rlang::args_dots_empty
#' @export
#' @examples
#' x1 <- list(a = 1, b = 2, c = 3)
#' list_c(x1)
#'
#' x2 <- list(
#' a = data.frame(x = 1:2),
#' b = data.frame(y = "a")
#' )
#' list_rbind(x2)
#' list_rbind(x2, names_to = "id")
#' list_rbind(unname(x2), names_to = "id")
#'
#' list_cbind(x2)
list_c <- function(x, ..., ptype = NULL) {
vec_check_list(x)
check_dots_empty()
# For `list_c()`, we don't expose `list_unchop()`'s `name_spec` arg,
# and instead strip outer names to avoid collisions with inner names
x <- unname(x)
list_unchop(
x,
ptype = ptype,
error_call = current_env()
)
}
#' @export
#' @rdname list_c
list_cbind <- function(
x,
...,
name_repair = c("unique", "universal", "check_unique"),
size = NULL
) {
check_list_of_data_frames(x)
check_dots_empty()
vec_cbind(!!!x, .name_repair = name_repair, .size = size, .error_call = current_env())
}
#' @export
#' @rdname list_c
list_rbind <- function(x, ..., names_to = rlang::zap(), ptype = NULL) {
check_list_of_data_frames(x)
check_dots_empty()
vec_rbind(!!!x, .names_to = names_to, .ptype = ptype, .error_call = current_env())
}
check_list_of_data_frames <- function(x, error_call = caller_env()) {
vec_check_list(x, call = error_call)
is_df_or_null <- map_lgl(x, function(x) is.data.frame(x) || is.null(x))
if (all(is_df_or_null)) {
return()
}
bad <- which(!is_df_or_null)
cli::cli_abort(
c(
"Each element of {.arg x} must be either a data frame or {.code NULL}.",
i = "Elements {bad} are not."
),
arg = "x",
call = error_call
)
}
purrr/R/compat-obj-type.R 0000644 0001762 0000144 00000017642 14326311377 015003 0 ustar ligges users # nocov start --- r-lib/rlang compat-obj-type
#
# Changelog
# =========
#
# 2022-10-04:
# - `obj_type_friendly(value = TRUE)` now shows numeric scalars
# literally.
# - `stop_friendly_type()` now takes `show_value`, passed to
# `obj_type_friendly()` as the `value` argument.
#
# 2022-10-03:
# - Added `allow_na` and `allow_null` arguments.
# - `NULL` is now backticked.
# - Better friendly type for infinities and `NaN`.
#
# 2022-09-16:
# - Unprefixed usage of rlang functions with `rlang::` to
# avoid onLoad issues when called from rlang (#1482).
#
# 2022-08-11:
# - Prefixed usage of rlang functions with `rlang::`.
#
# 2022-06-22:
# - `friendly_type_of()` is now `obj_type_friendly()`.
# - Added `obj_type_oo()`.
#
# 2021-12-20:
# - Added support for scalar values and empty vectors.
# - Added `stop_input_type()`
#
# 2021-06-30:
# - Added support for missing arguments.
#
# 2021-04-19:
# - Added support for matrices and arrays (#141).
# - Added documentation.
# - Added changelog.
#' Return English-friendly type
#' @param x Any R object.
#' @param value Whether to describe the value of `x`. Special values
#' like `NA` or `""` are always described.
#' @param length Whether to mention the length of vectors and lists.
#' @return A string describing the type. Starts with an indefinite
#' article, e.g. "an integer vector".
#' @noRd
obj_type_friendly <- function(x, value = TRUE) {
if (is_missing(x)) {
return("absent")
}
if (is.object(x)) {
if (inherits(x, "quosure")) {
type <- "quosure"
} else {
type <- paste(class(x), collapse = "/")
}
return(sprintf("a <%s> object", type))
}
if (!is_vector(x)) {
return(.rlang_as_friendly_type(typeof(x)))
}
n_dim <- length(dim(x))
if (!n_dim) {
if (!is_list(x) && length(x) == 1) {
if (is_na(x)) {
return(switch(
typeof(x),
logical = "`NA`",
integer = "an integer `NA`",
double =
if (is.nan(x)) {
"`NaN`"
} else {
"a numeric `NA`"
},
complex = "a complex `NA`",
character = "a character `NA`",
.rlang_stop_unexpected_typeof(x)
))
}
show_infinites <- function(x) {
if (x > 0) {
"`Inf`"
} else {
"`-Inf`"
}
}
str_encode <- function(x, width = 30, ...) {
if (nchar(x) > width) {
x <- substr(x, 1, width - 3)
x <- paste0(x, "...")
}
encodeString(x, ...)
}
if (value) {
if (is.numeric(x) && is.infinite(x)) {
return(show_infinites(x))
}
if (is.numeric(x) || is.complex(x)) {
number <- as.character(round(x, 2))
what <- if (is.complex(x)) "the complex number" else "the number"
return(paste(what, number))
}
return(switch(
typeof(x),
logical = if (x) "`TRUE`" else "`FALSE`",
character = {
what <- if (nzchar(x)) "the string" else "the empty string"
paste(what, str_encode(x, quote = "\""))
},
raw = paste("the raw value", as.character(x)),
.rlang_stop_unexpected_typeof(x)
))
}
return(switch(
typeof(x),
logical = "a logical value",
integer = "an integer",
double = if (is.infinite(x)) show_infinites(x) else "a number",
complex = "a complex number",
character = if (nzchar(x)) "a string" else "\"\"",
raw = "a raw value",
.rlang_stop_unexpected_typeof(x)
))
}
if (length(x) == 0) {
return(switch(
typeof(x),
logical = "an empty logical vector",
integer = "an empty integer vector",
double = "an empty numeric vector",
complex = "an empty complex vector",
character = "an empty character vector",
raw = "an empty raw vector",
list = "an empty list",
.rlang_stop_unexpected_typeof(x)
))
}
}
vec_type_friendly(x)
}
vec_type_friendly <- function(x, length = FALSE) {
if (!is_vector(x)) {
abort("`x` must be a vector.")
}
type <- typeof(x)
n_dim <- length(dim(x))
add_length <- function(type) {
if (length && !n_dim) {
paste0(type, sprintf(" of length %s", length(x)))
} else {
type
}
}
if (type == "list") {
if (n_dim < 2) {
return(add_length("a list"))
} else if (is.data.frame(x)) {
return("a data frame")
} else if (n_dim == 2) {
return("a list matrix")
} else {
return("a list array")
}
}
type <- switch(
type,
logical = "a logical %s",
integer = "an integer %s",
numeric = ,
double = "a double %s",
complex = "a complex %s",
character = "a character %s",
raw = "a raw %s",
type = paste0("a ", type, " %s")
)
if (n_dim < 2) {
kind <- "vector"
} else if (n_dim == 2) {
kind <- "matrix"
} else {
kind <- "array"
}
out <- sprintf(type, kind)
if (n_dim >= 2) {
out
} else {
add_length(out)
}
}
.rlang_as_friendly_type <- function(type) {
switch(
type,
list = "a list",
NULL = "`NULL`",
environment = "an environment",
externalptr = "a pointer",
weakref = "a weak reference",
S4 = "an S4 object",
name = ,
symbol = "a symbol",
language = "a call",
pairlist = "a pairlist node",
expression = "an expression vector",
char = "an internal string",
promise = "an internal promise",
... = "an internal dots object",
any = "an internal `any` object",
bytecode = "an internal bytecode object",
primitive = ,
builtin = ,
special = "a primitive function",
closure = "a function",
type
)
}
.rlang_stop_unexpected_typeof <- function(x, call = caller_env()) {
abort(
sprintf("Unexpected type <%s>.", typeof(x)),
call = call
)
}
#' Return OO type
#' @param x Any R object.
#' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`,
#' `"R6"`, or `"R7"`.
#' @noRd
obj_type_oo <- function(x) {
if (!is.object(x)) {
return("bare")
}
class <- inherits(x, c("R6", "R7_object"), which = TRUE)
if (class[[1]]) {
"R6"
} else if (class[[2]]) {
"R7"
} else if (isS4(x)) {
"S4"
} else {
"S3"
}
}
#' @param x The object type which does not conform to `what`. Its
#' `obj_type_friendly()` is taken and mentioned in the error message.
#' @param what The friendly expected type as a string. Can be a
#' character vector of expected types, in which case the error
#' message mentions all of them in an "or" enumeration.
#' @param show_value Passed to `value` argument of `obj_type_friendly()`.
#' @param ... Arguments passed to [abort()].
#' @inheritParams args_error_context
#' @noRd
stop_input_type <- function(x,
what,
...,
allow_na = FALSE,
allow_null = FALSE,
show_value = TRUE,
arg = caller_arg(x),
call = caller_env()) {
# From compat-cli.R
cli <- env_get_list(
nms = c("format_arg", "format_code"),
last = topenv(),
default = function(x) sprintf("`%s`", x),
inherit = TRUE
)
if (allow_na) {
what <- c(what, cli$format_code("NA"))
}
if (allow_null) {
what <- c(what, cli$format_code("NULL"))
}
if (length(what)) {
what <- oxford_comma(what)
}
message <- sprintf(
"%s must be %s, not %s.",
cli$format_arg(arg),
what,
obj_type_friendly(x, value = show_value)
)
abort(message, ..., call = call, arg = arg)
}
oxford_comma <- function(chr, sep = ", ", final = "or") {
n <- length(chr)
if (n < 2) {
return(chr)
}
head <- chr[seq_len(n - 1)]
last <- chr[n]
head <- paste(head, collapse = sep)
# Write a or b. But a, b, or c.
if (n > 2) {
paste0(head, sep, final, " ", last)
} else {
paste0(head, " ", final, " ", last)
}
}
# nocov end
purrr/R/deprec-when.R 0000644 0001762 0000144 00000005616 14355573665 014204 0 ustar ligges users #' Match/validate a set of conditions for an object and continue with the action
#' associated with the first valid match.
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 because it's not related to the
#' core purpose of purrr. You can pull your code out of a pipe and use regular
#' `if`/`else` statements instead.
#'
#' `when()` is a flavour of pattern matching (or an if-else abstraction) in
#' which a value is matched against a sequence of condition-action sets. When a
#' valid match/condition is found the action is executed and the result of the
#' action is returned.
#'
#' @param . the value to match against
#' @param ... formulas; each containing a condition as LHS and an action as RHS.
#' named arguments will define additional values.
#' @return The value resulting from the action of the first valid
#' match/condition is returned. If no matches are found, and no default is
#' given, NULL will be returned.
#'
# @details condition-action sets are written as formulas with conditions as
# left-hand sides and actions as right-hand sides. A formula with only a
# right-hand will be treated as a condition which is always satisfied. For
# such a default case one can also omit the `~` symbol, but note that its
# value will then be evaluated. Any named argument will be made available in
# all conditions and actions, which is useful in avoiding repeated temporary
# computations or temporary assignments.
#
#' Validity of the conditions are tested with `isTRUE`, or equivalently
#' with `identical(condition, TRUE)`.
#' In other words conditions resulting in more than one logical will never
#' be valid. Note that the input value is always treated as a single object,
#' as opposed to the `ifelse` function.
#'
#' @keywords internal
#' @examples
#' 1:10 %>%
#' when(
#' sum(.) <= 50 ~ sum(.),
#' sum(.) <= 100 ~ sum(.)/2,
#' ~ 0
#' )
#'
#' # now
#' x <- 1:10
#' if (sum(x) < 10) {
#' sum(x)
#' } else if (sum(x) < 100) {
#' sum(x) / 2
#' } else {
#' 0
#' }
#' @export
when <- function(., ...) {
lifecycle::deprecate_soft("1.0.0", "when()", I("`if`"))
dots <- list(...)
names <- names(dots)
named <- if (is.null(names)) rep(FALSE, length(dots)) else names != ""
if (sum(!named) == 0)
cli::cli_abort("At least one matching condition is needed.")
is_formula <-
vapply(dots,
function(dot) identical(class(dot), "formula"),
logical(1L))
env <- new.env(parent = parent.frame())
env[["."]] <- .
if (sum(named) > 0)
for (i in which(named))
env[[names[i]]] <- dots[[i]]
result <- NULL
for (i in which(!named)) {
if (is_formula[i]) {
action <- length(dots[[i]])
if (action == 2 || is_true(eval(dots[[i]][[2]], env, env))) {
result <- eval(dots[[i]][[action]], env, env)
break
}
} else {
result <- dots[[i]]
}
}
result
}
purrr/R/adverb-insistently.R 0000644 0001762 0000144 00000004422 14326311377 015607 0 ustar ligges users #' Transform a function to wait then retry after an error
#'
#' @description
#' `insistently()` takes a function and modifies it to retry after given
#' amount of time whenever it errors.
#'
#' @inheritParams safely
#' @param rate A [rate][rate-helpers] object. Defaults to jittered exponential
#' backoff.
#' @inheritParams rate_sleep
#' @seealso [httr::RETRY()] is a special case of [insistently()] for
#' HTTP verbs.
#' @inheritSection safely Adverbs
#' @inherit safely return
#' @family adverbs
#' @export
#' @examples
#' # For the purpose of this example, we first create a custom rate
#' # object with a low waiting time between attempts:
#' rate <- rate_delay(0.1)
#'
#' # insistently() makes a function repeatedly try to work
#' risky_runif <- function(lo = 0, hi = 1) {
#' y <- runif(1, lo, hi)
#' if(y < 0.9) {
#' stop(y, " is too small")
#' }
#' y
#' }
#'
#' # Let's now create an exponential backoff rate with a low waiting
#' # time between attempts:
#' rate <- rate_backoff(pause_base = 0.1, pause_min = 0.005, max_times = 4)
#'
#' # Modify your function to run insistently.
#' insistent_risky_runif <- insistently(risky_runif, rate, quiet = FALSE)
#'
#' set.seed(6) # Succeeding seed
#' insistent_risky_runif()
#'
#' set.seed(3) # Failing seed
#' try(insistent_risky_runif())
#'
#' # You can also use other types of rate settings, like a delay rate
#' # that waits for a fixed amount of time. Be aware that a delay rate
#' # has an infinite amount of attempts by default:
#' rate <- rate_delay(0.2, max_times = 3)
#' insistent_risky_runif <- insistently(risky_runif, rate = rate, quiet = FALSE)
#' try(insistent_risky_runif())
#'
#' # insistently() and possibly() are a useful combination
#' rate <- rate_backoff(pause_base = 0.1, pause_min = 0.005)
#' possibly_insistent_risky_runif <- possibly(insistent_risky_runif, otherwise = -99)
#'
#' set.seed(6)
#' possibly_insistent_risky_runif()
#'
#' set.seed(3)
#' possibly_insistent_risky_runif()
insistently <- function(f, rate = rate_backoff(), quiet = TRUE) {
f <- as_mapper(f)
check_rate(rate)
check_bool(quiet)
function(...) {
rate_reset(rate)
repeat {
rate_sleep(rate, quiet = quiet)
out <- capture_error(f(...), quiet = quiet)
if (is_null(out$error)) {
return(out$result)
}
}
}
}
purrr/R/superseded-flatten.R 0000644 0001762 0000144 00000006063 14330525021 015546 0 ustar ligges users #' Flatten a list of lists into a simple vector
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' These functions were superseded in purrr 1.0.0 because their behaviour was
#' inconsistent. Superseded functions will not go away, but will only receive
#' critical bug fixes.
#'
#' * `flatten()` has been superseded by [list_flatten()].
#' * `flatten_lgl()`, `flatten_int()`, `flatten_dbl()`, and `flatten_chr()`
#' have been superseded by [list_c()].
#' * `flatten_dfr()` and `flatten_dfc()` have been superseded by [list_rbind()]
#' and [list_cbind()] respectively.
#'
#' @param .x A list to flatten. The contents of the list can be anything for
#' `flatten()` (as a list is returned), but the contents must match the
#' type for the other functions.
#' @return `flatten()` returns a list, `flatten_lgl()` a logical
#' vector, `flatten_int()` an integer vector, `flatten_dbl()` a
#' double vector, and `flatten_chr()` a character vector.
#'
#' `flatten_dfr()` and `flatten_dfc()` return data frames created by
#' row-binding and column-binding respectively. They require dplyr to
#' be installed.
#' @keywords internal
#' @inheritParams map
#' @export
#' @examples
#' x <- map(1:3, \(i) sample(4))
#' x
#'
#' # was
#' x |> flatten_int() |> str()
#' # now
#' x |> list_c() |> str()
#'
#' x <- list(list(1, 2), list(3, 4))
#' # was
#' x |> flatten() |> str()
#' # now
#' x |> list_flatten() |> str()
flatten <- function(.x) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten()", "list_flatten()")
.Call(flatten_impl, .x)
}
#' @export
#' @rdname flatten
flatten_lgl <- function(.x) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()")
.Call(vflatten_impl, .x, "logical")
}
#' @export
#' @rdname flatten
flatten_int <- function(.x) {
lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()")
.Call(vflatten_impl, .x, "integer")
}
#' @export
#' @rdname flatten
flatten_dbl <- function(.x) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()")
.Call(vflatten_impl, .x, "double")
}
#' @export
#' @rdname flatten
flatten_chr <- function(.x) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten_lgl()", "list_c()")
.Call(vflatten_impl, .x, "character")
}
#' @export
#' @rdname flatten
flatten_dfr <- function(.x, .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten_dfr()", "list_rbind()")
check_installed("dplyr", "for `flatten_dfr()`.")
res <- .Call(flatten_impl, .x)
dplyr::bind_rows(res, .id = .id)
}
#' @export
#' @rdname flatten
flatten_dfc <- function(.x) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten_dfc()", "list_cbind()")
check_installed("dplyr", "for `flatten_dfc()`.")
res <- .Call(flatten_impl, .x)
dplyr::bind_cols(res)
}
#' @export
#' @rdname flatten
#' @usage NULL
flatten_df <- function(.x, .id = NULL) {
# in 1.0.0
lifecycle::signal_stage("superseded", "flatten_df()", "list_rbind()")
check_installed("dplyr", "for `flatten_dfr()`.")
res <- .Call(flatten_impl, .x)
dplyr::bind_rows(res, .id = .id)
}
purrr/R/pluck-depth.R 0000644 0001762 0000144 00000002055 14315046000 014163 0 ustar ligges users #' Compute the depth of a vector
#'
#' The depth of a vector is how many levels that you can index/pluck into it.
#' `pluck_depth()` was previously called `vec_depth()`.
#'
#' @param x A vector
#' @param is_node Optionally override the default criteria for determine an
#' element can be recursed within. The default matches the behaviour of
#' `pluck()` which can recurse into lists and expressions.
#' @return An integer.
#' @export
#' @examples
#' x <- list(
#' list(),
#' list(list()),
#' list(list(list(1)))
#' )
#' pluck_depth(x)
#' x |> map_int(pluck_depth)
pluck_depth <- function(x, is_node = NULL) {
if (is.null(is_node)) {
is_node <- function(x) is.expression(x) || is.list(x)
}
is_node <- as_is_node(is_node)
if (is_node(x)) {
depths <- map_int(x, pluck_depth, is_node = is_node)
1L + max(depths, 0L)
} else if (is_atomic(x)) {
1L
} else {
0L
}
}
#' @export
#' @rdname pluck_depth
#' @usage NULL
vec_depth <- function(x) {
lifecycle::deprecate_soft("1.0.0", "vec_depth()", "pluck_depth()")
pluck_depth(x)
}
purrr/R/map2.R 0000644 0001762 0000144 00000005531 14355573666 012637 0 ustar ligges users #' Map over two inputs
#'
#' @description
#' These functions are variants of [map()] that iterate over two arguments at
#' a time.
#'
#' @param .x,.y A pair of vectors, usually the same length. If not, a vector
#' of length 1 will be recycled to the length of the other.
#' @param .f A function, specified in one of the following ways:
#'
#' * A named function.
#' * An anonymous function, e.g. `\(x, y) x + y` or `function(x, y) x + y`.
#' * A formula, e.g. `~ .x + .y`. You must use `.x` to refer to the current
#' element of `x` and `.y` to refer to the current element of `y`. Only
#' recommended if you require backward compatibility with older versions
#' of R.
#' @inheritParams map
#' @inherit map return
#' @family map variants
#' @export
#' @examples
#' x <- list(1, 1, 1)
#' y <- list(10, 20, 30)
#'
#' map2(x, y, \(x, y) x + y)
#' # Or just
#' map2(x, y, `+`)
#'
#' # Split into pieces, fit model to each piece, then predict
#' by_cyl <- mtcars |> split(mtcars$cyl)
#' mods <- by_cyl |> map(\(df) lm(mpg ~ wt, data = df))
#' map2(mods, by_cyl, predict)
map2 <- function(.x, .y, .f, ..., .progress = FALSE) {
map2_("list", .x, .y, .f, ..., .progress = .progress)
}
#' @export
#' @rdname map2
map2_lgl <- function(.x, .y, .f, ..., .progress = FALSE) {
map2_("logical", .x, .y, .f, ..., .progress = .progress)
}
#' @export
#' @rdname map2
map2_int <- function(.x, .y, .f, ..., .progress = FALSE) {
map2_("integer", .x, .y, .f, ..., .progress = .progress)
}
#' @export
#' @rdname map2
map2_dbl <- function(.x, .y, .f, ..., .progress = FALSE) {
map2_("double", .x, .y, .f, ..., .progress = .progress)
}
#' @export
#' @rdname map2
map2_chr <- function(.x, .y, .f, ..., .progress = FALSE) {
map2_("character", .x, .y, .f, ..., .progress = .progress)
}
map2_ <- function(.type,
.x,
.y,
.f,
...,
.progress = FALSE,
.purrr_user_env = caller_env(2),
.purrr_error_call = caller_env()) {
.x <- vctrs_vec_compat(.x, .purrr_user_env)
.y <- vctrs_vec_compat(.y, .purrr_user_env)
n <- vec_size_common(.x = .x, .y = .y, .call = .purrr_error_call)
args <- vec_recycle_common(.x = .x, .y = .y, .size = n, .call = .purrr_error_call)
.x <- args$.x
.y <- args$.y
names <- vec_names(.x)
.f <- as_mapper(.f, ...)
i <- 0L
with_indexed_errors(
i = i,
names = names,
error_call = .purrr_error_call,
call_with_cleanup(map2_impl, environment(), .type, .progress, n, names, i)
)
}
#' @rdname map2
#' @export
map2_vec <- function(.x, .y, .f, ..., .ptype = NULL, .progress = FALSE) {
out <- map2(.x, .y, .f, ..., .progress = .progress)
simplify_impl(out, ptype = .ptype)
}
#' @export
#' @rdname map2
walk2 <- function(.x, .y, .f, ..., .progress = FALSE) {
map2(.x, .y, .f, ..., .progress = .progress)
invisible(.x)
}
purrr/R/deprec-along.R 0000644 0001762 0000144 00000001310 14313331715 014304 0 ustar ligges users #' Create a list of given length
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 since it's not related to the
#' core purpose of purrr.
#'
#' It can be useful to create an empty list that you plan to fill later. This is
#' similar to the idea of [seq_along()], which creates a vector of the same
#' length as its input.
#'
#' @param x A vector.
#' @return A list of the same length as `x`.
#' @keywords internal
#' @examples
#' x <- 1:5
#' seq_along(x)
#' list_along(x)
#' @name along
#' @rdname along
#' @export
list_along <- function(x) {
lifecycle::deprecate_soft("1.0.0", "list_along()", I("rep_along(x, list())"))
vector("list", length(x))
}
purrr/R/list-modify.R 0000644 0001762 0000144 00000007507 14350157731 014227 0 ustar ligges users #' Modify a list
#'
#' @description
#' * `list_assign()` modifies the elements of a list by name or position.
#' * `list_modify()` modifies the elements of a list recursively.
#' * `list_merge()` merges the elements of a list recursively.
#'
#' `list_modify()` is inspired by [utils::modifyList()].
#'
#' @param .x List to modify.
#' @param ... New values of a list. Use `zap()` to remove values.
#'
#' These values should be either all named or all unnamed. When
#' inputs are all named, they are matched to `.x` by name. When they
#' are all unnamed, they are matched by position.
#'
#' [Dynamic dots][rlang::dyn-dots] are supported. In particular, if your
#' replacement values are stored in a list, you can splice that in with
#' `!!!`.
#' @inheritParams map_depth
#' @export
#' @examples
#' x <- list(x = 1:10, y = 4, z = list(a = 1, b = 2))
#' str(x)
#'
#' # Update values
#' str(list_assign(x, a = 1))
#' # Replace values
#' str(list_assign(x, z = 5))
#' str(list_assign(x, z = NULL))
#'
#' str(list_assign(x, z = list(a = 1:5)))
#' # replace recursively, leaving the other elements of z alone
#' str(list_modify(x, z = list(a = 1:5)))
#'
#' # Remove values
#' str(list_assign(x, z = zap()))
#'
#' # Combine values with list_merge()
#' str(list_merge(x, x = 11, z = list(a = 2:5, c = 3)))
#'
#' # All these functions support dynamic dots features. Use !!! to splice
#' # a list of arguments:
#' l <- list(new = 1, y = zap(), z = 5)
#' str(list_assign(x, !!!l))
list_assign <- function(.x, ..., .is_node = NULL) {
check_list(.x)
y <- dots_list(..., .named = NULL, .homonyms = "error")
list_recurse(.x, y, function(x, y) y, recurse = FALSE, is_node = .is_node)
}
#' @export
#' @rdname list_assign
list_modify <- function(.x, ..., .is_node = NULL) {
check_list(.x)
y <- dots_list(..., .named = NULL, .homonyms = "error")
list_recurse(.x, y, function(x, y) y, is_node = .is_node)
}
#' @export
#' @rdname list_assign
list_merge <- function(.x, ..., .is_node = NULL) {
check_list(.x)
y <- dots_list(..., .named = NULL, .homonyms = "error")
list_recurse(.x, y, c, is_node = .is_node)
}
list_recurse <- function(x, y, base_f, recurse = TRUE, error_call = caller_env(), is_node = NULL) {
is_node <- as_is_node(is_node, error_call = error_call, error_arg = ".is_node")
if (!is_null(names(y)) && !is_named(y)) {
cli::cli_abort(
"`...` arguments must be either all named or all unnamed.",
call = error_call
)
}
idx <- names(y) %||% rev(seq_along(y))
for (i in idx) {
x_i <- pluck(x, i)
y_i <- pluck(y, i)
if (is_zap(y_i)) {
x[[i]] <- NULL
} else if (recurse && is_node(x_i) && is_node(y_i)) {
list_slice2(x, i) <- list_recurse(x_i, y_i, base_f)
} else {
list_slice2(x, i) <- base_f(x_i, y_i)
}
}
x
}
check_list <- function(x, call = caller_env(), arg = caller_arg(x)) {
if (!is.list(x)) {
cli::cli_abort(
"{.arg {arg}} must be a list, not {.obj_type_friendly {x}}.",
call = call,
arg = arg
)
}
}
#' Update a list with formulas
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `update_list()` was deprecated in purrr 1.0.0, because we no longer believe
#' that functions that use NSE are a good fit for purrr.
#'
#' `update_list()` handles formulas and quosures that can refer to
#' values existing within the input list. This function is deprecated
#' because we no longer believe that functions that use tidy evaluation are
#' a good fit for purrr.
#'
#' @inheritParams list_modify
#' @export
#' @keywords internal
update_list <- function(.x, ...) {
lifecycle::deprecate_soft("1.0.0", "update_list()")
dots <- dots_list(...)
formulas <- map_lgl(dots, is_bare_formula, lhs = FALSE, scoped = TRUE)
dots <- map_if(dots, formulas, as_quosure)
dots <- map_if(dots, is_quosure, eval_tidy, data = .x)
list_recurse(.x, dots, function(x, y) y)
}
purrr/R/adverb-negate.R 0000644 0001762 0000144 00000001012 14311356421 014446 0 ustar ligges users #' Negate a predicate function so it selects what it previously rejected
#'
#' Negating a function changes `TRUE` to `FALSE` and `FALSE` to `TRUE`.
#'
#' @inheritParams keep
#' @inheritSection safely Adverbs
#' @family adverbs
#' @return A new predicate function.
#' @export
#' @examples
#' x <- list(x = 1:10, y = rbernoulli(10), z = letters)
#' x |> keep(is.numeric) |> names()
#' x |> keep(negate(is.numeric)) |> names()
#' # Same as
#' x |> discard(is.numeric)
negate <- function(.p) {
compose(`!`, as_mapper(.p))
}
purrr/R/list-flatten.R 0000644 0001762 0000144 00000004350 14326311377 014367 0 ustar ligges users #' Flatten a list
#'
#' Flattening a list removes a single layer of internal hierarchy,
#' i.e. it inlines elements that are lists leaving non-lists alone.
#'
#' @param x A list.
#' @param name_spec If both inner and outer names are present, control
#' how they are combined. Should be a glue specification that uses
#' variables `inner` and `outer`.
#' @param name_repair One of `"minimal"`, `"unique"`, `"universal"`, or
#' `"check_unique"`. See [vctrs::vec_as_names()] for the meaning of these
#' options.
#' @inheritParams rlang::args_dots_empty
#' @return A list of the same type as `x`. The list might be shorter
#' if `x` contains empty lists, the same length if it contains lists
#' of length 1 or no sub-lists, or longer if it contains lists of
#' length > 1.
#' @export
#' @examples
#' x <- list(1, list(2, 3), list(4, list(5)))
#' x |> list_flatten() |> str()
#' x |> list_flatten() |> list_flatten() |> str()
#'
#' # Flat lists are left as is
#' list(1, 2, 3, 4, 5) |> list_flatten() |> str()
#'
#' # Empty lists will disappear
#' list(1, list(), 2, list(3)) |> list_flatten() |> str()
#'
#' # Another way to see this is that it reduces the depth of the list
#' x <- list(
#' list(),
#' list(list())
#' )
#' x |> pluck_depth()
#' x |> list_flatten() |> pluck_depth()
#'
#' # Use name_spec to control how inner and outer names are combined
#' x <- list(x = list(a = 1, b = 2), y = list(c = 1, d = 2))
#' x |> list_flatten() |> names()
#' x |> list_flatten(name_spec = "{outer}") |> names()
#' x |> list_flatten(name_spec = "{inner}") |> names()
list_flatten <- function(
x,
...,
name_spec = "{outer}_{inner}",
name_repair = c("minimal", "unique", "check_unique", "universal")
) {
vec_check_list(x)
check_dots_empty()
check_string(name_spec)
# Take the proxy as we restore on exit
proxy <- vec_proxy(x)
# Unclass S3 lists to avoid their coercion methods. Wrap atoms in a
# list of size 1 so the elements can be concatenated in a single list.
proxy <- map_if(proxy, vec_is_list, unclass, .else = list)
out <- list_unchop(
proxy,
ptype = list(),
name_spec = name_spec,
name_repair = name_repair,
error_arg = x,
error_call = current_env()
)
# Preserve input type
vec_restore(out, x)
}
purrr/R/superseded-transpose.R 0000644 0001762 0000144 00000005023 14330525021 016122 0 ustar ligges users #' Transpose a list.
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' `transpose()` turns a list-of-lists "inside-out"; it turns a pair of lists
#' into a list of pairs, or a list of pairs into pair of lists. For example,
#' if you had a list of length n where each component had values `a` and
#' `b`, `transpose()` would make a list with elements `a` and
#' `b` that contained lists of length n. It's called transpose because
#' \code{x[[1]][[2]]} is equivalent to \code{transpose(x)[[2]][[1]]}.
#'
#' This function was superseded in purrr 1.0.0 because [list_transpose()]
#' has a better name and can automatically simplify the output, as is commonly
#' needed. Superseded functions will not go away, but will only receive critical
#' bug fixes.
#'
#' @param .l A list of vectors to transpose. The first element is used as the
#' template; you'll get a warning if a subsequent element has a different
#' length.
#' @param .names For efficiency, `transpose()` bases the return structure on
#' the first component of `.l` by default. Specify `.names` to override this.
#' @return A list with indexing transposed compared to `.l`.
#'
#' `transpose()` is its own inverse, much like the transpose operation on a
#' matrix. You can get back the original input by transposing it twice.
#' @keywords internal
#' @export
#' @examples
#' x <- map(1:5, \(i) list(x = runif(1), y = runif(5)))
#' # was
#' x |> transpose() |> str()
#' # now
#' x |> list_transpose(simplify = FALSE) |> str()
#'
#' # transpose() is useful in conjunction with safely() & quietly()
#' x <- list("a", 1, 2)
#' y <- x |> map(safely(log))
#' # was
#' y |> transpose() |> str()
#' # now:
#' y |> list_transpose() |> str()
#'
#' # Previously, output simplification required a call to another function
#' x <- list(list(a = 1, b = 2), list(a = 3, b = 4), list(a = 5, b = 6))
#' x |> transpose() |> simplify_all()
#' # Now can take advantage of automatic simplification
#' x |> list_transpose()
#'
#' # Provide explicit component names to prevent loss of those that don't
#' # appear in first component
#' ll <- list(
#' list(x = 1, y = "one"),
#' list(z = "deux", x = 2)
#' )
#' ll |> transpose()
#' nms <- ll |> map(names) |> reduce(union)
#' # was
#' ll |> transpose(.names = nms)
#' # now
#' ll |> list_transpose(template = nms)
#' # and can supply default value
#' ll |> list_transpose(template = nms, default = NA)
transpose <- function(.l, .names = NULL) {
# 1.0.0
lifecycle::signal_stage("superseded", "transpose()", "list_transpose()")
.Call(transpose_impl, .l, .names)
}
purrr/R/deprec-splice.R 0000644 0001762 0000144 00000002110 14313331715 014462 0 ustar ligges users #' Splice objects and lists of objects into a list
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 because we no longer believe that
#' this style of implicit/automatic splicing is a good idea; instead use
#' `rlang::list2()` + `!!!` or [list_flatten()].
#'
#' `splice()` splices all arguments into a list. Non-list objects and lists
#' with a S3 class are encapsulated in a list before concatenation.
#'
#' @param ... Objects to concatenate.
#' @return A list.
#' @keywords internal
#' @examples
#' inputs <- list(arg1 = "a", arg2 = "b")
#'
#' # splice() concatenates the elements of inputs with arg3
#' splice(inputs, arg3 = c("c1", "c2")) |> str()
#' list(inputs, arg3 = c("c1", "c2")) |> str()
#' c(inputs, arg3 = c("c1", "c2")) |> str()
#' @export
splice <- function(...) {
lifecycle::deprecate_soft("1.0.0", "splice()", "list_flatten()")
splice_if(list(...), is_bare_list)
}
splice_if <- function(.x, .p) {
unspliced <- !where_if(.x, .p)
out <- modify_if(.x, unspliced, list)
list_flatten(out, name_spec = "{inner}")
}
purrr/R/coerce.R 0000644 0001762 0000144 00000002137 14460560176 013224 0 ustar ligges users # Used internally by map and flatten.
# Exposed here for testing
coerce <- function(x, type) {
.Call(coerce_impl, x, type)
}
coerce_lgl <- function(x) coerce(x, "logical")
coerce_int <- function(x) coerce(x, "integer")
coerce_dbl <- function(x) coerce(x, "double")
coerce_chr <- function(x) {
local_deprecation_user_env()
coerce(x, "character")
}
deprecate_to_char <- function(type) {
lifecycle::deprecate_warn(
"1.0.0",
I(paste0("Automatic coercion from ", type, " to character")),
I("an explicit call to `as.character()` within `map_chr()`"),
always = TRUE,
user_env = the$deprecation_user_env
)
}
# Can rewrite after https://github.com/r-lib/rlang/issues/1643
local_deprecation_user_env <- function(user_env = caller_env(2), frame = caller_env()) {
old <- the$deprecation_user_env
the$deprecation_user_env <- user_env
defer(the$deprecation_user_env <- old, frame)
}
# Lightweight equivalent of withr::defer()
defer <- function(expr, env = caller_env(), after = FALSE) {
thunk <- as.call(list(function() expr))
do.call(on.exit, list(thunk, TRUE, after), envir = env)
}
purrr/R/pluck-assign.R 0000644 0001762 0000144 00000004334 14311356421 014354 0 ustar ligges users #' Modify a pluck location
#'
#' @description
#'
#' * `assign_in()` takes a data structure and a [pluck] location,
#' assigns a value there, and returns the modified data structure.
#'
#' * `modify_in()` applies a function to a pluck location, assigns the
#' result back to that location with [assign_in()], and returns the
#' modified data structure.
#'
#' @inheritParams pluck
#' @param .f A function to apply at the pluck location given by `.where`.
#' @param ... Arguments passed to `.f`.
#' @param .where,where A pluck location, as a numeric vector of
#' positions, a character vector of names, or a list combining both.
#' The location must exist in the data structure.
#' @seealso [pluck()]
#' @export
#' @examples
#' # Recall that pluck() returns a component of a data structure that
#' # might be arbitrarily deep
#' x <- list(list(bar = 1, foo = 2))
#' pluck(x, 1, "foo")
#'
#' # Use assign_in() to modify the pluck location:
#' str(assign_in(x, list(1, "foo"), 100))
#' # Or zap to remove it
#' str(assign_in(x, list(1, "foo"), zap()))
#'
#' # Like pluck(), this works even when the element (or its parents) don't exist
#' pluck(x, 1, "baz")
#' str(assign_in(x, list(2, "baz"), 100))
#'
#' # modify_in() applies a function to that location and update the
#' # element in place:
#' modify_in(x, list(1, "foo"), \(x) x * 200)
#'
#' # Additional arguments are passed to the function in the ordinary way:
#' modify_in(x, list(1, "foo"), `+`, 100)
modify_in <- function(.x, .where, .f, ...) {
.where <- as.list(.where)
.f <- rlang::as_function(.f)
value <- .f(pluck(.x, !!!.where), ...)
assign_in(.x, .where, value)
}
#' @rdname modify_in
#' @param value A value to replace in `.x` at the pluck location.
#' Use `zap()` to instead remove the element.
#' @export
assign_in <- function(x, where, value) {
n <- length(where)
if (n == 0) {
cli::cli_abort(
"{.arg where} must contain at least one element.",
arg = "where"
)
} else if (n > 1) {
old <- pluck(x, where[[1]], .default = list())
if (!is_zap(value) || !identical(old, list())) {
value <- assign_in(old, where[-1], value)
}
}
if (is_zap(value)) {
x[[where[[1]]]] <- NULL
} else {
list_slice2(x, where[[1]]) <- value
}
x
}
purrr/R/compat-types-check.R 0000644 0001762 0000144 00000024351 14326311377 015464 0 ustar ligges users # nocov start --- r-lib/rlang compat-types-check
#
# Dependencies
# ============
#
# - compat-obj-type.R
#
# Changelog
# =========
#
# 2022-10-07:
# - `check_number_whole()` and `_decimal()` no longer treat
# non-numeric types such as factors or dates as numbers. Numeric
# types are detected with `is.numeric()`.
#
# 2022-10-04:
# - Added `check_name()` that forbids the empty string.
# `check_string()` allows the empty string by default.
#
# 2022-09-28:
# - Removed `what` arguments.
# - Added `allow_na` and `allow_null` arguments.
# - Added `allow_decimal` and `allow_infinite` arguments.
# - Improved errors with absent arguments.
#
#
# 2022-09-16:
# - Unprefixed usage of rlang functions with `rlang::` to
# avoid onLoad issues when called from rlang (#1482).
#
# 2022-08-11:
# - Added changelog.
# Scalars -----------------------------------------------------------------
check_bool <- function(x,
...,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_bool(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
if (allow_na && identical(x, NA)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
c("`TRUE`", "`FALSE`"),
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_string <- function(x,
...,
allow_empty = TRUE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
is_string <- .rlang_check_is_string(
x,
allow_empty = allow_empty,
allow_na = allow_na,
allow_null = allow_null
)
if (is_string) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a single string",
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
.rlang_check_is_string <- function(x,
allow_empty,
allow_na,
allow_null) {
if (is_string(x)) {
if (allow_empty || !is_string(x, "")) {
return(TRUE)
}
}
if (allow_null && is_null(x)) {
return(TRUE)
}
if (allow_na && (identical(x, NA) || identical(x, na_chr))) {
return(TRUE)
}
FALSE
}
check_name <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
is_string <- .rlang_check_is_string(
x,
allow_empty = FALSE,
allow_na = FALSE,
allow_null = allow_null
)
if (is_string) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a valid name",
...,
allow_na = FALSE,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_number_decimal <- function(x,
...,
min = -Inf,
max = Inf,
allow_infinite = TRUE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
.rlang_types_check_number(
x,
...,
min = min,
max = max,
allow_decimal = TRUE,
allow_infinite = allow_infinite,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_number_whole <- function(x,
...,
min = -Inf,
max = Inf,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
.rlang_types_check_number(
x,
...,
min = min,
max = max,
allow_decimal = FALSE,
allow_infinite = FALSE,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
}
.rlang_types_check_number <- function(x,
...,
min = -Inf,
max = Inf,
allow_decimal = FALSE,
allow_infinite = FALSE,
allow_na = FALSE,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (allow_decimal) {
what <- "a number"
} else {
what <- "a whole number"
}
.stop <- function(x, what, ...) stop_input_type(
x,
what,
...,
allow_na = allow_na,
allow_null = allow_null,
arg = arg,
call = call
)
if (!missing(x)) {
is_number <- is_number(
x,
allow_decimal = allow_decimal,
allow_infinite = allow_infinite
)
if (is_number) {
if (min > -Inf && max < Inf) {
what <- sprintf("a number between %s and %s", min, max)
} else {
what <- NULL
}
if (x < min) {
what <- what %||% sprintf("a number larger than %s", min)
.stop(x, what, ...)
}
if (x > max) {
what <- what %||% sprintf("a number smaller than %s", max)
.stop(x, what, ...)
}
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
if (allow_na && (identical(x, NA) ||
identical(x, na_dbl) ||
identical(x, na_int))) {
return(invisible(NULL))
}
}
.stop(x, what, ...)
}
is_number <- function(x,
allow_decimal = FALSE,
allow_infinite = FALSE) {
if (!typeof(x) %in% c("integer", "double")) {
return(FALSE)
}
if (!is.numeric(x)) {
return(FALSE)
}
if (length(x) != 1) {
return(FALSE)
}
if (is.na(x)) {
return(FALSE)
}
if (!allow_decimal && !is_integerish(x)) {
return(FALSE)
}
if (!allow_infinite && is.infinite(x)) {
return(FALSE)
}
TRUE
}
check_symbol <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_symbol(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a symbol",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_arg <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_symbol(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an argument name",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_call <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_call(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a defused call",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_environment <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_environment(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an environment",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_function <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_function(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a function",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_closure <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_closure(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"an R function",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
check_formula <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_formula(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a formula",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
# Vectors -----------------------------------------------------------------
check_character <- function(x,
...,
allow_null = FALSE,
arg = caller_arg(x),
call = caller_env()) {
if (!missing(x)) {
if (is_character(x)) {
return(invisible(NULL))
}
if (allow_null && is_null(x)) {
return(invisible(NULL))
}
}
stop_input_type(
x,
"a character vector",
...,
allow_null = allow_null,
arg = arg,
call = call
)
}
# nocov end
purrr/R/keep.R 0000644 0001762 0000144 00000005234 14350157731 012706 0 ustar ligges users #' Keep/discard elements based on their values
#'
#' `keep()` selects all elements where `.p` evaluates to `TRUE`;
#' `discard()` selects all elements where `.p` evaluates to `FALSE`.
#' `compact()` discards elements where `.p` evaluates to an empty vector.
#'
#' In other languages, `keep()` and `discard()` are often called `select()`/
#' `filter()` and `reject()`/ `drop()`, but those names are already taken
#' in R. `keep()` is similar to [Filter()], but the argument order is more
#' convenient, and the evaluation of the predicate function `.p` is stricter.
#'
#' @param .x A list or vector.
#' @param .p A predicate function (i.e. a function that returns either `TRUE`
#' or `FALSE`) specified in one of the following ways:
#'
#' * A named function, e.g. `is.character`.
#' * An anonymous function, e.g. `\(x) all(x < 0)` or `function(x) all(x < 0)`.
#' * A formula, e.g. `~ all(.x < 0)`. You must use `.x` to refer to the first
#' argument). Only recommended if you require backward compatibility with
#' older versions of R.
#' @seealso [keep_at()]/[discard_at()] to keep/discard elements by name.
#' @param ... Additional arguments passed on to `.p`.
#' @export
#' @examples
#' rep(10, 10) |>
#' map(sample, 5) |>
#' keep(function(x) mean(x) > 6)
#'
#' # Or use a formula
#' rep(10, 10) |>
#' map(sample, 5) |>
#' keep(\(x) mean(x) > 6)
#'
#' # Using a string instead of a function will select all list elements
#' # where that subelement is TRUE
#' x <- rerun(5, a = rbernoulli(1), b = sample(10))
#' x
#' x |> keep("a")
#' x |> discard("a")
#'
#' # compact() discards elements that are NULL or that have length zero
#' list(a = "a", b = NULL, c = integer(0), d = NA, e = list()) |>
#' compact()
keep <- function(.x, .p, ...) {
where <- where_if(.x, .p, ...)
.x[!is.na(where) & where]
}
#' @export
#' @rdname keep
discard <- function(.x, .p, ...) {
where <- where_if(.x, .p, ...)
.x[is.na(where) | !where]
}
#' @export
#' @rdname keep
compact <- function(.x, .p = identity) {
.f <- as_mapper(.p)
discard(.x, function(x) is_empty(.f(x)))
}
#' Keep/discard elements based on their name/position
#'
#' @inheritParams map_at
#' @seealso [keep()]/[discard()] to keep/discard elements by value.
#' @export
#' @examples
#' x <- c(a = 1, b = 2, cat = 10, dog = 15, elephant = 5, e = 10)
#' x %>% keep_at(letters)
#' x %>% discard_at(letters)
#'
#' # Can also use a function
#' x %>% keep_at(~ nchar(.x) == 3)
#' x %>% discard_at(~ nchar(.x) == 3)
keep_at <- function(x, at) {
where <- where_at(x, at, user_env = caller_env())
x[where]
}
#' @export
#' @rdname keep_at
discard_at <- function(x, at) {
where <- where_at(x, at, user_env = caller_env())
x[!where]
}
purrr/R/conditions.R 0000644 0001762 0000144 00000006276 14310436312 014131 0 ustar ligges users #' Error conditions for bad types
#'
#' @param x The object whose type doesn't match `expected`.
#' @param what What does `x` represent? This is used to introduce the
#' object in the error message and should be capitalised. If `NULL`
#' and `arg` is `NULL` as well, defaults to `"Object"`. Otherwise
#' defaults to `arg` wrapped in backquotes.
#' @param expected,actual The expected and actual type of `x`, in
#' friendly representation. If `actual` is not supplied, `x` is
#' passed to `friendly_type_of()` to provide a default value.
#' @param index The index of `x` when it is an element of a vector.
#' @param ...,message,.subclass Only use these fields when creating a subclass.
#'
#' @details
#'
#' Some of the fields are expected to be in friendly representation,
#' i.e. a longer description that includes indefinite articles. For
#' example, a friendly representation of `"integer"` would be
#' `"an integer vector"`.
#'
#' Fields in pretty representation are meant for printing, not for
#' testing. They should not be relied on in unit tests as upstream
#' packages might tweak the friendly representation at any time.
#'
#' @keywords internal
#' @name purrr-conditions-type
#' @noRd
NULL
stop_bad_type <- function(x,
expected,
...,
what = NULL,
arg = NULL,
call = caller_env()) {
what <- what %||% what_bad_object(arg)
cli::cli_abort(
"{what} must be {expected}, not {.obj_type_friendly {x}}.",
arg = arg,
call = call
)
}
stop_bad_element_type <- function(x,
index,
expected,
...,
what = NULL,
arg = NULL,
call = caller_env()) {
what <- what_bad_element(what, arg, index)
cli::cli_abort(
"{what} must be {expected}, not {.obj_type_friendly {x}}.",
arg = arg,
call = call
)
}
stop_bad_element_length <- function(x,
index,
expected_length,
...,
what = NULL,
arg = NULL,
recycle = FALSE,
call = caller_env()) {
what <- what_bad_element(what, arg, index)
if (recycle) {
expected <- sprintf("1 or %s", expected_length)
} else {
expected <- expected_length
}
cli::cli_abort(
"{what} must have length {expected}, not {length(x)}.",
arg = arg,
call = call
)
}
# Helpers -----------------------------------------------------------------
what_bad_object <- function(arg) {
if (is_null(arg)) {
"Object"
} else if (is_string(arg)) {
sprintf("`%s`", arg)
} else {
stop_bad_type(arg, "`NULL` or a string", arg = "arg")
}
}
what_bad_element <- function(what, arg, index) {
stopifnot(is_integerish(index, n = 1, finite = TRUE))
if (is_null(arg)) {
what <- what %||% "Element"
sprintf("%s %d", what, index)
} else {
sprintf("`%s[[%d]]`", arg, index)
}
}
purrr/R/deprec-lift.R 0000644 0001762 0000144 00000013735 14355042456 014167 0 ustar ligges users #' Lift the domain of a function
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `lift_xy()` is a composition helper. It helps you compose
#' functions by lifting their domain from a kind of input to another
#' kind. The domain can be changed from and to a list (l), a vector
#' (v) and dots (d). For example, `lift_ld(fun)` transforms a
#' function taking a list to a function taking dots.
#'
#' The most important of those helpers is probably `lift_dl()`
#' because it allows you to transform a regular function to one that
#' takes a list. This is often essential for composition with purrr
#' functional tools. Since this is such a common function,
#' `lift()` is provided as an alias for that operation.
#'
#' These functions were superseded in purrr 1.0.0 because we no longer believe
#' "lifting" to be a mainstream operation, and we are striving to reduce purrr
#' to its most useful core. Superseded functions will not go away, but will only
#' receive critical bug fixes.
#'
#' @inheritParams as_vector
#' @param ..f A function to lift.
#' @param ... Default arguments for `..f`. These will be
#' evaluated only once, when the lifting factory is called.
#' @return A function.
#' @name lift
#' @seealso [invoke()]
NULL
#' @rdname lift
#' @section from ... to `list(...)` or `c(...)`:
#' Here dots should be taken here in a figurative way. The lifted
#' functions does not need to take dots per se. The function is
#' simply wrapped a function in [do.call()], so instead
#' of taking multiple arguments, it takes a single named list or
#' vector which will be interpreted as its arguments. This is
#' particularly useful when you want to pass a row of a data frame
#' or a list to a function and don't want to manually pull it apart
#' in your function.
#' @param .unnamed If `TRUE`, `ld` or `lv` will not
#' name the parameters in the lifted function signature. This
#' prevents matching of arguments by name and match by position
#' instead.
#' @keywords internal
#' @export
#' @examples
#' ### Lifting from ... to list(...) or c(...)
#'
#' x <- list(x = c(1:100, NA, 1000), na.rm = TRUE, trim = 0.9)
#' lift_dl(mean)(x)
#' # You can also use the lift() alias for this common operation:
#' lift(mean)(x)
#' # now:
#' exec(mean, !!!x)
#'
#' # Default arguments can also be specified directly in lift_dl()
#' list(c(1:100, NA, 1000)) |> lift_dl(mean, na.rm = TRUE)()
#' # now:
#' mean(c(1:100, NA, 1000), na.rm = TRUE)
#'
#' # lift_dl() and lift_ld() are inverse of each other.
#' # Here we transform sum() so that it takes a list
#' fun <- sum |> lift_dl()
#' fun(list(3, NA, 4, na.rm = TRUE))
#' # now:
#' fun <- function(x) exec("sum", !!!x)
#' exec(sum, 3, NA, 4, na.rm = TRUE)
lift <- function(..f, ..., .unnamed = FALSE) {
lifecycle::deprecate_soft("1.0.0", "lift()")
force(..f)
defaults <- list(...)
function(.x = list(), ...) {
if (.unnamed) {
.x <- unname(.x)
}
do.call("..f", c(.x, defaults, list(...)))
}
}
#' @rdname lift
#' @export
lift_dl <- lift
#' @rdname lift
#' @export
lift_dv <- function(..f, ..., .unnamed = FALSE) {
lifecycle::deprecate_soft("1.0.0", "lift_dv()")
force(..f)
defaults <- list(...)
function(.x, ...) {
if (.unnamed) {
.x <- unname(.x)
}
.x <- as.list(.x)
do.call("..f", c(.x, defaults, list(...)))
}
}
#' @rdname lift
#' @section from `c(...)` to `list(...)` or `...`:
#' These factories allow a function taking a vector to take a list
#' or dots instead. The lifted function internally transforms its
#' inputs back to an atomic vector. purrr does not obey the usual R
#' casting rules (e.g., `c(1, "2")` produces a character
#' vector) and will produce an error if the types are not
#' compatible. Additionally, you can enforce a particular vector
#' type by supplying `.type`.
#' @export
#' @examples
#' ### Lifting from c(...) to list(...) or ...
#'
#' # In other situations we need the vector-valued function to take a
#' # variable number of arguments as with pmap(). This is a job for
#' # lift_vd():
#' pmap_dbl(mtcars, lift_vd(mean))
#' # now
#' pmap_dbl(mtcars, \(...) mean(c(...)))
lift_vl <- function(..f, ..., .type) {
lifecycle::deprecate_soft("1.0.0", "lift_vl()")
force(..f)
defaults <- list(...)
if (missing(.type)) .type <- NULL
function(.x = list(), ...) {
x <- as_vector_(.x, .type)
do.call("..f", c(list(x), defaults, list(...)))
}
}
#' @rdname lift
#' @export
lift_vd <- function(..f, ..., .type) {
lifecycle::deprecate_soft("1.0.0", "lift_vd()")
force(..f)
defaults <- list(...)
if (missing(.type)) .type <- NULL
function(...) {
x <- as_vector_(list(...), .type)
do.call("..f", c(list(x), defaults))
}
}
#' @rdname lift
#' @section from list(...) to c(...) or ...:
#' `lift_ld()` turns a function that takes a list into a
#' function that takes dots. `lift_vd()` does the same with a
#' function that takes an atomic vector. These factory functions are
#' the inverse operations of `lift_dl()` and `lift_dv()`.
#'
#' `lift_vd()` internally coerces the inputs of `..f` to
#' an atomic vector. The details of this coercion can be controlled
#' with `.type`.
#'
#' @export
#' @examples
#' ### Lifting from list(...) to c(...) or ...
#'
#' # This kind of lifting is sometimes needed for function
#' # composition. An example would be to use pmap() with a function
#' # that takes a list. In the following, we use some() on each row of
#' # a data frame to check they each contain at least one element
#' # satisfying a condition:
#' mtcars |> pmap_lgl(lift_ld(some, partial(`<`, 200)))
#' # now
#' mtcars |> pmap_lgl(\(...) any(c(...) > 200))
#'
lift_ld <- function(..f, ...) {
lifecycle::deprecate_soft("1.0.0", "lift_ld()")
force(..f)
defaults <- list(...)
function(...) {
do.call("..f", c(list(list(...)), defaults))
}
}
#' @rdname lift
#' @export
lift_lv <- function(..f, ...) {
lifecycle::deprecate_soft("1.0.0", "lift_lv()")
force(..f)
defaults <- list(...)
function(.x, ...) {
do.call("..f", c(list(as.list(.x)), defaults, list(...)))
}
}
purrr/R/every-some-none.R 0000644 0001762 0000144 00000002660 14311356421 015004 0 ustar ligges users #' Do every, some, or none of the elements of a list satisfy a predicate?
#'
#' * `some()` returns `TRUE` when `.p` is `TRUE` for at least one element.
#' * `every()` returns `TRUE` when `.p` is `TRUE` for all elements.
#' * `none()` returns `TRUE` when `.p` is `FALSE` for all elements.
#'
#' @inheritParams keep
#' @param ... Additional arguments passed on to `.p`.
#' @return A logical vector of length 1.
#' @export
#' @examples
#' x <- list(0:10, 5.5)
#' x |> every(is.numeric)
#' x |> every(is.integer)
#' x |> some(is.integer)
#' x |> none(is.character)
#'
#' # Missing values are propagated:
#' some(list(NA, FALSE), identity)
#'
#' # If you need to use these functions in a context where missing values are
#' # unsafe (e.g. in `if ()` conditions), make sure to use safe predicates:
#' if (some(list(NA, FALSE), rlang::is_true)) "foo" else "bar"
every <- function(.x, .p, ...) {
.p <- as_predicate(.p, ..., .mapper = TRUE, .allow_na = TRUE)
val <- TRUE
for (i in seq_along(.x)) {
val <- val && .p(.x[[i]], ...)
if (is_false(val)) {
return(FALSE)
}
}
val
}
#' @export
#' @rdname every
some <- function(.x, .p, ...) {
.p <- as_predicate(.p, ..., .mapper = TRUE, .allow_na = TRUE)
val <- FALSE
for (i in seq_along(.x)) {
val <- val || .p(.x[[i]], ...)
if (is_true(val)) {
return(TRUE)
}
}
val
}
#' @export
#' @rdname every
none <- function(.x, .p, ...) {
every(.x, negate(.p), ...)
}
purrr/R/deprec-prepend.R 0000644 0001762 0000144 00000002257 14313331715 014654 0 ustar ligges users #' Prepend a vector
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' This function was deprecated in purrr 1.0.0 because it's not related to the
#' core purpose of purrr.
#'
#' This is a companion to [append()] to help merging two
#' lists or atomic vectors. `prepend()` is a clearer semantic
#' signal than `c()` that a vector is to be merged at the beginning of
#' another, especially in a pipe chain.
#'
#' @param x the vector to be modified.
#' @param values to be included in the modified vector.
#' @param before a subscript, before which the values are to be appended. If
#' `NULL`, values will be appended at the beginning even for `x` of length 0.
#' @return A merged vector.
#' @keywords internal
#' @export
#' @examples
#' x <- as.list(1:3)
#'
#' x |> append("a")
#' x |> prepend("a")
#' x |> prepend(list("a", "b"), before = 3)
#' prepend(list(), x)
prepend <- function(x, values, before = NULL) {
lifecycle::deprecate_soft("1.0.0", "prepend()", I("append(after = 0)"))
n <- length(x)
stopifnot(is.null(before) || (before > 0 && before <= n))
if (is.null(before) || before == 1) {
c(values, x)
} else {
c(x[1:(before - 1)], values, x[before:n])
}
}
purrr/R/modify.R 0000644 0001762 0000144 00000014147 14350157731 013254 0 ustar ligges users #' Modify elements selectively
#'
#' @description
#'
#' Unlike [map()] and its variants which always return a fixed object
#' type (list for `map()`, integer vector for `map_int()`, etc), the
#' `modify()` family always returns the same type as the input object.
#'
#' * `modify()` is a shortcut for `x[[i]] <- f(x[[i]]); return(x)`.
#'
#' * `modify_if()` only modifies the elements of `x` that satisfy a
#' predicate and leaves the others unchanged. `modify_at()` only
#' modifies elements given by names or positions.
#'
#' * `modify2()` modifies the elements of `.x` but also passes the
#' elements of `.y` to `.f`, just like [map2()]. `imodify()` passes
#' the names or the indices to `.f` like [imap()] does.
#'
#' * [modify_in()] modifies a single element in a [pluck()] location.
#'
#' @param .x A vector.
#' @param .y A vector, usually the same length as `.x`.
#' @inheritParams map2
#' @inheritParams map
#' @param .f A function specified in the same way as the corresponding map
#' function.
#' @return An object the same class as `.x`
#'
#' @details
#'
#' Since the transformation can alter the structure of the input; it's
#' your responsibility to ensure that the transformation produces a
#' valid output. For example, if you're modifying a data frame, `.f`
#' must preserve the length of the input.
#'
#' @section Genericity:
#'
#' `modify()` and variants are generic over classes that implement
#' `length()`, `[[` and `[[<-` methods. If the default implementation
#' is not compatible for your class, you can override them with your
#' own methods.
#'
#' If you implement your own `modify()` method, make sure it satisfies
#' the following invariants:
#'
#' ```
#' modify(x, identity) === x
#' modify(x, compose(f, g)) === modify(x, g) |> modify(f)
#' ```
#'
#' These invariants are known as the [functor
#' laws](https://wiki.haskell.org/Functor#Functor_Laws) in computer
#' science.
#'
#'
#' @family map variants
#' @family modify variants
#' @examples
#' # Convert factors to characters
#' iris |>
#' modify_if(is.factor, as.character) |>
#' str()
#'
#' # Specify which columns to map with a numeric vector of positions:
#' mtcars |> modify_at(c(1, 4, 5), as.character) |> str()
#'
#' # Or with a vector of names:
#' mtcars |> modify_at(c("cyl", "am"), as.character) |> str()
#'
#' list(x = sample(c(TRUE, FALSE), 100, replace = TRUE), y = 1:100) |>
#' list_transpose(simplify = FALSE) |>
#' modify_if("x", \(l) list(x = l$x, y = l$y * 100)) |>
#' list_transpose()
#'
#' # Use modify2() to map over two vectors and preserve the type of
#' # the first one:
#' x <- c(foo = 1L, bar = 2L)
#' y <- c(TRUE, FALSE)
#' modify2(x, y, \(x, cond) if (cond) x else 0L)
#'
#' # Use a predicate function to decide whether to map a function:
#' modify_if(iris, is.factor, as.character)
#'
#' # Specify an alternative with the `.else` argument:
#' modify_if(iris, is.factor, as.character, .else = as.integer)
#' @export
modify <- function(.x, .f, ...) {
.f <- as_mapper(.f, ...)
if (vec_is_list(.x)) {
out <- map(vec_proxy(.x), .f, ...)
vec_restore(out, .x)
} else if (is.data.frame(.x)) {
size <- vec_size(.x)
out <- unclass(vec_proxy(.x))
out <- map(out, .f, ...)
out <- vec_recycle_common(!!!out, .size = size, .arg = "out")
out <- new_data_frame(out, n = size)
vec_restore(out, .x)
} else if (vec_is(.x)) {
map_vec(.x, .f, ..., .ptype = .x)
} else if (is.list(.x) || is.null(.x)) {
.x[] <- map(.x, .f, ...)
.x
} else {
cli::cli_abort(
"{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}."
)
}
}
#' @rdname modify
#' @inheritParams map_if
#' @export
modify_if <- function(.x, .p, .f, ..., .else = NULL) {
where <- where_if(.x, .p)
.x <- modify_where(.x, where, .f, ...)
if (!is.null(.else)) {
.else <- as_mapper(.else, ...)
.x <- modify_where(.x, !where, .else, ...)
}
.x
}
#' @rdname modify
#' @inheritParams map_at
#' @export
modify_at <- function(.x, .at, .f, ...) {
where <- where_at(.x, .at, user_env = caller_env())
modify_where(.x, where, .f, ...)
}
#' @rdname modify
#' @export
modify2 <- function(.x, .y, .f, ...) {
.f <- as_mapper(.f, ...)
if (vec_is_list(.x)) {
out <- map2(vec_proxy(.x), .y, .f, ...)
vec_restore(out, .x)
} else if (is.data.frame(.x)) {
size <- vec_size(.x)
out <- unclass(vec_proxy(.x))
out <- map2(out, .y, .f, ...)
out <- vec_recycle_common(!!!out, .size = size, .arg = "out")
out <- new_data_frame(out, n = size)
vec_restore(out, .x)
} else if (vec_is(.x)) {
map2_vec(.x, .y, .f, ..., .ptype = .x)
} else if (is.null(.x) || is.list(.x)) {
out <- map2(.x, .y, .f, ...)
if (length(out) > length(.x)) {
.x <- .x[rep(1L, length(out))]
}
.x[] <- out
.x
} else {
cli::cli_abort(
"{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}."
)
}
}
#' @rdname modify
#' @export
imodify <- function(.x, .f, ...) {
modify2(.x, vec_index(.x), .f, ...)
}
# helpers -----------------------------------------------------------------
modify_where <- function(.x, .where, .f, ..., .purrr_error_call = caller_env()) {
if (vec_is_list(.x)) {
out <- vec_proxy(.x)
out[.where] <- no_zap(map(out[.where], .f, ...), .purrr_error_call)
vec_restore(out, .x)
} else if (is.data.frame(.x)) {
size <- vec_size(.x)
out <- unclass(vec_proxy(.x))
new <- no_zap(map(out[.where], .f, ...), .purrr_error_call)
out[.where] <- vec_recycle_common(!!!new, .size = size, .arg = "out")
out <- new_data_frame(out, n = size)
vec_restore(out, .x)
} else if (vec_is(.x)) {
.x[.where] <- map_vec(.x[.where], .f, ..., .ptype = .x)
.x
} else if (is.null(.x) || is.list(.x)) {
.x[.where] <- no_zap(map(.x[.where], .f, ...), .purrr_error_call)
.x
} else {
cli::cli_abort(
"{.arg .x} must be a vector, list, or data frame, not {.obj_type_friendly {.x}}.",
call = .purrr_error_call
)
}
}
no_zap <- function(x, error_call) {
has_zap <- some(x, is_zap)
if (!has_zap) {
x
} else {
cli::cli_abort(
"Can't use {.fn zap} to change the size of the output.",
call = error_call
)
}
}
purrr/R/pmap.R 0000644 0001762 0000144 00000010305 14355573666 012730 0 ustar ligges users #' Map over multiple input simultaneously (in "parallel")
#'
#' @description
#' These functions are variants of [map()] that iterate over multiple arguments
#' simultaneously. They are parallel in the sense that each input is processed
#' in parallel with the others, not in the sense of multicore computing, i.e.
#' they share the same notion of "parallel" as [base::pmax()] and [base::pmin()].
#'
#' @param .l A list of vectors. The length of `.l` determines the number of
#' arguments that `.f` will be called with. Arguments will be supply by
#' position if unnamed, and by name if named.
#'
#' Vectors of length 1 will be recycled to any length; all other elements
#' must be have the same length.
#'
#' A data frame is an important special case of `.l`. It will cause `.f`
#' to be called once for each row.
#' @param .f A function, specified in one of the following ways:
#'
#' * A named function.
#' * An anonymous function, e.g. `\(x, y, z) x + y / z` or
#' `function(x, y, z) x + y / z`
#' * A formula, e.g. `~ ..1 + ..2 / ..3`. This syntax is not recommended as
#' you can only refer to arguments by position.
#' @inheritParams map
#' @inherit map return
#' @family map variants
#' @export
#' @examples
#' x <- list(1, 1, 1)
#' y <- list(10, 20, 30)
#' z <- list(100, 200, 300)
#' pmap(list(x, y, z), sum)
#'
#' # Matching arguments by position
#' pmap(list(x, y, z), function(first, second, third) (first + third) * second)
#'
#' # Matching arguments by name
#' l <- list(a = x, b = y, c = z)
#' pmap(l, function(c, b, a) (a + c) * b)
#'
#' # Vectorizing a function over multiple arguments
#' df <- data.frame(
#' x = c("apple", "banana", "cherry"),
#' pattern = c("p", "n", "h"),
#' replacement = c("P", "N", "H"),
#' stringsAsFactors = FALSE
#' )
#' pmap(df, gsub)
#' pmap_chr(df, gsub)
#'
#' # Use `...` to absorb unused components of input list .l
#' df <- data.frame(
#' x = 1:3,
#' y = 10:12,
#' z = letters[1:3]
#' )
#' plus <- function(x, y) x + y
#' \dontrun{
#' # this won't work
#' pmap(df, plus)
#' }
#' # but this will
#' plus2 <- function(x, y, ...) x + y
#' pmap_dbl(df, plus2)
#'
#' # The "p" for "parallel" in pmap() is the same as in base::pmin()
#' # and base::pmax()
#' df <- data.frame(
#' x = c(1, 2, 5),
#' y = c(5, 4, 8)
#' )
#' # all produce the same result
#' pmin(df$x, df$y)
#' map2_dbl(df$x, df$y, min)
#' pmap_dbl(df, min)
pmap <- function(.l, .f, ..., .progress = FALSE) {
pmap_("list", .l, .f, ..., .progress = .progress)
}
#' @export
#' @rdname pmap
pmap_lgl <- function(.l, .f, ..., .progress = FALSE) {
pmap_("logical", .l, .f, ..., .progress = .progress)
}
#' @export
#' @rdname pmap
pmap_int <- function(.l, .f, ..., .progress = FALSE) {
pmap_("integer", .l, .f, ..., .progress = .progress)
}
#' @export
#' @rdname pmap
pmap_dbl <- function(.l, .f, ..., .progress = FALSE) {
pmap_("double", .l, .f, ..., .progress = .progress)
}
#' @export
#' @rdname pmap
pmap_chr <- function(.l, .f, ..., .progress = FALSE) {
pmap_("character", .l, .f, ..., .progress = .progress)
}
pmap_ <- function(.type,
.l,
.f,
...,
.progress = FALSE,
.purrr_user_env = caller_env(2),
.purrr_error_call = caller_env()) {
.l <- vctrs_list_compat(.l, error_call = .purrr_error_call)
.l <- map(.l, vctrs_vec_compat)
n <- vec_size_common(!!!.l, .arg = ".l", .call = .purrr_error_call)
.l <- vec_recycle_common(!!!.l, .size = n, .arg = ".l", .call = .purrr_error_call)
if (length(.l) > 0L) {
names <- vec_names(.l[[1L]])
} else {
names <- NULL
}
.f <- as_mapper(.f, ...)
call_names <- names(.l)
call_n <- length(.l)
i <- 0L
with_indexed_errors(
i = i,
names = names,
error_call = .purrr_error_call,
call_with_cleanup(pmap_impl, environment(), .type, .progress, n, names, i, call_names, call_n)
)
}
#' @export
#' @rdname pmap
pmap_vec <- function(.l, .f, ..., .ptype = NULL, .progress = FALSE) {
.f <- as_mapper(.f, ...)
out <- pmap(.l, .f, ..., .progress = .progress)
simplify_impl(out, ptype = .ptype)
}
#' @export
#' @rdname pmap
pwalk <- function(.l, .f, ..., .progress = FALSE) {
pmap(.l, .f, ..., .progress = .progress)
invisible(.l)
}
purrr/R/list-simplify.R 0000644 0001762 0000144 00000005657 14326311377 014601 0 ustar ligges users #' Simplify a list to an atomic or S3 vector
#'
#' Simplification maintains a one-to-one correspondence between the input
#' and output, implying that each element of `x` must contain a one element
#' vector or a one-row data frame. If you don't want to maintain this
#' correspondence, then you probably want either [list_c()]/[list_rbind()] or
#' [list_flatten()].
#'
#' @param x A list.
#' @param strict What should happen if simplification fails? If `TRUE`,
#' it will error. If `FALSE` and `ptype` is not supplied, it will return `x`
#' unchanged.
#' @param ptype An optional prototype to ensure that the output type is always
#' the same.
#' @inheritParams rlang::args_dots_empty
#' @returns A vector the same length as `x`.
#' @export
#' @examples
#' list_simplify(list(1, 2, 3))
#'
#' # Only works when vectors are length one and have compatible types:
#' try(list_simplify(list(1, 2, 1:3)))
#' try(list_simplify(list(1, 2, "x")))
#'
#' # Unless you strict = FALSE, in which case you get the input back:
#' list_simplify(list(1, 2, 1:3), strict = FALSE)
#' list_simplify(list(1, 2, "x"), strict = FALSE)
list_simplify <- function(x, ..., strict = TRUE, ptype = NULL) {
check_dots_empty()
check_bool(strict)
simplify_impl(x, strict = strict, ptype = ptype)
}
# Wrapper used by purrr functions that do automatic simplification
list_simplify_internal <- function(x,
simplify = NA,
ptype = NULL,
error_arg = caller_arg(x),
error_call = caller_env()) {
check_bool(simplify, allow_na = TRUE, call = error_call)
if (!is.null(ptype) && isFALSE(simplify)) {
cli::cli_abort(
"Can't specify {.arg ptype} when `simplify = FALSE`.",
arg = "ptype",
call = error_call
)
}
if (isFALSE(simplify)) {
return(x)
}
simplify_impl(
x,
strict = !is.na(simplify),
ptype = ptype,
error_arg = error_arg,
error_call = error_call
)
}
simplify_impl <- function(x,
strict = TRUE,
ptype = NULL,
error_arg = caller_arg(x),
error_call = caller_env()) {
vec_check_list(x, arg = error_arg, call = error_call)
# Handle the cases where we definitely can't simplify
if (strict) {
list_check_all_vectors(x, arg = error_arg, call = error_call)
list_check_all_size(x, 1, arg = error_arg, call = error_call)
} else {
can_simplify <- list_all_vectors(x) && all(list_sizes(x) == 1L)
if (!can_simplify) {
return(x)
}
}
names <- vec_names(x)
x <- vec_set_names(x, NULL)
out <- tryCatch(
list_unchop(x, ptype = ptype, error_arg = error_arg, error_call = error_call),
vctrs_error_incompatible_type = function(err) {
if (strict || !is.null(ptype)) {
cnd_signal(err)
} else {
x
}
}
)
vec_set_names(out, names)
}
purrr/R/faq.R 0000644 0001762 0000144 00000002274 14304371054 012525 0 ustar ligges users #' Best practices for exporting adverb-wrapped functions
#'
#' @description
#' Exporting functions created with purrr adverbs in your package
#' requires some precautions because the functions will contain internal
#' purrr code. This means that creating them once and for all when
#' the package is built may cause problems when purrr is updated, because
#' a function that the adverb uses might no longer exist.
#'
#' Instead, either create the modified function once per session on package
#' load or wrap the call within another function every time you use it:
#'
#' * Using the \code{\link[=.onLoad]{.onLoad()}} hook:
#' ```
#' #' My function
#' #' @export
#' insist_my_function <- function(...) "dummy"
#'
#' my_function <- function(...) {
#' # Implementation
#' }
#'
#' .onLoad <- function(lib, pkg) {
#' insist_my_function <<- purrr::insistently(my_function)
#' }
#' ```
#'
#' * Using a wrapper function:
#' ```
#' my_function <- function(...) {
#' # Implementation
#' }
#'
#' #' My function
#' #' @export
#' insist_my_function <- function(...) {
#' purrr::insistently(my_function)(...)
#' }
#' ```
#' @keywords internal
#' @name faq-adverbs-export
NULL
purrr/NEWS.md 0000644 0001762 0000144 00000110174 14464464633 012544 0 ustar ligges users # purrr 1.0.2
* Fixed valgrind issue.
* Deprecation infrastructure in `map_chr()` now has much less overhead
leading to improved performance (#1089).
* purrr now requires R 3.5.0.
# purrr 1.0.1
* As of purrr 1.0.0, the `map()` family of functions wraps all errors generated
by `.f` inside an wrapper error that tracks the iteration index. As of purrr
1.0.1, this error now has a custom class (`purrr_error_indexed`),
`location` and `name` fields, and is documented in `?purrr_error_indexed`
(#1027).
* `map()` errors with named inputs also report the name of the element that
errored.
* Fixed an issue where progress bars weren't being closed when user interrupts
or errors were encountered during a `map()` call (#1024).
* Fixed an invalid C signature for `pluck()` (#1018).
* Set `Biarch: true` to build purrr on 32-bit Windows on R < 4.2.0 (#1017).
# purrr 1.0.0
## Breaking changes
### Core purpose refinements
* `cross()` and all its variants have been deprecated in favour of
`tidyr::expand_grid()`. These functions were slow and buggy and we
no longer think they are the right approach to solving this problem.
See #768 for more information.
* `update_list()` (#858) and `rerun()` (#877), and the use of tidyselect
with `map_at()` and friends (#874) have been deprecated. These functions
use some form of non-standard evaluation which we now believe is a poor
fit for purrr.
* The `lift_*` family of functions has been deprecated. We no longer believe
these to be a good fit for purrr because they rely on a style of function
manipulation that is very uncommon in R code (#871).
* `prepend()`, `rdunif()`, `rbernoulli()`, `when()`, and `list_along()` have
all been deprecated (#925). It's now clear that they don't align with the
core purpose of purrr.
* `splice()` is deprecated because we no longer believe that automatic
splicing makes for good UI. Instead use `list2()` + `!!!` or
`list_flatten()` (#869).
### Mapping
* Use of map functions with expressions, calls, and pairlists has been
deprecated (#961).
* All map `_raw()` variants have been deprecated because they are of limited
use and you can now use `map_vec()` instead (#903).
* In `map_chr()`, automatic conversion from logical, integer, and double to
character is now deprecated. Use an explicit `as.character()` if needed
(#904).
* Errors from `.f` are now wrapped in an additional class that gives
information about where the error occurred (#945).
### Deprecation next steps
* `as_function()` and the `...f` argument to `partial()` are no longer
supported. They have been defunct for quite some time.
* Soft deprecated functions: `%@%`, `reduce_right()`, `reduce2_right()`,
`accumulate_right()` are now fully deprecated. Similarly, the
`.lazy`, `.env`, and `.first` arguments to `partial()`,
and the `.right` argument to `detect()` and `detect_index()`
are fully deprecated. Removing elements with `NULL` in `list_modify()` and
`list_merge()` is now fully deprecated.
* `is_numeric()` and `is_scalar_numeric()` have been removed. They have
been deprecated since purrr 0.2.3 (Sep 2017).
* `invoke_*()` is now deprecated. It was superseded in 0.3.0 (Jan 2019) and
3.5 years later, we have decided to deprecate it as part of the API
refinement in the 1.0.0 release.
* `map_call()` has been removed. It was made defunct in 0.3.0 (Jan 2019).
## New features
* `*_at()` can now take a function (or formula) that's passed the vector of
element names and returns the elements to select.
* New `map_vec()`, `map2_vec()`, and `pmap_vec()` work on all types of vectors,
extending `map_lgl()`, `map_int()`, and friends so that you can easily work
with dates, factors, date-times and more (#435).
* New `keep_at()` and `discard_at()` that work like `keep()` and `discard()`
but operation on element names rather than element contents (#817).
* Some mapping functions have now a `.progress` argument to create a
progress bar. See `?progress_bars` (#149).
* purrr is now licensed as MIT (#805).
* `modify()`, `modify_if()`, `modify_at()`, and `modify2()` are no longer
generics. We have discovered a simple implementation that no longer requires
genericity and methods were only provided by a very small number of packages
(#894).
* purrr now uses the base pipe (`|>`) and anonymous function short hand (`\(x)`),
in all examples. This means that examples will no longer work in R 4.0 and
earlier so in those versions of R, the examples are automatically converted
to a regular section with a note that they might not work (#936).
* When map functions fail, they now report the element they failed at (#945).
* New `modify_tree()` for recursively modifying nested data structures (#720).
### Flattening and simplification
* New `list_c()`, `list_rbind()`, and `list_cbind()` make it easy to
`c()`, `rbind()`, or `cbind()` all of the elements in a list.
* New `list_simplify()` reduces a list of length-1 vectors to a simpler atomic
or S3 vector (#900).
* New `list_transpose()` which automatically simplifies if possible (#875).
* `accumulate()` and `accumulate2()` now both simplify the output if possible
using vctrs. New arguments `simplify` and `ptype` allow you to control the
details of simplification (#774, #809).
* `flatten()` and friends are superseded in favour of `list_flatten()`,
`list_c()`, `list_cbind()`, and `list_rbind()`.
* `*_dfc()` and `*_dfr()` have been superseded in favour of using the
appropriate map function along with `list_rbind()` or `list_cbind()` (#912).
* `simplify()`, `simplify_all()`, and `as_vector()` have been superseded in
favour of `list_simplify()`. It provides a more consistent definition of
simplification (#900).
* `transpose()` has been superseded in favour of `list_transpose()` (#875).
It has built-in simplification.
### Tidyverse consistency
* `_lgl()`, `_int()`, `_int()`, and `_dbl()` now use the same (strict) coercion
methods as vctrs (#904). This means that:
* `map_chr(TRUE, identity)`, `map_chr(0L, identity)`, and
`map_chr(1L, identity)` are deprecated because we now believe that
converting a logical/integer/double to a character vector should require
an explicit coercion.
* `map_int(1.5, identity)` now fails because we believe that silently
truncating doubles to integers is dangerous. But note that
`map_int(1, identity)` still works since no numeric precision is lost.
* `map_int(c(TRUE, FALSE), identity)`, `map_dbl(c(TRUE, FALSE), identity)`,
`map_lgl(c(1L, 0L), identity)` and `map_lgl(c(1, 0), identity)` now
succeed because 1/TRUE and 0/FALSE should be interchangeable.
* `map2()`, `modify2()`, and `pmap()` now use tidyverse recycling rules where
vectors of length 1 are recycled to any size but all others must have
the same length (#878).
* `map2()` and `pmap()` now recycle names of their first input if
needed (#783).
* `modify()`, `modify_if()`, and `modify_at()` have been reimplemented using
vctrs principles. This shouldn't have an user facing impact, but it does
make the implementation much simpler.
### Plucking
* `vec_depth()` is now `pluck_depth()` and works with more types of input
(#818).
* `pluck()` now requires indices to be length 1 (#813). It also now reports
the correct type if you supply an unexpected index.
* `pluck()` now accepts negative integers, indexing from the right (#603).
* `pluck()` and `chuck()` now fail if you provide named inputs to ... (#788).
* `pluck()` no longer replaces 0-length vectors with `default`; it now
only applies absent and `NULL` components (#480).
* `pluck<-`/`assign_in()` can now modify non-existing locations (#704).
### Setting with NULL
* `pluck<-`/`assign_in()` now sets elements to `NULL` rather than removing them
(#636). Now use the explicit `zap()` if you want to remove elements.
* `modify()`, `modify2()`, and `modify_if()` now correctly handle `NULL`s
in replacement values (#655, #746, #753).
* `list_modify()`'s interface has been standardised. Modifying with `NULL`
now always creates a `NULL` in the output (#810)
### `list_` functions
* New `list_assign()` which is similar to `list_modify()` but doesn't work
recursively (#822).
* `list_modify()` no longer recurses into data frames (and other objects built
on top of lists that are fundamentally non-list like) (#810). You can
revert to the previous behaviour by setting `.is_node = is.list`.
## Minor improvements and bug fixes
* `capture_output()` correctly uses `conditionMessage()` instead of directly
interrogating the `message` field (#1010).
* `modify()` no longer works with calls or pairlists.
* `modify_depth()` is no longer a generic. This makes it more consistent
with `map_depth()`.
* `map_depth()` and `modify_depth()` have a new `is_node` argument that
allows you to control what counts as a level. The default uses
`vec_is_list()` to avoid recursing into rich S3 objects like linear models
or data.frames (#958, #920).
* `map_depth()` and `modify_depth()` now correctly recurse at depth 1.
* `as_mapper()` is now around twice as fast when used with character,
integer, or list (#820).
* `possibly()` now defaults `otherwise` to NULL.
* `modify_if(.else)` is now actually evaluated for atomic vectors (@mgirlich,
#701).
* `lmap_if()` correctly handles `.else` functions (#847).
* `every()` now correctly propagates missing values using the same
rules as `&&` (#751). Internally, it has become a wrapper around
`&&`. This makes it consistent with `&&` and also with `some()`
which has always been a wrapper around `||` with the same
propagation rules.
* `every()` and `some()` now properly check the return value of their
predicate function. It must now return a `TRUE`, `FALSE`, or `NA`.
* Greatly improved performance of functions created with `partial()` (#715).
Their invocation is now as fast as for functions creating manually.
* `partial()` no longer inlines the function in the call stack. This
fixes issues when `partial()` is used with `lm()` for instance (#707).
# purrr 0.3.5
* Fixes for CRAN checks.
# purrr 0.3.4
* Fixed issue in `list_modify()` that prevented lists from being
removed with `zap()` (@adamroyjones, #777).
* Added documentation for exporting functions created with purrr
adverb (@njtierney, #668). See `?faq-adverbs-export`.
* Added `none()`, which tests that a predicate is false for all elements
(the opposite of `every()`) (@AliciaSchep, #735).
# purrr 0.3.3
* Maintenance release.
* The documentation of `map()` and its variants has been improved by
@surdina as part of the Tidyverse Developer Day (@surdina, #671).
* purrr now depends on R 3.2 or greater.
# purrr 0.3.2
* Fix protection issues reported by rchk.
# purrr 0.3.1
* `reduce()` now forces arguments (#643).
* Fixed an issue in `partial()` with generic functions (#647).
* `negate()` now works with generic functions and functions with early
returns.
* `compose()` now works with generic functions again (#629, #639). Its
set of unit tests was expanded to cover many edge cases.
* `prepend()` now works with empty lists (@czeildi, #637)
# purrr 0.3.0
## Breaking changes
* `modify()` and variants are now wrapping `[[<-` instead of
`[<-`. This change increases the genericity of these functions but
might cause different behaviour in some cases.
For instance, the `[[<-` for data frames is stricter than the `[<-`
method and might throw errors instead of warnings. This is the case
when assigning a longer vector than the number of rows. `[<-`
truncates the vector with a warning, `[[<-` fails with an error (as
is appropriate).
* `modify()` and variants now return the same type as the input when
the input is an atomic vector.
* All functionals taking predicate functions (like `keep()`,
`detect()`, `some()`) got stricter. Predicate functions must now
return a single `TRUE` or `FALSE`.
This change is meant to detect problems early with a more meaningful
error message.
## Plucking
* New `chuck()` function. This is a strict variant of `pluck()` that
throws errors when an element does not exist instead of returning
`NULL` (@daniel-barnett, #482).
* New `assign_in()` and `pluck<-` functions. They modify a data
structure at an existing pluck location.
* New `modify_in()` function to map a function at a pluck location.
* `pluck()` now dispatches properly with S3 vectors. The vector class
must implement a `length()` method for numeric indexing and a
`names()` method for string indexing.
* `pluck()` now supports primitive functions (#404).
## Mapping
* New `.else` argument for `map_if()` and `modify_if()`. They take an
alternative function that is mapped over elements of the input for
which the predicate function returns `FALSE` (#324).
* `reduce()`, `reduce2()`, `accumulate()`, and `accumulate2()` now
terminate early when the function returns a value wrapped with
`done()` (#253). When an empty `done()` is returned, the
value at the last iteration is returned instead.
* Functions taking predicates (`map_if()`, `keep()`, `some()`,
`every()`, `keep()`, etc) now fail with an informative message when
the return value is not `TRUE` or `FALSE` (#470).
This is a breaking change for `every()` and `some()` which were
documented to be more liberal in the values they accepted as logical
(any vector was considered `TRUE` if not a single `FALSE` value, no
matter its length). These functions signal soft-deprecation warnings
instead of a hard failure.
Edit (purr 0.4.0): `every()` and `some()` never issued deprecation
warnings because of a technical issue. We didn't fix the warnings in
the end, and using predicates returning `NA` is no longer considered
deprecated. If you need to use `every()` and `some()` in contexts
where `NA` propagation is unsafe, e.g. in `if ()` conditions, make
sure to use safe predicate functions like `is_true()`.
* `modify()` and variants are now implemented using `length()`, `[[`,
and `[[<-` methods. This implementation should be compatible with
most vector classes.
* New `modify2()` and `imodify()` functions. These work like `map()`
and `imap()` but preserve the type of `.x` in the return value.
* `pmap()` and `pwalk()` now preserve class for inputs of `factor`,
`Date`, `POSIXct` and other atomic S3 classes with an appropriate
`[[` method (#358, @mikmart).
* `modify()`, `modify_if()` and `modify_at()` now preserve the class of atomic
vectors instead of promoting them to lists. New S3 methods are provided for
character, logical, double, and integer classes (@t-kalinowski, #417).
* By popular request, `at_depth()` has been brought back as
`map_depth()`. Like `modify_depth()`, it applies a function at a
specified level of a data structure. However, it transforms all
traversed vectors up to `.depth` to bare lists (#381).
* `map_at()`, `modify_at()` and `lmap_at()` accept negative values for
`.at`, ignoring elements at those positions.
* `map()` and `modify()` now work with calls and pairlists (#412).
* `modify_depth()` now modifies atomic leaves as well. This makes
`modify_depth(x, 1, fn)` equivalent to `modify(x, fn)` (#359).
* New `accumulate2()` function which is to `accumulate()` what
`reduce2()` is to `reduce()`.
## Rates
* New `rate_backoff()` and `rate_delay()` functions to create rate
objects. You can pass rates to `insistently()`, `slowly()`, or the
lower level function `rate_sleep()`. This will cause a function to
wait for a given amount of time with exponential backoff
(increasingly larger waiting times) or for a constant delay.
* `insistently(f)` modifies a function, `f`, so that it is repeatedly
called until it succeeds (@richierocks, @ijlyttle).
`slowly()` modifies a function so that it waits for a given amount
of time between calls.
## `partial()`
The interface of `partial()` has been simplified. It now supports
quasiquotation to control the timing of evaluation, and the
`rlang::call_modify()` syntax to control the position of partialised
arguments.
* `partial()` now supports empty `... = ` argument to specify the
position of future arguments, relative to partialised ones. This
syntax is borrowed from (and implemented with) `rlang::call_modify()`.
To prevent partial matching of `...` on `...f`, the latter has been
renamed to `.f`, which is more consistent with other purrr function
signatures.
* `partial()` now supports quasiquotation. When you unquote an
argument, it is evaluated only once at function creation time. This
is more flexible than the `.lazy` argument since you can control the
timing of evaluation for each argument. Consequently, `.lazy` is
soft-deprecated (#457).
* Fixed an infinite loop when partialised function is given the same
name as the original function (#387).
* `partial()` now calls `as_closure()` on primitive functions to
ensure argument matching (#360).
* The `.lazy` argument of `partial()` is soft-deprecated in favour of
quasiquotation:
```r
# Before
partial(fn, u = runif(1), n = rnorm(1), .lazy = FALSE)
# After
partial(fn, u = !!runif(1), n = !!rnorm(1)) # All constant
partial(fn, u = !!runif(1), n = rnorm(1)) # First constant
```
## Minor improvements and fixes
* The tibble package is now in Suggests rather than Imports. This
brings the hard dependency of purrr to just rlang and magrittr.
* `compose()` now returns an identity function when called without
inputs.
* Functions created with `compose()` now have the same formal
parameters as the first function to be called. They also feature a
more informative print method that prints all composed functions in
turn (@egnha, #366).
* New `.dir` argument in `compose()`. When set to `"forward"`, the
functions are composed from left to right rather than right to left.
* `list_modify()` now supports the `zap()` sentinel (reexported from
rlang) to remove elements from lists. Consequently, removing
elements with the ambiguous sentinel `NULL` is soft-deprecated.
* The requirements of `list_modify()` and `list_merge()` have been
relaxed. Previously it required both the modified lists and the
inputs to be either named or unnamed. This restriction now only
applies to inputs in `...`. When inputs are all named, they are
matched to the list by name. When they are all unnamed, they are
matched positionally. Otherwise, this is an error.
* Fixed ordering of names returned by `accumulate_right()`
output. They now correspond to the order of inputs.
* Fixed names of `accumulate()` output when `.init` is supplied.
* `compose()` now supports composition with lambdas (@ColinFay, #556)
* Fixed a `pmap()` crash with empty lists on the Win32 platform (#565).
* `modify_depth` now has `.ragged` argument evaluates correctly to
`TRUE` by default when `.depth < 0` (@cderv, #530).
* `accumulate()` now inherits names from their first input (@AshesITR, #446).
* `attr_getter()` no longer uses partial matching. For example, if an
`x` object has a `labels` attribute but no `label` attribute,
`attr_getter("label")(x)` will no longer extract the `labels`
attribute (#460, @huftis).
* `flatten_dfr()` and `flatten_dfc()` now aborts if dplyr is not installed. (#454)
* `imap_dfr()` now works with `.id` argument is provided (#429)
* `list_modify()`, `update_list()` and `list_merge()` now handle duplicate
duplicate argument names correctly (#441, @mgirlich).
* `map_raw`, `imap_raw`, `flatten_raw`, `invoke_map_raw`, `map2_raw` and `pmap_raw`
added to support raw vectors. (#455, @romainfrancois)
* `flatten()` now supports raw and complex elements.
* `array_branch()` and `array_tree()` now retain the `dimnames()` of the input
array (#584, @flying-sheep)
* `pluck()` no longer flattens lists of arguments. You can still do it
manually with `!!!`. This change is for consistency with other
dots-collecting functions of the tidyverse.
* `map_at()`, `lmap_at()` and `modify_at()` now supports selection
using `vars()` and `tidyselect` (@ColinFay, #608).
Note that for now you need to import `vars()` from dplyr or call it
qualified like `dplyr::vars()`. It will be reexported from rlang in
a future release.
* `detect()` now has a .default argument to specify the value returned when
nothing is detected (#622, @ColinFay).
## Life cycle
### `.dir` arguments
We have standardised the purrr API for reverse iteration with a common
`.dir` argument.
* `reduce_right()` is soft-deprecated and replaced by a new `.dir`
argument of `reduce()`:
```{r}
# Before:
reduce_right(1:3, f)
# After:
reduce(1:3, f, .dir = "backward")
```
Note that the details of the computation have changed. Whereas
`reduce_right()` computed `f(f(3, 2), 1)`, it now computes `f(1,
f(2, 3))`. This is the standard way of reducing from the right.
To produce the exact same reduction as `reduce_right()`, simply
reverse your vector and use a left reduction:
```{r}
# Before:
reduce_right(1:3, f)
# After:
reduce(rev(1:3), f)
```
* `reduce2_right()` is soft-deprecated without replacement. It is not
clear what algorithmic properties should a right reduction have in
this case. Please reach out if you know about a use case for a right
reduction with a ternary function.
* `accumulate_right()` is soft-deprecated and replaced by the new
`.dir` argument of `accumulate()`. Note that the algorithm has
slightly changed: the accumulated value is passed to the right
rather than the left, which is consistent with a right reduction.
```{r}
# Before:
accumulate_right(1:3, f)
# After:
accumulate(1:3, f, .dir = "backward")
```
* The `.right` argument of `detect()` and `detect_index()` is
soft-deprecated and renamed to `.dir` for consistency with other
functions and clarity of the interface.
```{r}
# Before
detect(x, f, .right = TRUE)
# After
detect(x, f, .dir = "backward")
```
### Simplification of `partial()`
The interface of `partial()` has been simplified (see more about
`partial()` below):
* The `.lazy` argument of `partial()` is soft-deprecated in favour of
quasiquotation.
* We had to rename `...f` to `.f` in `partial()` in order to support
`... = ` argument (which would otherwise partial-match on
`...f`). This also makes `partial()` more consistent with other
purrr function signatures.
### Retirement of `invoke()`
`invoke()` and `invoke_map()` are retired in favour of `exec()`. Note
that retired functions are no longer under active development, but
continue to be maintained undefinitely in the package.
* `invoke()` is retired in favour of the `exec()` function, reexported
from rlang. `exec()` evaluates a function call built from its inputs
and supports tidy dots:
```r
# Before:
invoke(mean, list(na.rm = TRUE), x = 1:10)
# After
exec(mean, 1:10, !!!list(na.rm = TRUE))
```
Note that retired functions are not removed from the package and
will be maintained undefinitely.
* `invoke_map()` is retired without replacement because it is more
complex to understand than the corresponding code using `map()`,
`map2()` and `exec()`:
```r
# Before:
invoke_map(fns, list(args))
invoke_map(fns, list(args1, args2))
# After:
map(fns, exec, !!!args)
map2(fns, list(args1, args2), function(fn, args) exec(fn, !!!args))
```
### Other lifecycle changes
* `%@%` is soft-deprecated, please use the operator exported in rlang
instead. The latter features an interface more consistent with `@`
as it uses NSE, supports S4 fields, and has an assignment variant.
* Removing elements from lists using `NULL` in `list_modify()` is
soft-deprecated. Please use the new `zap()` sentinel reexported from
rlang instead:
```{r}
# Before:
list_modify(x, foo = NULL)
# After:
list_modify(x, foo = zap())
```
This change is motivated by the ambiguity of `NULL` as a deletion
sentinel because `NULL` is also a valid value in lists. In the
future, `NULL` will set an element to `NULL` rather than removing
the element.
* `rerun()` is now in the questioning stage because we are no longer
convinced NSE functions are a good fit for purrr. Also, `rerun(n,
x)` can just as easily be expressed as `map(1:n, ~ x)` (with the
added benefit of being passed the current index as argument to the
lambda).
* `map_call()` is defunct.
# purrr 0.2.5
* This is a maintenance release following the release of dplyr 0.7.5.
# purrr 0.2.4
* Fixes for R 3.1.
# purrr 0.2.3
## Breaking changes
We noticed the following issues during reverse dependencies checks:
* If `reduce()` fails with this message: ``Error: `.x` is empty, and
no `.init` supplied``, this is because `reduce()` now returns
`.init` when `.x` is empty. Fix the problem by supplying an
appropriate argument to `.init`, or by providing special behaviour
when `.x` has length 0.
* The type predicates have been migrated to rlang. Consequently the
`bare-type-predicates` documentation topic is no longer in purrr,
which might cause a warning if you cross-reference it.
## Dependencies
purrr no longer depends on lazyeval or Rcpp (or dplyr, as of the
previous version). This makes the dependency graph of the tidyverse
simpler, and makes purrr more suitable as a dependency of lower-level
packages.
There have also been two changes to eliminate name conflicts between
purrr and dplyr:
* `order_by()`, `sort_by()` and `split_by()` have been removed. `order_by()`
conflicted with `dplyr::order_by()` and the complete family doesn't feel that
useful. Use tibbles instead (#217).
* `contains()` has been renamed to `has_element()` to avoid conflicts with
dplyr (#217).
## pluck()
The plucking mechanism used for indexing into data structures with
`map()` has been extracted into the function `pluck()`. Plucking is
often more readable to extract an element buried in a deep data
structure. Compare this syntax-heavy extraction which reads
non-linearly:
```
accessor(x[[1]])$foo
```
to the equivalent pluck:
```
x %>% pluck(1, accessor, "foo")
```
## Map helpers
* `as_function()` is now `as_mapper()` because it is a tranformation that
makes sense primarily for mapping functions, not in general (#298).
`.null` has been renamed to `.default` to better reflect its intent (#298).
`.default` is returned whenever an element is absent or empty (#231, #254).
`as_mapper()` sanitises primitive functions by transforming them to
closures with standardised argument names (using `rlang::as_closure()`).
For instance `+` is transformed to `function(.x, .y) .x + .y`. This
results in proper argument matching so that `map(1:10, partial(`-`,
.x = 5))` produces `list(5 - 1, 5 - 2, ...)`.
* Recursive indexing can now extract objects out of environments (#213) and
S4 objects (#200), as well as lists.
* `attr_getter()` makes it possible to extract from attributes
like `map(list(iris, mtcars), attr_getter("row.names"))`.
* The argument list for formula-functions has been tweaked so that you can
refer to arguments by position with `..1`, `..2`, and so on. This makes it
possible to use the formula shorthand for functions with more than two
arguments (#289).
* `possibly()`, `safely()` and friends no longer capture interrupts: this
means that you can now terminate a mapper using one of these with
Escape or Ctrl + C (#314)
## Map functions
* All map functions now treat `NULL` the same way as an empty vector (#199),
and return an empty vector if any input is an empty vector.
* All `map()` functions now force their arguments in the same way that base R
does for `lapply()` (#191). This makes `map()` etc easier to use when
generating functions.
* A new family of "indexed" map functions, `imap()`, `imap_lgl()` etc,
provide a short-hand for `map2(x, names(x))` or `map2(x, seq_along(x))`
(#240).
* The data frame suffix `_df` has been (soft) deprecated in favour of
`_dfr` to more clearly indicate that it's a row-bind. All variants now
also have a `_dfc` for column binding (#167). (These will not be terribly
useful until `dplyr::bind_rows()`/`dplyr::bind_cols()` have better
semantics for vectors.)
## Modify functions
A new `modify()` family returns the same output of the type as the
input `.x`. This is in contrast to the `map()` family which always
returns a list, regardless of the input type.
The modify functions are S3 generics. However their default methods
should be sufficient for most classes since they rely on the semantics
of `[<-`. `modify.default()` is thus a shorthand for `x[] <- map(x, f)`.
* `at_depth()` has been renamed to `modify_depth()`.
* `modify_depth()` gains new `.ragged` argument, and negative depths are
now computed relative to the deepest component of the list (#236).
## New functions
* `auto_browse(f)` returns a new function that automatically calls `browser()`
if `f` throws an error (#281).
* `vec_depth()` computes the depth (i.e. the number of levels of indexing)
or a vector (#243).
* `reduce2()` and `reduce2_right()` make it possible to reduce with a
3 argument function where the first argument is the accumulated value, the
second argument is `.x`, and the third argument is `.y` (#163).
* `list_modify()` extends `stats::modifyList()` to replace by position
if the list is not named.(#201). `list_merge()` operates similarly
to `list_modify()` but combines instead of replacing (#322).
* The legacy function `update_list()` is basically a version of
`list_modify` that evaluates formulas within the list. It is likely
to be deprecated in the future in favour of a tidyeval interface
such as a list method for `dplyr::mutate()`.
## Minor improvements and bug fixes
* Thanks to @dchiu911, the unit test coverage of purrr is now much greater.
* All predicate functions are re-exported from rlang (#124).
* `compact()` now works with standard mapper conventions (#282).
* `cross_n()` has been renamed to `cross()`. The `_n` suffix was
removed for consistency with `pmap()` (originally called `map_n()`
at the start of the project) and `transpose()` (originally called
`zip_n()`). Similarly, `cross_d()` has been renamed to `cross_df()`
for consistency with `map_df()`.
* `every()` and `some()` now return `NA` if present in the input (#174).
* `invoke()` uses a more robust approach to generate the argument list (#249)
It no longer uses lazyeval to figure out which enviroment a character `f`
comes from.
* `is_numeric()` and `is_scalar_numeric()` are deprecated because they
don't test for what you might expect at first sight.
* `reduce()` now throws an error if `.x` is empty and `.init` is not
supplied.
* Deprecated functions `flatmap()`, `map3()`, `map_n()`, `walk3()`,
`walk_n()`, `zip2()`, `zip3()`, `zip_n()` have been removed.
* `pmap()` coerces data frames to lists to avoid the expensive `[.data.frame`
which provides security that is unneeded here (#220).
* `rdunif()` checks its inputs for validity (#211).
* `set_names()` can now take a function to tranform the names programmatically
(#276), and you can supply names in `...` to reduce typing even more
more (#316). `set_names()` is now powered by `rlang::set_names()`.
* `safely()` now actually uses the `quiet` argument (#296).
* `transpose()` now matches by name if available (#164). You can
override the default choice with the new `.names` argument.
* The function argument of `detect()` and `detect_index()` have been
renamed from `.p` to `.f`. This is because they have mapper
semantics rather than predicate semantics.
# purrr 0.2.2.1
This is a compatibility release with dplyr 0.6.0.
* All data-frame based mappers have been removed in favour of new
functions and idioms in the tidyverse. `dmap()`, `dmap_at()`,
`dmap_if()`, `invoke_rows()`, `slice_rows()`, `map_rows()`,
`by_slice()`, `by_row()`, and `unslice()` have been moved to
purrrlyr. This is a bit of an aggresive change but it allows us to
make the dependencies much lighter.
# purrr 0.2.2
* Fix for dev tibble support.
* `as_function()` now supports list arguments which allow recursive indexing
using either names or positions. They now always stop when encountering
the first NULL (#173).
* `accumulate` and `reduce` correctly pass extra arguments to the
worker function.
# purrr 0.2.1
* `as_function()` gains a `.null` argument that for character and numeric
values allows you to specify what to return for null/absent elements (#110).
This can be used with any map function, e.g. `map_int(x, 1, .null = NA)`
* `as_function()` is now generic.
* New `is_function()` that returns `TRUE` only for regular functions.
* Fix crash on GCC triggered by `invoke_rows()`.
# purrr 0.2.0
## New functions
* There are two handy infix functions:
* `x %||% y` is shorthand for `if (is.null(x)) y else x` (#109).
* `x %@% "a"` is shorthand for `attr(x, "a", exact = TRUE)` (#69).
* `accumulate()` has been added to handle recursive folding. It is shortand
for `Reduce(f, .x, accumulate = TRUE)` and follows a similar syntax to
`reduce()` (#145). A right-hand version `accumulate_right()` was also added.
* `map_df()` row-binds output together. It's the equivalent of `plyr::ldply()`
(#127)
* `flatten()` is now type-stable and always returns a list. To return a simpler
vector, use `flatten_lgl()`, `flatten_int()`, `flatten_dbl()`,
`flatten_chr()`, or `flatten_df()`.
* `invoke()` has been overhauled to be more useful: it now works similarly
to `map_call()` when `.x` is NULL, and hence `map_call()` has been
deprecated. `invoke_map()` is a vectorised complement to `invoke()` (#125),
and comes with typed variants `invoke_map_lgl()`, `invoke_map_int()`,
`invoke_map_dbl()`, `invoke_map_chr()`, and `invoke_map_df()`.
* `transpose()` replaces `zip2()`, `zip3()`, and `zip_n()` (#128).
The name more clearly reflects the intent (transposing the first and second
levels of list). It no longer has fields argument or the `.simplify` argument;
instead use the new `simplify_all()` function.
* `safely()`, `quietly()`, and `possibly()` are experimental functions
for working with functions with side-effects (e.g. printed output,
messages, warnings, and errors) (#120). `safely()` is a version of `try()`
that modifies a function (rather than an expression), and always returns a
list with two components, `result` and `error`.
* `list_along()` and `rep_along()` generalise the idea of `seq_along()`.
(#122).
* `is_null()` is the snake-case version of `is.null()`.
* `pmap()` (parallel map) replaces `map_n()` (#132), and has typed-variants
suffixed `pmap_lgl()`, `pmap_int()`, `pmap_dbl()`, `pmap_chr()`, and
`pmap_df()`.
* `set_names()` is a snake-case alternative to `setNames()` with stricter
equality checking, and more convenient defaults for pipes:
`x %>% set_names()` is equivalent to `setNames(x, x)` (#119).
## Row based functionals
We are still figuring out what belongs in dplyr and what belongs in
purrr. Expect much experimentation and many changes with these
functions.
* `map()` now always returns a list. Data frame support has been moved
to `map_df()` and `dmap()`. The latter supports sliced data frames
as a shortcut for the combination of `by_slice()` and `dmap()`:
`x %>% by_slice(dmap, fun, .collate = "rows")`. The conditional
variants `dmap_at()` and `dmap_if()` also support sliced data frames
and will recycle scalar results to the slice size.
* `map_rows()` has been renamed to `invoke_rows()`. As other
rows-based functionals, it collates results inside lists by default,
but with column collation this function is equivalent to
`plyr::mdply()`.
* The rows-based functionals gain a `.to` option to name the output
column as well as a `.collate` argument. The latter allows to
collate the output in lists (by default), on columns or on
rows. This makes these functions more flexible and more predictable.
## Bug fixes and minor changes
* `as_function()`, which converts formulas etc to functions, is now
exported (#123).
* `rerun()` is correctly scoped (#95)
* `update_list()` can now modify an element called `x` (#98).
* `map*()` now use custom C code, rather than relying on `lapply()`, `mapply()`
etc. The performance characteristcs are very similar, but it allows us greater
control over the output (#118).
* `map_lgl()` now has second argument `.f`, not `.p` (#134).
## Deprecated functions
* `flatmap()` -> use `map()` followed by the appropriate `flatten()`.
* `map_call()` -> `invoke()`.
* `map_n()` -> `pmap()`; `walk_n()` -> `pwalk()`.
* `map3(x, y, z)` -> `map_n(list(x, y, z))`; `walk3(x, y, z) -> `pwalk(list(x, y, z))`
purrr/MD5 0000644 0001762 0000144 00000036111 14465116667 011756 0 ustar ligges users 0f2b2a4c8eb80c936f09362e58736865 *DESCRIPTION
b7d6ac1e742b5272f9f6400acefd18dc *LICENSE
a139025dc1f1fa2b950dc03fe8bfe851 *NAMESPACE
206b3e71bd7da6c730c4b55f4e44caeb *NEWS.md
3249873c59fae3bc2ca9f7806fea4121 *R/adverb-auto-browse.R
94899d1cf71a2eb3e69cd8bec078862c *R/adverb-compose.R
4d6998e2f3b91840d43382ba41c4e705 *R/adverb-insistently.R
41619c2a07d5e552ea79d26de6a8a149 *R/adverb-negate.R
3a4392fbd76436d18857f7a0b2cc3c7f *R/adverb-partial.R
4eef661ec6dd38d88d1af5d72480edfb *R/adverb-possibly.R
a6c11bf334099256b85cf1cc9f12a4a2 *R/adverb-quietly.R
35d3b19658ff5fd11255e655bf5debc6 *R/adverb-safely.R
a7adda4b54d8cd3253165fec950ae553 *R/adverb-slowly.R
b515804113cc549bc506e63313f1c591 *R/arrays.R
3b5b847b3ab116d84f02ce849d5d691f *R/cleancall.R
1a76007f51d0f33db555390854fd9c58 *R/coerce.R
07c06e6be0443b7d5b9094f11daa406f *R/compat-obj-type.R
e39d35d817dec590fcb8b9a2715ba226 *R/compat-types-check.R
68c740ac6ebe0e93bab36fe94319337a *R/conditions.R
a5048a175f84428c18db22a2610b049e *R/deprec-along.R
bebd5022f900db36dd2252fb392fe938 *R/deprec-cross.R
8c081c38566cccd7c32254bb0a198b44 *R/deprec-invoke.R
fdb46dfab1bb53ed011bf20c634345eb *R/deprec-lift.R
b153cfb2959c9f2839223c0b4f25c739 *R/deprec-map.R
abb45ff6ff22648d94e6dd1273134d9c *R/deprec-prepend.R
81a956f29aae4d6287fbc54baea52229 *R/deprec-rerun.R
be885a6fd18f2e2874a7ebc980e19fe8 *R/deprec-splice.R
6424704d1fcfa1dec9efe75fefc2564a *R/deprec-utils.R
1185eef9109a215c67a946cdc34f19c4 *R/deprec-when.R
e3dcfd3a940d152c235cff9b9b827171 *R/detect.R
fe8948a5f4759ff9d4b77d90707caf01 *R/every-some-none.R
3eecf3331e4ec26852fb241fff26a828 *R/faq.R
539dd095d2b848187fc77de3129a6026 *R/head-tail.R
b2a2024b7054479f857f25474db7cd86 *R/imap.R
46695aa5d54b94be4ee162b87bb38ea3 *R/keep.R
f6aac490b7193facad77a6b4518cf56c *R/list-combine.R
10054cb41855acfaf3024f21b121d307 *R/list-flatten.R
da7a4448164a9402b92877d295cc17d7 *R/list-modify.R
ddcf7fe04b839a80a6ec3910820db216 *R/list-simplify.R
94cce77d277e97e18ba706b07f997dda *R/list-transpose.R
f57adacf2a333ff7ee651d8c6efc7fe3 *R/lmap.R
0eaa22fbfdd38cf239a4ac3c0444e4ee *R/map-depth.R
4b73604808d1710435f77298897016ac *R/map-if-at.R
c68d89e44e83d88bfaa31dffdb3b374c *R/map-mapper.R
cbcc9760daae9e1cfaab78db81df5a4f *R/map-raw.R
37c69dd6c9bbc9c2a5d954e8d37cc1d7 *R/map.R
b0527de1582187fceb1f6bc4e7950334 *R/map2.R
fbb6fc008a86ca8cad381bc7a9fc1c88 *R/modify-tree.R
860a64ba9cf085d3c36a8e2172b66afa *R/modify.R
4de308ff9c82c52176fcfe9da12e8815 *R/package-purrr.R
018bca962220548d24305eb8af346e08 *R/pluck-assign.R
53863961d60b5113afbe91dfcff27d43 *R/pluck-depth.R
228d69137004673f372c9e05fc89d8ef *R/pluck.R
2349f57c533f9241d9f7fc021583286a *R/pmap.R
cebed07dc5d89552bd123cd937ed135e *R/progress-bars.R
d0a581d2b30b7f8b2497d55aac79ad16 *R/rate.R
8a7cc3b5485d19efaa36a43902c5c9a8 *R/reduce.R
205cf2833a0f66a11be385289abd06cb *R/reexport-pipe.R
ffe64893c11ede22a4ce0e82a810850a *R/reexport-rlang.R
676324d0f2547e366101d30e48110bae *R/superseded-flatten.R
730805317f6fd5daf475deb0b07c70af *R/superseded-map-df.R
40af9fa24dff3e4541b6a1a0c676f147 *R/superseded-simplify.R
a9f61ea8d4423d49f7fdb0e641d3dba8 *R/superseded-transpose.R
6a69bb1c9bf00b58acd458acd6b8e618 *R/utils.R
72d553ef6788197eb679ddd9158d3a58 *README.md
90b57b3c3dc65d6d037323e58edc03de *build/vignette.rds
de3fc7fc6d5f0ec1ddf799c84d04a63e *cleanup
b547518249e0da4528616c8ed2382036 *configure
757ef8281ef2a1ebcbcc8235aeee2d0e *configure.win
3325b9991fb6048cf1852fe16792b516 *inst/doc/base.R
6c3228cf25b6740bdfa1832ead401fb3 *inst/doc/base.Rmd
9ba47242179f902545ace84d11e240e8 *inst/doc/base.html
59ccb5562cdcbbaebc1e7e9d6b2e5e1b *inst/doc/other-langs.Rmd
a851cc92e0f31b3a3ef2bdd1d41b1c40 *inst/doc/other-langs.html
f00176301d14489073e2413531fe4474 *man/accumulate.Rd
a6e5ef70ca9479a693a2eca55172b2d8 *man/along.Rd
436c1d64da16fe444906f743c3a74f3c *man/array-coercion.Rd
7f135b01fdd79854f0c607744307b684 *man/as_mapper.Rd
9a7ae57daeeef10f5dcb19372db63e10 *man/as_vector.Rd
7686e98774087414b7c7c5c0b5eaa4fe *man/at_depth.Rd
147341fcbc75baa0a9c8ba7478fe8a16 *man/attr_getter.Rd
13e902f9d059a8fdec93b9e27e4a1672 *man/auto_browse.Rd
1c791828a7f69a5fe52840f160b7d9f8 *man/chuck.Rd
88c29db4415b8e139e7779ada0e723a7 *man/compose.Rd
8ca9be5cb432a4431653255f7a025ae0 *man/cross.Rd
27057d78b1efd6cea7b7cdbfee09079f *man/detect.Rd
f596efdf72832a0766bfa04772960fda *man/every.Rd
6fb35089007e4d9d2c5588fe7380d180 *man/faq-adverbs-export.Rd
cb1e46f469cfbbbde29c8b5113e1d789 *man/figures/lifecycle-archived.svg
c0d2e5a54f1fa4ff02bf9533079dd1f7 *man/figures/lifecycle-defunct.svg
a1b8c987c676c16af790f563f96cbb1f *man/figures/lifecycle-deprecated.svg
c3978703d8f40f2679795335715e98f4 *man/figures/lifecycle-experimental.svg
952b59dc07b171b97d5d982924244f61 *man/figures/lifecycle-maturing.svg
27b879bf3677ea76e3991d56ab324081 *man/figures/lifecycle-questioning.svg
6902bbfaf963fbc4ed98b86bda80caa2 *man/figures/lifecycle-soft-deprecated.svg
53b3f893324260b737b3c46ed2a0e643 *man/figures/lifecycle-stable.svg
1c1fe7a759b86dc6dbcbe7797ab8246c *man/figures/lifecycle-superseded.svg
1d60cfe447b30937913953382e194602 *man/figures/logo.png
efba13d3891d9627d2ad9aa3006aaf88 *man/flatten.Rd
a72d3ade9c4f6c5a5a95efab1b4ea184 *man/get-attr.Rd
01da9802fe500f7257ccc2dfbeec9d67 *man/has_element.Rd
af76e793cdbc6a32fc65bbf80304baae *man/head_while.Rd
1f750f64b083e8fc87462264cc000214 *man/imap.Rd
17fdc32ccac7049062c075b630c8d596 *man/insistently.Rd
d9eb7a573a99415abbdfa520c1a91971 *man/invoke.Rd
0c44eaa846ea16477f3a11562e599cc4 *man/keep.Rd
570b9ca1f798e97e81b329b2bced4a2e *man/keep_at.Rd
adcb4274f0012e9d4c7f82be8b9681c5 *man/lift.Rd
ff9a748beab090c3750900f975e56fc8 *man/list_assign.Rd
aac52b8d6bee72b4186e55f4a6b9a2d7 *man/list_c.Rd
444f5d98fcd9154b9ba932ca4c1939b2 *man/list_flatten.Rd
3b9ec5d0bd5a5325e8b1096826eedb9e *man/list_simplify.Rd
a584a7c59a3a74a12c74b3fdf0172ac4 *man/list_transpose.Rd
ab0032d166646c1d2a3c253401ff1ea0 *man/lmap.Rd
3397e372c51330e43278f03080a90388 *man/map.Rd
1504ce4c5bee419106d1ccd2bf522a46 *man/map2.Rd
9c1343794aeb659c5f9cc4440d9f38ba *man/map_depth.Rd
d574fc999aa84addadddf19ae24c8a77 *man/map_dfr.Rd
e7ee4c94a79eea04ed06b4f7f6492b38 *man/map_if.Rd
55d433f03e63d447f6b96a8a0690c306 *man/map_raw.Rd
15be93db9caa7d3fb683b78ee6e54132 *man/modify.Rd
ed73b7f7b31f237f9abdd787ea811ffe *man/modify_in.Rd
d16cb875e67e50b427d0021230b8041a *man/modify_tree.Rd
38bfc1f86603031fe79a622e2e163ae7 *man/negate.Rd
eec1ef2539f957a0ad9a6e62bb7664a0 *man/partial.Rd
20ddcacb06bef90d0ef483349d9eb688 *man/pipe.Rd
1f49acbbeb6250553b9ee5894737435e *man/pluck.Rd
54881a56d1fe77e6520646d4c27a16d9 *man/pluck_depth.Rd
289e9e2bf6a651a9f6507799b6dfdf35 *man/pmap.Rd
07aa8c62773bfbef177aeaf338aa9721 *man/possibly.Rd
6626ac358a303017849dd6845fa1532b *man/prepend.Rd
6d8c85b65615b7823dbdb4cacbf54f1c *man/progress_bars.Rd
6475830ad22092b57004d14771a4d377 *man/purrr-package.Rd
a9e8ba8302fe11e6a4c1ed293ade3765 *man/purrr_error_indexed.Rd
f9e4c3f8e45d8fdac401dfb2fc36a9dc *man/quietly.Rd
f282657e9c3e032d1dfce7e1795fe2fe *man/rate-helpers.Rd
728813ebb9c2c67d82794d6056f14316 *man/rate_sleep.Rd
f1c14c2625eb3c41dffaffbd38b7bfed *man/rbernoulli.Rd
0b3a16966d9fe29d0bd3b03a53a39145 *man/rdunif.Rd
9315858c1ec0e95720b349ca189ef2b5 *man/reduce.Rd
399a2a0bc92bf968c7d4705bce968e38 *man/reduce_right.Rd
442d055f9895caea4dc8df0506344f5f *man/reexports.Rd
11ffe0cd8f9dc16f8aa30a594ff39076 *man/rerun.Rd
c7cc36ddf062f8e4ff29c23ee4257bce *man/rmd/indexed-error.Rmd
8ceab1fe8dd015bde4877bcb4294cf9f *man/safely.Rd
635cfa0ffe9b9f9f23217737f25f6c47 *man/slowly.Rd
122d3e9e04863b26f0171d283cd7408e *man/splice.Rd
6910ef35fbc2860fa14609332a0d7d76 *man/transpose.Rd
f7f186a8c48e8ad4a42c3c66f20e678b *man/update_list.Rd
19ac0a38e950c17e4dc003e15767a90a *man/when.Rd
d25d5af44b59cd40d3830b54f7a7cf7f *src/Makevars
ff2850c9a8f09363bbcb7439f1a55e70 *src/backports.c
3a1ddd472e6b17c3679467cbd3409b10 *src/backports.h
82b5161fea28cdd8f50f6b94451ab72d *src/cleancall.c
07a0b2f422fb87c0d5e789157fac4b31 *src/cleancall.h
d5e3c8f5353d45d7efcea2f90b3e45ae *src/coerce.c
9d0421297cfdab0c06f7ec2e36759e34 *src/coerce.h
a675c96d3f728bb337345796be698f9c *src/conditions.c
7b9fc51f5a512ce14bf25ccfe00650af *src/conditions.h
cfb390458d214a983383df824878698d *src/flatten.c
cae717080e63cdacc48ace8821ea66ca *src/init.c
ec16972171f8a9f0f951bed117895090 *src/map.c
1774cecb4cb23c3c852fd88aed7c2dbb *src/map.h
920d8254f731897ae6367b790dc32085 *src/pluck.c
8c9586189bdd80b8853ea0f8738f40c2 *src/transpose.c
44668af668839200908745f6c7e0906b *src/utils.c
371dea46f35f35a19afee808aae842d4 *src/utils.h
8e9d16c5c6aedcc157783b13df5b9db0 *tests/testthat.R
4ba4a6038e95827dcd78d38d8c558e0d *tests/testthat/_snaps/adverb-auto-browse.md
b40a11b179154d841671b8ec7c3eff74 *tests/testthat/_snaps/adverb-compose.md
8c57450be765a49add6ea74ebad5913b *tests/testthat/_snaps/adverb-insistently.md
3afce5e151cc42df01e35034701180e8 *tests/testthat/_snaps/adverb-partial.md
ce54aff1634c67cb621b9e3ff249c0df *tests/testthat/_snaps/adverb-slowly.md
a1d1067bded31124fdd9536228fe8b8d *tests/testthat/_snaps/arrays.md
98d696189b49428b28c28549ebd849b5 *tests/testthat/_snaps/coerce.md
ed845c01f73ef3fe75711cdefac84307 *tests/testthat/_snaps/conditions.md
cff43fa75b4ff8b03494b52d80b0ccaa *tests/testthat/_snaps/deprec-along.md
848948dacb08048dfacc93c211a31422 *tests/testthat/_snaps/deprec-cross.md
a4ec0ff99d776c2c939a01619536b861 *tests/testthat/_snaps/deprec-invoke.md
3882353452b0fe1c2a6378697501d4fc *tests/testthat/_snaps/deprec-lift.md
2cac7bc20b587b8f7fa6f1557fe83453 *tests/testthat/_snaps/deprec-map.md
071c53ee8473cc16bbfa0341fd728e3e *tests/testthat/_snaps/deprec-prepend.md
c4c0cc263578a7a9765002e6a251c6a6 *tests/testthat/_snaps/deprec-rerun.md
ff3c35718998d19eb67fbbb22c76b9a8 *tests/testthat/_snaps/deprec-splice.md
694549a59766159bd3d80e80a86e7af5 *tests/testthat/_snaps/deprec-utils.md
0ee0571cb46a94081748ac0dfeac6f59 *tests/testthat/_snaps/deprec-when.md
d6d3e3e6b2d88433e3cb1ca6bbc423fb *tests/testthat/_snaps/detect.md
ec1184c2b5af139e2fc0555e92ad1194 *tests/testthat/_snaps/head-tail.md
f4fcce4fabd63522a679254907c8e7c2 *tests/testthat/_snaps/keep.md
9d1773507504fc19e7acc742d9e23b3b *tests/testthat/_snaps/list-combine.md
0f05a420a951753a597368d8d6c2daad *tests/testthat/_snaps/list-flatten.md
38cd7aee18cd6206cabd9a7cc66ad33e *tests/testthat/_snaps/list-modify.md
efd90fc67102416cba554bfd56bfaba8 *tests/testthat/_snaps/list-simplify.md
cdbac9c723eaec07d1915e92970ce824 *tests/testthat/_snaps/list-transpose.md
7015ad0737bb266bcc438378a33a4c0e *tests/testthat/_snaps/lmap.md
d4d98c17c4cf485959457e9b78912a33 *tests/testthat/_snaps/map-depth.md
77bc7274ed3168ea411945fbf3f3640f *tests/testthat/_snaps/map-if-at.md
2471d23e2ee8145617818c8ca0d3d3fd *tests/testthat/_snaps/map-raw.md
0439e5f01d1889fd89c6bb4a921632ea *tests/testthat/_snaps/map.md
fda4e0afc6676b8b110625ee78841ec2 *tests/testthat/_snaps/map2.md
9762cd6f920cbf29ae9308da740b5650 *tests/testthat/_snaps/modify-tree.md
f7def725d82b3959eb1860e42be0ca9d *tests/testthat/_snaps/modify.md
48cb68a5e24f2afab3092fcbde903d19 *tests/testthat/_snaps/pluck-assign.md
9d4fca1a111f1c86c9e794291a5fe4b7 *tests/testthat/_snaps/pluck-depth.md
fe55cc7e3cde235f492ca1072501b017 *tests/testthat/_snaps/pluck.md
036608e24d9320b120e23e8f87ca26e8 *tests/testthat/_snaps/pmap.md
b3b7d358c885f430aa5ec3db9d5817aa *tests/testthat/_snaps/rate.md
ad567ed3c3dcc13249ae3c0c8fadb6ba *tests/testthat/_snaps/reduce.md
589c1c71919f7adf8f4d503451c1a827 *tests/testthat/_snaps/superseded-flatten.md
b4656054afc8ab8c4cc8c8861fa4588d *tests/testthat/_snaps/superseded-transpose.md
32419c6c30a189e3279a671278acca01 *tests/testthat/_snaps/utils.md
9910f862c678e5cab0747535444ef2b6 *tests/testthat/helper-map.R
95ca8e1eff88f95013ff5de9710514bb *tests/testthat/helper.R
0cddd9f63f32e83702987889ecf4eda7 *tests/testthat/setup.R
b06a4aaac525eb4b7d4de164a2f0d7fd *tests/testthat/test-adverb-auto-browse.R
6d510ede9ae3f7d8b1fe61f4e62d34a4 *tests/testthat/test-adverb-compose.R
88f4841de74fa10ac1e540977c06c95c *tests/testthat/test-adverb-insistently.R
768f4925032ee87d54669591116d53c7 *tests/testthat/test-adverb-negate.R
b246fbe73646e25466697f748cf275bc *tests/testthat/test-adverb-partial.R
92fd9d67feffd0a781da879e1db457e9 *tests/testthat/test-adverb-possibly.R
218031b000d5669ed53b6e936c9b9495 *tests/testthat/test-adverb-quietly.R
dbceaffff5cf1f48398730d85a9279c8 *tests/testthat/test-adverb-safely.R
10a18d7711e07edcb223e068afe8baa7 *tests/testthat/test-adverb-slowly.R
fb57d26764a86888edaac33f82ca0cf7 *tests/testthat/test-arrays.R
91c1814bd2bfd1858423502883af5854 *tests/testthat/test-coerce.R
b332abdff90649614cea91c19fd33159 *tests/testthat/test-conditions.R
539c737bbbd41452d6cb09ff478e406d *tests/testthat/test-deprec-along.R
635cb361e9030c11b43f1a23c7febf24 *tests/testthat/test-deprec-cross.R
3425f2a2e22c4d7316334ac0a817e3bf *tests/testthat/test-deprec-invoke.R
fcf8e96e697811d8d40fcb92e6b847a6 *tests/testthat/test-deprec-lift.R
92d8d985ce044e86c6de30a602db38de *tests/testthat/test-deprec-map.R
7b4d24f69a90c0aed779e5faeb878893 *tests/testthat/test-deprec-prepend.R
bfe5b7e7c07575735bd6993d279687b1 *tests/testthat/test-deprec-rerun.R
1f06b9ae6a939fa5a68f4bec188a6b30 *tests/testthat/test-deprec-splice.R
39946e9147f6eb989a8ed6bc42739238 *tests/testthat/test-deprec-utils.R
07320c2e0d55060b532605b3a9de2712 *tests/testthat/test-deprec-when.R
416384b1c4a23da96afb827c5eb503e8 *tests/testthat/test-detect.R
ac810db4dc3d92959abd6abcf5231324 *tests/testthat/test-every-some-none.R
3ebe28179207a5b2f635ef3680329263 *tests/testthat/test-head-tail.R
29901fdb0617ddf0c08a4f43acb6f040 *tests/testthat/test-imap.R
4b9378850ffb9835ab982f405c3d6dac *tests/testthat/test-keep.R
7cd0f7471462e68ced09bcc510f7588e *tests/testthat/test-list-combine.R
98e2162a2cc58be3b03511a22fbed7bc *tests/testthat/test-list-flatten.R
7f2366b6f394133a8b65dc56f0a26561 *tests/testthat/test-list-modify.R
92d7a3666ea4c3351814ccbe59d1612d *tests/testthat/test-list-simplify.R
70014bd3110630916b91276219c31c9a *tests/testthat/test-list-transpose.R
bdfe6eeeecdf53edb8f8aeea8dce3156 *tests/testthat/test-lmap.R
ca2cc589759f07ff193224cbea42e964 *tests/testthat/test-map-depth.R
bc02617edebcf9bc84723e742eb30f13 *tests/testthat/test-map-if-at.R
d6be6e31bece94743e5ae6f431dd4bca *tests/testthat/test-map-mapper.R
6d4011bc6e067fb62fe52be6a66abed5 *tests/testthat/test-map-raw.R
c207894636a56090a0b7b9995958006e *tests/testthat/test-map.R
11489c9b6e2cb70fb6a7ab69c083a72e *tests/testthat/test-map2.R
c1a8c3b4d1d4635e8d1d7f254798eb3b *tests/testthat/test-modify-tree.R
141a52745d0091eddd5e1cfa044bac9c *tests/testthat/test-modify.R
7c8b7a4e92c71fa04859505d48ab9702 *tests/testthat/test-pluck-assign.R
577a43785506b3269e467a98fa5c6e28 *tests/testthat/test-pluck-depth.R
10d9e5ac148dbe1664a974914542f4a4 *tests/testthat/test-pluck.R
3e80ebe3461cd334a12f6a560ad887a8 *tests/testthat/test-pmap.R
5ad3d8a874c025a5adb48ca121d29499 *tests/testthat/test-rate.R
c54b6293b539da98195940e81e93b264 *tests/testthat/test-reduce.R
50fbffb1584f3312fc9447ea7ccc9572 *tests/testthat/test-superseded-flatten.R
baf549b0004c7aeb37b107831e569856 *tests/testthat/test-superseded-map-df.R
566197e01cb28db2387ea55d25dab167 *tests/testthat/test-superseded-simplify.R
02934c52ef493d25f5ede2a2ffef87a8 *tests/testthat/test-superseded-transpose.R
5236bbb7e82f290daa334bd9dd4c8617 *tests/testthat/test-utils.R
04b0a09ebe1847f15c2b36527ba834ca *tools/examples.R
6c3228cf25b6740bdfa1832ead401fb3 *vignettes/base.Rmd
59ccb5562cdcbbaebc1e7e9d6b2e5e1b *vignettes/other-langs.Rmd
purrr/inst/ 0000755 0001762 0000144 00000000000 14464464653 012421 5 ustar ligges users purrr/inst/doc/ 0000755 0001762 0000144 00000000000 14464464653 013166 5 ustar ligges users purrr/inst/doc/base.Rmd 0000644 0001762 0000144 00000035261 14325501250 014530 0 ustar ligges users ---
title: "purrr <-> base R"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{purrr <-> base R}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width = 7,
fig.height = 4.5,
fig.align = "center"
)
options(tibble.print_min = 6, tibble.print_max = 6)
modern_r <- getRversion() >= "4.1.0"
```
# Introduction
This vignette compares purrr's functionals to their base R equivalents, focusing primarily on the map family and related functions.
This helps those familiar with base R understand better what purrr does, and shows purrr users how you might express the same ideas in base R code.
We'll start with a rough overview of the major differences, give a rough translation guide, and then show a few examples.
```{r setup}
library(purrr)
library(tibble)
```
## Key differences
There are two primary differences between the base apply family and the purrr map family: purrr functions are named more consistently, and more fully explore the space of input and output variants.
- purrr functions consistently use `.` as prefix to avoid [inadvertently matching arguments](https://adv-r.hadley.nz/functionals.html#argument-names) of the purrr function, instead of the function that you're trying to call.
Base functions use a variety of techniques including upper case (e.g. `lapply(X, FUN, ...)`) or require anonymous functions (e.g. `Map()`).
- All map functions are type stable: you can predict the type of the output using little information about the inputs.
In contrast, the base functions `sapply()` and `mapply()` automatically simplify making the return value hard to predict.
- The map functions all start with the data, followed by the function, then any additional constant argument.
Most base apply functions also follow this pattern, but `mapply()` starts with the function, and `Map()` has no way to supply additional constant arguments.
- purrr functions provide all combinations of input and output variants, and include variants specifically for the common two argument case.
## Direct translations
The following sections give a high-level translation between base R commands and their purrr equivalents.
See function documentation for the details.
### `Map` functions
Here `x` denotes a vector and `f` denotes a function
| Output | Input | Base R | purrr |
|------------------|------------------|------------------|-------------------|
| List | 1 vector | `lapply()` | `map()` |
| List | 2 vectors | `mapply()`, `Map()` | `map2()` |
| List | \>2 vectors | `mapply()`, `Map()` | `pmap()` |
| Atomic vector of desired type | 1 vector | `vapply()` | `map_lgl()` (logical), `map_int()` (integer), `map_dbl()` (double), `map_chr()` (character), `map_raw()` (raw) |
| Atomic vector of desired type | 2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `map2_lgl()` (logical), `map2_int()` (integer), `map2_dbl()` (double), `map2_chr()` (character), `map2_raw()` (raw) |
| Atomic vector of desired type | \>2 vectors | `mapply()`, `Map()`, then `is.*()` to check type | `pmap_lgl()` (logical), `pmap_int()` (integer), `pmap_dbl()` (double), `pmap_chr()` (character), `pmap_raw()` (raw) |
| Side effect only | 1 vector | loops | `walk()` |
| Side effect only | 2 vectors | loops | `walk2()` |
| Side effect only | \>2 vectors | loops | `pwalk()` |
| Data frame (`rbind` outputs) | 1 vector | `lapply()` then `rbind()` | `map_dfr()` |
| Data frame (`rbind` outputs) | 2 vectors | `mapply()`/`Map()` then `rbind()` | `map2_dfr()` |
| Data frame (`rbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `rbind()` | `pmap_dfr()` |
| Data frame (`cbind` outputs) | 1 vector | `lapply()` then `cbind()` | `map_dfc()` |
| Data frame (`cbind` outputs) | 2 vectors | `mapply()`/`Map()` then `cbind()` | `map2_dfc()` |
| Data frame (`cbind` outputs) | \>2 vectors | `mapply()`/`Map()` then `cbind()` | `pmap_dfc()` |
| Any | Vector and its names | `l/s/vapply(X, function(x) f(x, names(x)))` or `mapply/Map(f, x, names(x))` | `imap()`, `imap_*()` (`lgl`, `dbl`, `dfr`, and etc. just like for `map()`, `map2()`, and `pmap()`) |
| Any | Selected elements of the vector | `l/s/vapply(X[index], FUN, ...)` | `map_if()`, `map_at()` |
| List | Recursively apply to list within list | `rapply()` | `map_depth()` |
| List | List only | `lapply()` | `lmap()`, `lmap_at()`, `lmap_if()` |
### Extractor shorthands
Since a common use case for map functions is list extracting components, purrr provides a handful of shortcut functions for various uses of `[[`.
| Input | base R | purrr |
|-------------------|--------------------------|---------------------------|
| Extract by name | `` lapply(x, `[[`, "a") `` | `map(x, "a")` |
| Extract by position | `` lapply(x, `[[`, 3) `` | `map(x, 3)` |
| Extract deeply | `lapply(x, \(y) y[[1]][["x"]][[3]])` | `map(x, list(1, "x", 3))` |
| Extract with default value | `lapply(x, function(y) tryCatch(y[[3]], error = function(e) NA))` | `map(x, 3, .default = NA)` |
### Predicates
Here `p`, a predicate, denotes a function that returns `TRUE` or `FALSE` indicating whether an object fulfills a criterion, e.g. `is.character()`.
| Description | base R | purrr |
|-----------------------------|--------------------|-----------------------|
| Find a matching element | `Find(p, x)` | `detect(x, p)`, |
| Find position of matching element | `Position(p, x)` | `detect_index(x, p)` |
| Do all elements of a vector satisfy a predicate? | `all(sapply(x, p))` | `every(x, p)` |
| Does any elements of a vector satisfy a predicate? | `any(sapply(x, p))` | `some(x, p)` |
| Does a list contain an object? | `any(sapply(x, identical, obj))` | `has_element(x, obj)` |
| Keep elements that satisfy a predicate | `x[sapply(x, p)]` | `keep(x, p)` |
| Discard elements that satisfy a predicate | `x[!sapply(x, p)]` | `discard(x, p)` |
| Negate a predicate function | `function(x) !p(x)` | `negate(p)` |
### Other vector transforms
| Description | base R | purrr |
|-----------------------------|--------------------|-----------------------|
| Accumulate intermediate results of a vector reduction | `Reduce(f, x, accumulate = TRUE)` | `accumulate(x, f)` |
| Recursively combine two lists | `c(X, Y)`, but more complicated to merge recursively | `list_merge()`, `list_modify()` |
| Reduce a list to a single value by iteratively applying a binary function | `Reduce(f, x)` | `reduce(x, f)` |
## Examples
### Varying inputs
#### One input
Suppose we would like to generate a list of samples of 5 from normal distributions with different means:
```{r}
means <- 1:4
```
There's little difference when generating the samples:
- Base R uses `lapply()`:
```{r}
set.seed(2020)
samples <- lapply(means, rnorm, n = 5, sd = 1)
str(samples)
```
- purrr uses `map()`:
```{r}
set.seed(2020)
samples <- map(means, rnorm, n = 5, sd = 1)
str(samples)
```
#### Two inputs
Lets make the example a little more complicated by also varying the standard deviations:
```{r}
means <- 1:4
sds <- 1:4
```
- This is relatively tricky in base R because we have to adjust a number of `mapply()`'s defaults.
```{r}
set.seed(2020)
samples <- mapply(
rnorm,
mean = means,
sd = sds,
MoreArgs = list(n = 5),
SIMPLIFY = FALSE
)
str(samples)
```
Alternatively, we could use `Map()` which doesn't simply, but also doesn't take any constant arguments, so we need to use an anonymous function:
```{r}
samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds)
```
In R 4.1 and up, you could use the shorter anonymous function form:
```{r, eval = modern_r}
samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds)
```
- Working with a pair of vectors is a common situation so purrr provides the `map2()` family of functions:
```{r}
set.seed(2020)
samples <- map2(means, sds, rnorm, n = 5)
str(samples)
```
#### Any number of inputs
We can make the challenge still more complex by also varying the number of samples:
```{r}
ns <- 4:1
```
- Using base R's `Map()` becomes more straightforward because there are no constant arguments.
```{r}
set.seed(2020)
samples <- Map(rnorm, mean = means, sd = sds, n = ns)
str(samples)
```
- In purrr, we need to switch from `map2()` to `pmap()` which takes a list of any number of arguments.
```{r}
set.seed(2020)
samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm)
str(samples)
```
### Outputs
Given the samples, imagine we want to compute their means.
A mean is a single number, so we want the output to be a numeric vector rather than a list.
- There are two options in base R: `vapply()` or `sapply()`.
`vapply()` requires you to specific the output type (so is relatively verbose), but will always return a numeric vector.
`sapply()` is concise, but if you supply an empty list you'll get a list instead of a numeric vector.
```{r}
# type stable
medians <- vapply(samples, median, FUN.VALUE = numeric(1L))
medians
# not type stable
medians <- sapply(samples, median)
```
- purrr is little more compact because we can use `map_dbl()`.
```{r}
medians <- map_dbl(samples, median)
medians
```
What if we want just the side effect, such as a plot or a file output, but not the returned values?
- In base R we can either use a for loop or hide the results of `lapply`.
```{r, fig.show='hide'}
# for loop
for (s in samples) {
hist(s, xlab = "value", main = "")
}
# lapply
invisible(lapply(samples, function(s) {
hist(s, xlab = "value", main = "")
}))
```
- In purrr, we can use `walk()`.
```{r, fig.show='hide'}
walk(samples, ~ hist(.x, xlab = "value", main = ""))
```
### Pipes
You can join multiple steps together either using the magrittr pipe:
```{r}
set.seed(2020)
means %>%
map(rnorm, n = 5, sd = 1) %>%
map_dbl(median)
```
Or the base pipe R:
```{r, eval = modern_r}
set.seed(2020)
means |>
lapply(rnorm, n = 5, sd = 1) |>
sapply(median)
```
(And of course you can mix and match the piping style with either base R or purrr.)
The pipe is particularly compelling when working with longer transformations.
For example, the following code splits `mtcars` up by `cyl`, fits a linear model, extracts the coefficients, and extracts the first one (the intercept).
```{r, eval = modern_r}
mtcars %>%
split(mtcars$cyl) %>%
map(\(df) lm(mpg ~ wt, data = df)) %>%
map(coef) %>%
map_dbl(1)
```
purrr/inst/doc/base.R 0000644 0001762 0000144 00000006256 14464464652 014233 0 ustar ligges users ## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.width = 7,
fig.height = 4.5,
fig.align = "center"
)
options(tibble.print_min = 6, tibble.print_max = 6)
modern_r <- getRversion() >= "4.1.0"
## ----setup--------------------------------------------------------------------
library(purrr)
library(tibble)
## -----------------------------------------------------------------------------
means <- 1:4
## -----------------------------------------------------------------------------
set.seed(2020)
samples <- lapply(means, rnorm, n = 5, sd = 1)
str(samples)
## -----------------------------------------------------------------------------
set.seed(2020)
samples <- map(means, rnorm, n = 5, sd = 1)
str(samples)
## -----------------------------------------------------------------------------
means <- 1:4
sds <- 1:4
## -----------------------------------------------------------------------------
set.seed(2020)
samples <- mapply(
rnorm,
mean = means,
sd = sds,
MoreArgs = list(n = 5),
SIMPLIFY = FALSE
)
str(samples)
## -----------------------------------------------------------------------------
samples <- Map(function(...) rnorm(..., n = 5), mean = means, sd = sds)
## ---- eval = modern_r---------------------------------------------------------
samples <- Map(\(...) rnorm(..., n = 5), mean = means, sd = sds)
## -----------------------------------------------------------------------------
set.seed(2020)
samples <- map2(means, sds, rnorm, n = 5)
str(samples)
## -----------------------------------------------------------------------------
ns <- 4:1
## -----------------------------------------------------------------------------
set.seed(2020)
samples <- Map(rnorm, mean = means, sd = sds, n = ns)
str(samples)
## -----------------------------------------------------------------------------
set.seed(2020)
samples <- pmap(list(mean = means, sd = sds, n = ns), rnorm)
str(samples)
## -----------------------------------------------------------------------------
# type stable
medians <- vapply(samples, median, FUN.VALUE = numeric(1L))
medians
# not type stable
medians <- sapply(samples, median)
## -----------------------------------------------------------------------------
medians <- map_dbl(samples, median)
medians
## ---- fig.show='hide'---------------------------------------------------------
# for loop
for (s in samples) {
hist(s, xlab = "value", main = "")
}
# lapply
invisible(lapply(samples, function(s) {
hist(s, xlab = "value", main = "")
}))
## ---- fig.show='hide'---------------------------------------------------------
walk(samples, ~ hist(.x, xlab = "value", main = ""))
## -----------------------------------------------------------------------------
set.seed(2020)
means %>%
map(rnorm, n = 5, sd = 1) %>%
map_dbl(median)
## ---- eval = modern_r---------------------------------------------------------
set.seed(2020)
means |>
lapply(rnorm, n = 5, sd = 1) |>
sapply(median)
## ---- eval = modern_r---------------------------------------------------------
mtcars %>%
split(mtcars$cyl) %>%
map(\(df) lm(mpg ~ wt, data = df)) %>%
map(coef) %>%
map_dbl(1)
purrr/inst/doc/other-langs.Rmd 0000644 0001762 0000144 00000003623 14310436312 016036 0 ustar ligges users ---
title: "Functional programming in other languages"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Functional programming in other languages}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
purrr draws inspiration from many related tools:
* List operations defined in the Haskell [prelude][haskell]
* Scala's [list methods][scala].
* Functional programming libraries for javascript:
[underscore.js](http://underscorejs.org),
[lodash](https://lodash.com) and
[lazy.js](http://danieltao.com/lazy.js/).
* [rlist](https://renkun-ken.github.io/rlist/), another R package to support working
with lists. Similar goals but somewhat different philosophy.
However, the goal of purrr is not to try and simulate a purer functional programming language in R; we don't want to implement a second-class version of Haskell in R. The goal is to give you similar expressiveness to an FP language, while allowing you to write code that looks and works like R:
* Instead of point free (tacit) style, we use the pipe, `%>%`, to write code
that can be read from left to right.
* Instead of currying, we use `...` to pass in extra arguments.
* Before R 4.1, anonymous functions were verbose, so we provide two convenient shorthands.
For unary functions, `~ .x + 1` is equivalent to `function(.x) .x + 1`.
* R is weakly typed, so we need `map` variants that describe the output type
(like `map_int()`, `map_dbl()`, etc) because we don't know the return type of `.f`.
* R has named arguments, so instead of providing different functions for
minor variations (e.g. `detect()` and `detectLast()`) we use a named
argument, `.right`. Type-stable functions are easy to reason about so
additional arguments will never change the type of the output.
[scala]:https://www.scala-lang.org/api/current/index.html
[haskell]:http://hackage.haskell.org/package/base-4.7.0.1/docs/Prelude.html#g:11
purrr/inst/doc/base.html 0000644 0001762 0000144 00000110106 14464464653 014765 0 ustar ligges users
purrr <-> base R
purrr <-> base R
Introduction
This vignette compares purrr’s functionals to their base R
equivalents, focusing primarily on the map family and related functions.
This helps those familiar with base R understand better what purrr does,
and shows purrr users how you might express the same ideas in base R
code. We’ll start with a rough overview of the major differences, give a
rough translation guide, and then show a few examples.
library(purrr)library(tibble)
Key differences
There are two primary differences between the base apply family and
the purrr map family: purrr functions are named more consistently, and
more fully explore the space of input and output variants.
purrr functions consistently use . as prefix to
avoid inadvertently
matching arguments of the purrr function, instead of the function
that you’re trying to call. Base functions use a variety of techniques
including upper case (e.g. lapply(X, FUN, ...)) or require
anonymous functions (e.g. Map()).
All map functions are type stable: you can predict the type of
the output using little information about the inputs. In contrast, the
base functions sapply() and mapply()
automatically simplify making the return value hard to predict.
The map functions all start with the data, followed by the
function, then any additional constant argument. Most base apply
functions also follow this pattern, but mapply() starts
with the function, and Map() has no way to supply
additional constant arguments.
purrr functions provide all combinations of input and output
variants, and include variants specifically for the common two argument
case.
Direct translations
The following sections give a high-level translation between base R
commands and their purrr equivalents. See function documentation for the
details.
Here p, a predicate, denotes a function that returns
TRUE or FALSE indicating whether an object
fulfills a criterion, e.g. is.character().
Description
base R
purrr
Find a matching element
Find(p, x)
detect(x, p),
Find position of matching element
Position(p, x)
detect_index(x, p)
Do all elements of a vector satisfy a predicate?
all(sapply(x, p))
every(x, p)
Does any elements of a vector satisfy a predicate?
any(sapply(x, p))
some(x, p)
Does a list contain an object?
any(sapply(x, identical, obj))
has_element(x, obj)
Keep elements that satisfy a predicate
x[sapply(x, p)]
keep(x, p)
Discard elements that satisfy a predicate
x[!sapply(x, p)]
discard(x, p)
Negate a predicate function
function(x) !p(x)
negate(p)
Other vector transforms
Description
base R
purrr
Accumulate intermediate results of a vector reduction
Reduce(f, x, accumulate = TRUE)
accumulate(x, f)
Recursively combine two lists
c(X, Y), but more complicated to merge recursively
list_merge(), list_modify()
Reduce a list to a single value by iteratively applying a binary
function
Reduce(f, x)
reduce(x, f)
Examples
Varying inputs
One input
Suppose we would like to generate a list of samples of 5 from normal
distributions with different means:
means <-1:4
There’s little difference when generating the samples:
Base R uses lapply():
set.seed(2020)samples <-lapply(means, rnorm, n =5, sd =1)str(samples)#> List of 4#> $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797#> $ : num [1:5] 2.72 2.94 1.77 3.76 2.12#> $ : num [1:5] 2.15 3.91 4.2 2.63 2.88#> $ : num [1:5] 5.8 5.704 0.961 1.711 4.058
purrr uses map():
set.seed(2020)samples <-map(means, rnorm, n =5, sd =1)str(samples)#> List of 4#> $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797#> $ : num [1:5] 2.72 2.94 1.77 3.76 2.12#> $ : num [1:5] 2.15 3.91 4.2 2.63 2.88#> $ : num [1:5] 5.8 5.704 0.961 1.711 4.058
Two inputs
Lets make the example a little more complicated by also varying the
standard deviations:
means <-1:4sds <-1:4
This is relatively tricky in base R because we have to adjust a
number of mapply()’s defaults.
set.seed(2020)samples <-mapply( rnorm, mean = means, sd = sds, MoreArgs =list(n =5), SIMPLIFY =FALSE)str(samples)#> List of 4#> $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797#> $ : num [1:5] 3.44 3.88 1.54 5.52 2.23#> $ : num [1:5] 0.441 5.728 6.589 1.885 2.63#> $ : num [1:5] 11.2 10.82 -8.16 -5.16 4.23
Alternatively, we could use Map() which doesn’t simply,
but also doesn’t take any constant arguments, so we need to use an
anonymous function:
samples <-Map(function(...) rnorm(..., n =5), mean = means, sd = sds)
In R 4.1 and up, you could use the shorter anonymous function
form:
samples <-Map(\(...) rnorm(..., n =5), mean = means, sd = sds)
Working with a pair of vectors is a common situation so purrr
provides the map2() family of functions:
set.seed(2020)samples <-map2(means, sds, rnorm, n =5)str(samples)#> List of 4#> $ : num [1:5] 1.377 1.302 -0.098 -0.13 -1.797#> $ : num [1:5] 3.44 3.88 1.54 5.52 2.23#> $ : num [1:5] 0.441 5.728 6.589 1.885 2.63#> $ : num [1:5] 11.2 10.82 -8.16 -5.16 4.23
Any number of inputs
We can make the challenge still more complex by also varying the
number of samples:
ns <-4:1
Using base R’s Map() becomes more straightforward
because there are no constant arguments.
set.seed(2020)samples <-Map(rnorm, mean = means, sd = sds, n = ns)str(samples)#> List of 4#> $ : num [1:4] 1.377 1.302 -0.098 -0.13#> $ : num [1:3] -3.59 3.44 3.88#> $ : num [1:2] 2.31 8.28#> $ : num 4.47
In purrr, we need to switch from map2() to
pmap() which takes a list of any number of arguments.
set.seed(2020)samples <-pmap(list(mean = means, sd = sds, n = ns), rnorm)str(samples)#> List of 4#> $ : num [1:4] 1.377 1.302 -0.098 -0.13#> $ : num [1:3] -3.59 3.44 3.88#> $ : num [1:2] 2.31 8.28#> $ : num 4.47
Outputs
Given the samples, imagine we want to compute their means. A mean is
a single number, so we want the output to be a numeric vector rather
than a list.
There are two options in base R: vapply() or
sapply(). vapply() requires you to specific
the output type (so is relatively verbose), but will always return a
numeric vector. sapply() is concise, but if you supply an
empty list you’ll get a list instead of a numeric vector.
# type stablemedians <-vapply(samples, median, FUN.VALUE =numeric(1L))medians#> [1] 0.6017626 3.4411470 5.2946304 4.4694671# not type stablemedians <-sapply(samples, median)
purrr is little more compact because we can use
map_dbl().
(And of course you can mix and match the piping style with either
base R or purrr.)
The pipe is particularly compelling when working with longer
transformations. For example, the following code splits
mtcars up by cyl, fits a linear model,
extracts the coefficients, and extracts the first one (the
intercept).
rlist, another
R package to support working with lists. Similar goals but somewhat
different philosophy.
However, the goal of purrr is not to try and simulate a purer
functional programming language in R; we don’t want to implement a
second-class version of Haskell in R. The goal is to give you similar
expressiveness to an FP language, while allowing you to write code that
looks and works like R:
Instead of point free (tacit) style, we use the pipe,
%>%, to write code that can be read from left to
right.
Instead of currying, we use ... to pass in extra
arguments.
Before R 4.1, anonymous functions were verbose, so we provide two
convenient shorthands. For unary functions, ~ .x + 1 is
equivalent to function(.x) .x + 1.
R is weakly typed, so we need map variants that
describe the output type (like map_int(),
map_dbl(), etc) because we don’t know the return type of
.f.
R has named arguments, so instead of providing different
functions for minor variations (e.g. detect() and
detectLast()) we use a named argument, .right.
Type-stable functions are easy to reason about so additional arguments
will never change the type of the output.
purrr/cleanup 0000755 0001762 0000144 00000000061 14464464653 013016 0 ustar ligges users #! /usr/bin/env sh
rm -f man/macros/examples.Rd
purrr/configure 0000755 0001762 0000144 00000000751 14464464653 013356 0 ustar ligges users #! /usr/bin/env sh
# Check that this is not just ./configure. We need to run this
# from R CMD INSTALL, to have the R env vars set.
if [ -z "$R_HOME" ]; then
echo >&2 R_HOME is not set, are you running R CMD INSTALL?
exit 1
fi
# Find the R binary we need to use. This is a bit trickier on
# Windows, because it has two architectures. On windows R_ARCH_BIN
# is set, so this should work everywhere.
RBIN="${R_HOME}/bin${R_ARCH_BIN}/R"
"$RBIN" --vanilla --slave -f tools/examples.R
[](https://cran.r-project.org/package=purrr)
[](https://app.codecov.io/gh/tidyverse/purrr?branch=master)
[](https://github.com/tidyverse/purrr/actions)
## Overview
purrr enhances R’s functional programming (FP) toolkit by providing a
complete and consistent set of tools for working with functions and
vectors. If you’ve never heard of FP before, the best place to start is
the family of `map()` functions which allow you to replace many for
loops with code that is both more succinct and easier to read. The best
place to learn about the `map()` functions is the [iteration
chapter](https://r4ds.had.co.nz/iteration.html) in R for data science.
## Installation
``` r
# The easiest way to get purrr is to install the whole tidyverse:
install.packages("tidyverse")
# Alternatively, install just purrr:
install.packages("purrr")
# Or the the development version from GitHub:
# install.packages("remotes")
remotes::install_github("tidyverse/purrr")
```
## Cheatsheet