Preserve classes in pmap()

NEWS.md

@@ -1,5 +1,8 @@
 # purrr 0.2.4.9000
 
+* `pmap()` and `pwalk()` now preserve class for inputs of `factor`, `Date`, `POSIXct`
+  and other atomic S3 classes with an appropriate `[[` method (#358, @mikmart).
+
 * `compose()` now supports composition with lambdas (@ColinFay, #556)
 
 * Fixed a `pmap()` crash with empty lists on the Win32 platform (#565).

R/map.R

@@ -209,9 +209,6 @@ map_dfc <- function(.x, .f, ...) {
 #' @export
 #' @rdname map
 walk <- function(.x, .f, ...) {
-  .f <- as_mapper(.f, ...)
-  for (i in seq_along(.x)) {
-    .f(.x[[i]], ...)
-  }
+  map(.x, .f, ...)
   invisible(.x)
 }

R/map2-pmap.R

@@ -147,7 +147,7 @@ map2_df <- map2_dfr
 #' @export
 #' @rdname map2
 walk2 <- function(.x, .y, .f, ...) {
-  pwalk(list(.x, .y), .f, ...)
+  map2(.x, .y, .f, ...)
   invisible(.x)
 }
 
@@ -245,10 +245,6 @@ pmap_df <- pmap_dfr
 #' @export
 #' @rdname map2
 pwalk <- function(.l, .f, ...) {
-  .f <- as_mapper(.f, ...)
-  args_list <- transpose(recycle_args(.l))
-  for (args in args_list) {
-    do.call(".f", c(args, list(...)))
-  }
+  pmap(.l, .f, ...)
   invisible(.l)
 }

src/map.c

@@ -174,7 +174,11 @@ SEXP pmap_impl(SEXP env, SEXP l_name_, SEXP f_name_, SEXP type_) {
   SEXP i = Rf_install("i");
   SEXP one = PROTECT(Rf_ScalarInteger(1));
 
-  // Construct call like f(.x[[c(1, i)]], .x[[c(2, i)]], ...)
+  // 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.
@@ -186,10 +190,10 @@ SEXP pmap_impl(SEXP env, SEXP l_name_, SEXP f_name_, SEXP type_) {
   for (int j = m - 1; j >= 0; --j) {
     int nj = Rf_length(VECTOR_ELT(l_val, j));
 
-    // Construct call like .l[[c(j, i)]]
+    // Construct call like .l[[j]][[i]]
     SEXP j_ = PROTECT(Rf_ScalarInteger(j + 1));
-    SEXP ji_ = PROTECT(Rf_lang3(Rf_install("c"), j_, nj == 1 ? one : i));
-    SEXP l_ji = PROTECT(Rf_lang3(R_Bracket2Symbol, l, ji_));
+    SEXP l_j = PROTECT(Rf_lang3(R_Bracket2Symbol, l, j_));
+    SEXP l_ji = PROTECT(Rf_lang3(R_Bracket2Symbol, l_j, nj == 1 ? one : i));
 
     REPROTECT(f_call = Rf_lcons(l_ji, f_call), fi);
     if (has_names && CHAR(STRING_ELT(l_names, j))[0] != '\0')

tests/testthat/test-map_n.R

@@ -64,3 +64,9 @@ test_that("pmap on data frames performs rowwise operations", {
 test_that("pmap works with empty lists", {
   expect_identical(pmap(list(), identity), 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))
+})