R/agg.R

In EricLamphere/ezxfig: Transfigure data frames

#' Aggregate Measures By Dimensions
#'
#' @description This function is great for getting rollups across various dimensions
#'
#' @param .data A data frame
#' @param .dims Character vector of column names that represent the data frames
#'   dimensions to be grouped by and summarised with the formulas in
#' @param .all_dims Character vector of column names that represent the data
#'   frames entire set of dimensions. All other columns will be ignored unless
#'   referenced in `...`
#' @param ... Named expressions passed to [dplyr::summarise()]. These formulas
#'   are also applied at the `rowwise` level in a [dplyr::mutate] call to
#'   `.data`
#' @param .append Logical, whether or not to append the aggregated data to
#'   `.data` with "TOTAL" rows
#'
#' @return Data frame
#'
#' @examples
#' library(dplyr)
#' agger <- purrr::partial(
#'   agg,
#'   conc = mean(conc, na.rm = TRUE),
#'   uptake = mean(uptake, na.rm = TRUE),
#'   .all_dims = c("Plant", "Type", "Treatment")
#' )
#' tibble::tibble(datasets::CO2) %>%
#'   agger(c("Plant", "Type")) %>%
#'   agger("Treatment")
#'
#' @importFrom ezextras "%notin%"
#'
#' @export
agg <- function(.data, .dims = NULL, .all_dims, ..., .append = TRUE) {
  if (any(.dims %notin% colnames(.data))) {
    invalid <-
      ezextras::wrap(
        .dims[.dims %notin% colnames(.data)],
        "'"
      )
    cli::cli_abort("Can't aggregate by missing dimensions: {crayon::red(invalid)}")
  }

  filt_new_vars <-
    .data %>%
    dplyr::rowwise() %>%
    dplyr::mutate(...) %>%
    dplyr::ungroup()

  agged <-
    filt_new_vars %>%
    filter_remove_totals(dims = .all_dims) %>%
    rollup(.dims, ...)


  if (!.append) {
    return(agged)
  } else {
    agged_totals <-
      .agg_create_totals(
        data = agged,
        included_dims = .dims,
        all_dims = .all_dims
      )

    dplyr::bind_rows(
      filt_new_vars,
      agged_totals
    )
  }
}


#' Aggregate Data Over Dimensions
#'
#' @description This function is essentially a wrapper for `group_by %>%
#'   summarise`
#'
#' @param .data A data frame
#' @param .dims Character vector of column names that represent the data frames
#'   dimensions to be grouped by and summarised with the formulas in
#' @param ... Named expressions passed to [dplyr::summarise()]
#'
#' @return Data frame
#'
#' @export
rollup <- function(.data, .dims = NULL, ...) {
  if (is.null(.dims)) {
    return(dplyr::summarise(.data, ..., .groups = "drop"))
  }

  .data %>%
    dplyr::group_by(!!! rlang::syms(.dims)) %>%
    dplyr::summarise(..., .groups = "keep") %>%
    dplyr::ungroup()
}



# HELPERS ----
.agg_create_totals <- function(data, included_dims, all_dims) {
  excluded_dims <- .get_dims_excluded(included_dims, all_dims)

  calc(
    data = data,
    labels = excluded_dims,
    formulas = rep(totals_value(TRUE), length(excluded_dims))
  )
}


.get_dims_excluded <- function(included_dims, all_dims) {
  all_dims[all_dims %notin% included_dims]
}