R/calc.R

In EricLamphere/ezxfig: Transfigure data frames

#' Programmatically Calculate New Columns
#'
#' @description Create new columns using a list of column names (labels) and
#'   formulas. \code{labels} and \code{formulas} should both be character
#'   vectors of the same length
#'
#' @param data The data frame you're manipulating. The \code{formulas} should be
#'   based off of the column names of data.
#' @param labels A character vector used as the names for the newly created
#'   columns.
#' @param formulas A character vector of formulas (e.g. \code{col1 / col2}) used
#'   to generate the new columns.
#' @param prefix A prefix to append to the beginning of all of the column names
#'   in \code{labels}.
#' @param quiet Logical, if TRUE, print helpful messages for debugging
#'
#' @return A data frame with the newly calculated columns.
#'
#' @examples
#' calc(dplyr::tibble(x = c(1,2,3), y = c(2,2,2)), labels = c("x_times_y"),formulas = c("x * y"))
#'
#' @importFrom magrittr "%>%"
#' @importFrom ezextras "%&%"
#'
#' @export
calc <- function(data, labels, formulas, prefix = "", quiet = TRUE) {
  if (!quiet && any(labels %in% colnames(data))) {
    overwriting <-
      labels[which(labels %in% colnames(data))] %>%
      paste(collapse = ", ")
    cli::cli_alert("Overwriting existing columns: {crayon::cyan(overwriting)}")
  }

  if (!quiet) {
    bullets <-
      stats::setNames(
        "{crayon::cyan('" %&% prefix %&% labels %&% "')}: {crayon::yellow('" %&% formulas %&% "')}",
        rep("*", length(labels))
      )
    cli::cli_bullets(c(
      "Adding new variables using the following formulas: ",
      bullets
    ))
  }

  mutate_vec <-
    stats::setNames(
      rlang::parse_exprs(formulas),
      prefix %&% labels
    )

  calculated <- data %>%
    dplyr::mutate(
      !!! mutate_vec
    )

  calculated
}