R/01_mapx.R

In moodymudskipper/tidyx: modified tidyverse functions for interractive use

#' generalized purrr::map
#'
#' Includes the features of all \code{map_*} and \code{imap_*} functions with a
#' slightly modified interface. Use \code{.i} and \code{.n} in formula or
#' function to access current index or current name. Nor fast nor robust,
#' made for interractive use.
#'
#' @inheritParams purrr::map
#' @param .t type of output
#' @param .id passed to map_dfr
#' @param .invis set to \code{TRUE} to get walk behavior
#'
#' @export
#'
#' @examples
#' l1 <- list(a = "foo", b = "bar")
#' l1 %>% mapx(~ paste(., .i, .n))
#' l1 %>% mapx(~ paste(., .i, .n), .t="chr")
#' l1 %>% mapx(paste,"X")
#' l1 %>% mapx(function(x,.n) paste(x,.n),"[.n param]")
#' l1 %>% mapx(function(x) paste(x,.n))
mapx <- function(.x, .f, ..., .t = c("lst","lgl","int","dbl","chr","dfr","dfc"),
                 .id = NULL, .invis = FALSE)
{
  # check .t
  .t = match.arg(.t)
  type = c(lst = "list",dfr = "list", dfc = "list", chr = "character",
           lgl = "logical", int = "integer",dbl = "double")[.t]

  # change the formals to add .i, and add its values to .l
  .f <- purrr::as_mapper(.f, ...)
  .l <- list(.x)
  if (!".i" %in% formalArgs(.f)) {
    formals(.f) <- c(formals(.f), alist(.i = ))
    .l <- c(.l, list(.i = seq_along(.x)))
  } else message(".f already has a .i formal, the `.i = seq_along(.x)` ",
                 "feature will be disabled")

  # change the formals to add .n, and add its values to .l
  if (!".n" %in% formalArgs(.f)) {
    formals(.f) <- c(formals(.f),alist(.n = ))
    .l <- c(.l, list(.n = rlang::names2(.x)))
  } else message(".f already has a .n formal, the `.n = rlang::names2(.x)` ",
                 "feature will be disabled")

  # call pmap with right type and reformat if relevant
  res <- .Call(purrr:::pmap_impl, environment(), ".l", ".f", type)
  if (.t == "dfr") res <- dplyr::bind_rows(res, .id = .id)
  else if (.t == "dfc") res <- dplyr::bind_cols(res)
  if (.invis) invisible(res) else res
}