R/03.mdapply.R

#' Loop on a Sequence of Instructions
#'
#' apply a sequence of instructions for different sets of parameters
#'
#' @param x data.frame
#' @param ... instructions
#'
#' @return a character
#' @export
mdapply <- function(x, ..., knit = FALSE){
  if (!is.data.frame(x)) stop("x must be a data.frame")
  x <- x %>% purrr::mutate_if(is.factor, as.list)
  dots <- tibble::lst(...)
  purrr::map(dots,~when(
    .,
    is.character(.) ~ purrr::pmap(x,~with(list(...), glue::glue(.dot)),.dot=.),
    inherits(.,"formula") ~
      purrr::map(
        seq(nrow(x)),
        ~substitute(
          substitute(.y,lkp),
          lst(.y,
              lkp = glue::glue("{substitute(x)}${names(x)}[[{.x}]]") %>% # glue string
                parse(text=.)        %>% # expression (list of calls)
                as.list()            %>% # list
                setNames(names(x)))) %>% # named list
          # resolve outer substitute, so we get formula as typed
          eval() %>%
          # resolve inner substitute, so we get transformed variable
          eval() %>%
          formula_to_chunk(),
        # pass formula as .y so doesn't conflict with `.` as dot args (formulas)
        .y=.
      )# end of map
  )) %>%
    purrr::transpose() %>%
    purrr::map_chr(paste, collapse = "\n\n") %>%
    paste(collapse = "\n\n\n") %>%
    {if (knit) knitr::knit(text = .) else .}
}
moodymudskipper/mmmd documentation built on May 15, 2019, 9:14 p.m.