4dc7e3dd9104dd8cae615f58ca31d77d17d7d9ab — boB Rudis 10 months ago 3063918 + bd4201e
Merge pull request #14 from malcolmbarrett/master

add map_dfc, bind_cols, fix map2 calls
1 files changed, 51 insertions(+), 1 deletions(-)

M inst/templates/mappers.R
M inst/templates/mappers.R => inst/templates/mappers.R +51 -1
@@ 124,14 124,31 @@   map_dfr <- map_df
  
+ map_dfc <- function(.x, .f, ...) {
+ 
+   res <- map(.x, .f, ...)
+   out <- bind_cols(res)
+   out
+ 
+ }
+ 
  map2_df <- function(.x, .y, .f, ..., .id=NULL) {
  
-   res <- map(.x, .y, .f, ...)
+   res <- map2(.x, .y, .f, ...)
    out <- bind_rows(res, .id = .id)
    out
  
  }
  
+ 
+ map2_dfc <- function(.x, .y, .f, ...) {
+ 
+   res <- map2(.x, .y, .f, ...)
+   out <- bind_cols(res)
+   out
+ 
+ }
+ 
  # this has limitations and is more like 75% of dplyr::bind_rows()
  # this is also orders of magnitude slower than dplyr::bind_rows()
  bind_rows <- function(..., .id = NULL) {


@@ 182,6 199,39 @@   }
  
+ bind_cols <- function(...) {
+ 
+   res <- list(...)
+ 
+   row_mismatch <- lapply(res, nrow) != nrow(res[[1]])
+ 
+   if (any(row_mismatch)) {
+     first_mismatch_pos <- which(row_mismatch)[1]
+     stop(paste0("Argument ", first_mismatch_pos,
+                 " must be length ", nrow(res[[1]]),
+                 ", not ", nrow(res[[first_mismatch_pos]])))
+     }
+ 
+   if (length(res) == 1) res <- res[[1]]
+ 
+   col_names <- unlist(lapply(res, names), use.names = FALSE)
+   col_names <- make.unique(col_names, sep = "")
+ 
+   saf <- default.stringsAsFactors()
+   options(stringsAsFactors = FALSE)
+   on.exit(options(stringsAsFactors = saf))
+ 
+   out <- do.call(cbind.data.frame, res)
+ 
+   names(out) <- col_names
+   rownames(out) <- NULL
+ 
+   class(out) <- c("tbl_df", "tbl", "data.frame")
+ 
+   out
+ 
+ }
+ 
  
  # set.seed(1)
  # 1:10 %>%