1#' Map over multiple inputs simultaneously.
2#'
3#' These functions are variants of [map()] that iterate over multiple arguments
4#' simultaneously. They are parallel in the sense that each input is processed
5#' in parallel with the others, not in the sense of multicore computing. They
6#' share the same notion of "parallel" as [base::pmax()] and [base::pmin()].
7#' `map2()` and `walk2()` are specialised for the two argument case; `pmap()`
8#' and `pwalk()` allow you to provide any number of arguments in a list. Note
9#' that a data frame is a very important special case, in which case `pmap()`
10#' and `pwalk()` apply the function `.f` to each row. `map_dfr()`, `pmap_dfr()`
11#' and `map2_dfc()`, `pmap_dfc()` return data frames created by row-binding
12#' and column-binding respectively. They require dplyr to be installed.
13#'
14#' Note that arguments to be vectorised over come before `.f`,
15#' and arguments that are supplied to every call come after `.f`.
16#'
17#' @inheritParams map
18#' @param .x,.y Vectors of the same length. A vector of length 1 will
19#'   be recycled.
20#' @param .l A list of vectors, such as a data frame. The length of `.l`
21#'   determines the number of arguments that `.f` will be called with. List
22#'   names will be used if present.
23#' @return An atomic vector, list, or data frame, depending on the suffix.
24#'   Atomic vectors and lists will be named if `.x` or the first
25#'   element of `.l` is named.
26#'
27#'   If all input is length 0, the output will be length 0. If any
28#'   input is length 1, it will be recycled to the length of the longest.
29#' @export
30#' @family map variants
31#' @examples
32#' x <- list(1, 1, 1)
33#' y <- list(10, 20, 30)
34#' z <- list(100, 200, 300)
35#'
36#' map2(x, y, ~ .x + .y)
37#' # Or just
38#' map2(x, y, `+`)
39#'
40#' pmap(list(x, y, z), sum)
41#'
42#' # Matching arguments by position
43#' pmap(list(x, y, z), function(first, second, third) (first + third) * second)
44#'
45#' # Matching arguments by name
46#' l <- list(a = x, b = y, c = z)
47#' pmap(l, function(c, b, a) (a + c) * b)
48#'
49#' # Split into pieces, fit model to each piece, then predict
50#' by_cyl <- mtcars %>% split(.$cyl)
51#' mods <- by_cyl %>% map(~ lm(mpg ~ wt, data = .))
52#' map2(mods, by_cyl, predict)
53#'
54#' # Vectorizing a function over multiple arguments
55#' df <- data.frame(
56#'   x = c("apple", "banana", "cherry"),
57#'   pattern = c("p", "n", "h"),
58#'   replacement = c("P", "N", "H"),
59#'   stringsAsFactors = FALSE
60#'   )
61#' pmap(df, gsub)
62#' pmap_chr(df, gsub)
63#'
64#' # Use `...` to absorb unused components of input list .l
65#' df <- data.frame(
66#'   x = 1:3,
67#'   y = 10:12,
68#'   z = letters[1:3]
69#' )
70#' plus <- function(x, y) x + y
71#' \dontrun{
72#' # this won't work
73#' pmap(df, plus)
74#' }
75#' # but this will
76#' plus2 <- function(x, y, ...) x + y
77#' pmap_dbl(df, plus2)
78#'
79#' # The "p" for "parallel" in pmap() is the same as in base::pmin()
80#' # and base::pmax()
81#' df <- data.frame(
82#'   x = c(1, 2, 5),
83#'   y = c(5, 4, 8)
84#' )
85#' # all produce the same result
86#' pmin(df$x, df$y)
87#' map2_dbl(df$x, df$y, min)
88#' pmap_dbl(df, min)
89#'
90#' # If you want to bind the results of your function rowwise, use:
91#' # map2_dfr() or pmap_dfr()
92#' ex_fun <- function(arg1, arg2){
93#' col <- arg1 + arg2
94#' x <- as.data.frame(col)
95#' }
96#' arg1 <- 1:4
97#' arg2 <- 10:13
98#' map2_dfr(arg1, arg2, ex_fun)
99#' # If instead you want to bind by columns, use map2_dfc() or pmap_dfc()
100#' map2_dfc(arg1, arg2, ex_fun)
101
102map2 <- function(.x, .y, .f, ...) {
103  .f <- as_mapper(.f, ...)
104  .Call(map2_impl, environment(), ".x", ".y", ".f", "list")
105}
106#' @export
107#' @rdname map2
108map2_lgl <- function(.x, .y, .f, ...) {
109  .f <- as_mapper(.f, ...)
110  .Call(map2_impl, environment(), ".x", ".y", ".f", "logical")
111}
112#' @export
113#' @rdname map2
114map2_int <- function(.x, .y, .f, ...) {
115  .f <- as_mapper(.f, ...)
116  .Call(map2_impl, environment(), ".x", ".y", ".f", "integer")
117}
118#' @export
119#' @rdname map2
120map2_dbl <- function(.x, .y, .f, ...) {
121  .f <- as_mapper(.f, ...)
122  .Call(map2_impl, environment(), ".x", ".y", ".f", "double")
123}
124#' @export
125#' @rdname map2
126map2_chr <- function(.x, .y, .f, ...) {
127  .f <- as_mapper(.f, ...)
128  .Call(map2_impl, environment(), ".x", ".y", ".f", "character")
129}
130#' @export
131#' @rdname map2
132map2_raw <- function(.x, .y, .f, ...) {
133  .f <- as_mapper(.f, ...)
134  .Call(map2_impl, environment(), ".x", ".y", ".f", "raw")
135}
136#' @rdname map2
137#' @export
138map2_dfr <- function(.x, .y, .f, ..., .id = NULL) {
139  if (!is_installed("dplyr")) {
140    abort("`map2_dfr()` requires dplyr")
141  }
142
143  .f <- as_mapper(.f, ...)
144  res <- map2(.x, .y, .f, ...)
145  dplyr::bind_rows(res, .id = .id)
146}
147#' @rdname map2
148#' @export
149map2_dfc <- function(.x, .y, .f, ...) {
150  if (!is_installed("dplyr")) {
151    abort("`map2_dfc()` requires dplyr")
152  }
153
154  .f <- as_mapper(.f, ...)
155  res <- map2(.x, .y, .f, ...)
156  dplyr::bind_cols(res)
157}
158#' @rdname map2
159#' @export
160#' @usage NULL
161map2_df <- map2_dfr
162#' @export
163#' @rdname map2
164walk2 <- function(.x, .y, .f, ...) {
165  map2(.x, .y, .f, ...)
166  invisible(.x)
167}
168
169#' @export
170#' @rdname map2
171pmap <- function(.l, .f, ...) {
172  .f <- as_mapper(.f, ...)
173  if (is.data.frame(.l)) {
174    .l <- as.list(.l)
175  }
176
177  .Call(pmap_impl, environment(), ".l", ".f", "list")
178}
179
180#' @export
181#' @rdname map2
182pmap_lgl <- function(.l, .f, ...) {
183  .f <- as_mapper(.f, ...)
184  if (is.data.frame(.l)) {
185    .l <- as.list(.l)
186  }
187
188  .Call(pmap_impl, environment(), ".l", ".f", "logical")
189}
190#' @export
191#' @rdname map2
192pmap_int <- function(.l, .f, ...) {
193  .f <- as_mapper(.f, ...)
194  if (is.data.frame(.l)) {
195    .l <- as.list(.l)
196  }
197
198  .Call(pmap_impl, environment(), ".l", ".f", "integer")
199}
200#' @export
201#' @rdname map2
202pmap_dbl <- function(.l, .f, ...) {
203  .f <- as_mapper(.f, ...)
204  if (is.data.frame(.l)) {
205    .l <- as.list(.l)
206  }
207
208  .Call(pmap_impl, environment(), ".l", ".f", "double")
209}
210#' @export
211#' @rdname map2
212pmap_chr <- function(.l, .f, ...) {
213  .f <- as_mapper(.f, ...)
214  if (is.data.frame(.l)) {
215    .l <- as.list(.l)
216  }
217
218  .Call(pmap_impl, environment(), ".l", ".f", "character")
219}
220#' @export
221#' @rdname map2
222pmap_raw <- function(.l, .f, ...) {
223  .f <- as_mapper(.f, ...)
224  if (is.data.frame(.l)) {
225    .l <- as.list(.l)
226  }
227
228  .Call(pmap_impl, environment(), ".l", ".f", "raw")
229}
230
231#' @rdname map2
232#' @export
233pmap_dfr <- function(.l, .f, ..., .id = NULL) {
234  if (!is_installed("dplyr")) {
235    abort("`pmap_dfr()` requires dplyr")
236  }
237
238  .f <- as_mapper(.f, ...)
239  res <- pmap(.l, .f, ...)
240  dplyr::bind_rows(res, .id = .id)
241}
242
243#' @rdname map2
244#' @export
245pmap_dfc <- function(.l, .f, ...) {
246  if (!is_installed("dplyr")) {
247    abort("`pmap_dfc()` requires dplyr")
248  }
249
250  .f <- as_mapper(.f, ...)
251  res <- pmap(.l, .f, ...)
252  dplyr::bind_cols(res)
253}
254
255#' @rdname map2
256#' @export
257#' @usage NULL
258pmap_df <- pmap_dfr
259
260#' @export
261#' @rdname map2
262pwalk <- function(.l, .f, ...) {
263  pmap(.l, .f, ...)
264  invisible(.l)
265}
266