diff --git a/R/map_flat.R b/R/map_flat.R new file mode 100644 index 00000000..f1f4717b --- /dev/null +++ b/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) +} diff --git a/tests/testthat/test-map_flat.R b/tests/testthat/test-map_flat.R new file mode 100644 index 00000000..1714d2c5 --- /dev/null +++ b/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) +})