Add map_flat_type functions

R/map_flat.R

@@ -0,0 +1,125 @@
+#' Map a function then flatten the result by one-level
+#'
+#' @description
+#'
+#' The map_flap functions are equivalent to applying [map()]
+#' followed by a flatten function to remove one level of hierarchy
+#' from the list obtained by using [map()].
+#'
+#' * `map_flat()` is equivalent to [map()] followed by [flatten()].
+#'
+#' * `map_flat_lgl()`, `map_flat_int()`, `map_flap_dbl()`, `map_flat_chr()` and
+#'   `map_flat_raw` are equivalent to [map()] followed respectively by
+#'   [flatten_lgl()], [flatten_int()], [flatten_dbl()], [flatten_chr()] and
+#'   [flatten_raw()]
+#'
+#' * `map_flat_dfr()` and `map_flat_dfc()` are equivalent to [map()] followed
+#'   respectively by [flatten_dfr()] and [flatten_dfc()]
+#'
+#' @section About map vs map_flat Variants:
+#'
+#' Compared to [map_lgl()], [map_chr()], etc,
+#' map_flat functions are adapted to functions returning a variable
+#' number of elements.
+#'
+#' The map variants works by coercing the list to
+#' a vector of corresponding type - for that each element of the list resulting
+#' map must be a length 1 atomic vector, otherwise it will return an error.
+#'
+#' map_flat variants don't have that limitation as they unlist one level before
+#' trying to return a vector - it is more like concatenating map results, whatever the size
+#' of each elements in the resulting list after applying the function.
+#'
+#' @return `map_flat` returns a list, `map_flat_lgl()` a logical
+#'   vector, `map_flat_int()` an integer vector, `map_flat_dbl()` a
+#'   double vector, and `map_flat_chr()` a character vector.
+#'
+#'   `map_flat_dfr()` and `map_flat_dfc()` return data frames created by
+#'   row-binding and column-binding respectively. They require dplyr to
+#'   be installed.
+#'
+#' @inheritParams map
+#' @export
+#' @family map variants
+#' @seealso [map_lgl()], [map_chr()], [map_dbl()], [map_int()], [map_dfr()],
+#'   [map_dfc()], [map_raw()]
+#' @examples
+#' # It can be useful to map a function but flatten the result
+#' # to a vector. It is like concatenating map results.
+#' c("one piece", "four red pieces") %>%
+#'   map_flat_chr(~strsplit(.x, " ")[[1]])
+#' # this is equivalent to
+#' c("one piece", "four red pieces") %>%
+#'   map(~strsplit(.x, " ")[[1]]) %>%
+#'   flatten_chr()
+#' # Using map_chr() does not work here because resulting
+#' # elements before coercion is not of length 1,
+#' # so coercion failed.
+#' \dontrun{
+#' c("one piece", "four red pieces") %>%
+#'   map_chr(~strsplit(.x, " ")[[1]])
+#' }
+#'
+#' # Sample a variable number of elements from each column and
+#' # concatenate the results
+#' var_select <- function(x) sample(x, size = rdunif(1, 5))
+#' # map var_select on each mtcars column then flatten the result
+#' # by on level
+#' c(mtcars) %>% map_flat(var_select) # a list
+#' c(mtcars) %>% map_flat_dbl(var_select) # a numeric vector
+#' c(mtcars) %>% map_flat_chr(var_select) # a character vector
+#' # equivalent to
+#' c(mtcars) %>% map(var_select) %>% flatten_dbl()
+map_flat <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten(out)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_lgl <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten_lgl(out)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_int <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten_int(out)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_chr <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten_chr(out)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_dbl <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten_dbl(out)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_dfr <- function(.x, .f, ..., .id = NULL) {
+  out <- map(.x, .f = .f, ...)
+  flatten_dfr(out, .id = .id)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_dfc <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten_dfc(out)
+}
+
+#' @rdname map_flat
+#' @export
+map_flat_raw <- function(.x, .f, ...) {
+  out <- map(.x, .f = .f, ...)
+  flatten_raw(out)
+}

tests/testthat/test-map_flat.R

@@ -0,0 +1,25 @@
+context("map_flat")
+
+test_that("map function and flatten one level", {
+  expect_equal(map_flat(list(1:2, 3:6), `*`, 2), list(2, 4, 6, 8, 10, 12))
+})
+
+test_that("map_flat variants are correct types", {
+  set.seed(45)
+  return_var <- function(x, type) vector(type, rpois(1, 5))
+  expect_type(map_flat_dbl(c(mtcars), return_var, "double"), "double")
+  expect_type(map_flat_chr(c(mtcars), return_var, "character"), "character")
+  expect_type(map_flat_int(c(mtcars), return_var, "integer"), "integer")
+  expect_type(map_flat_lgl(c(mtcars), return_var, "logical"), "logical")
+  expect_type(map_flat_raw(c(mtcars), return_var, "raw"), "raw")
+})
+
+test_that("row and column binding work", {
+  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_flat_dfr(f_coef), 2)
+  expect_length(mtcar_mod %>% map_flat_dfr(f_coef, .id = "col"), 3)
+  expect_length(mtcar_mod %>% map_flat_dfc(f_coef), 6)
+})