R/tbl.group.sum.R

In irisweyermenkhoff/toyota-idv-functions: Risk Reporting and Toolbox Calculation Functions

#' Scalar variable of a tbl with groups
#'
#' This function creates a scalar variable summarizing the variables of a tbl
#' with groups created by group_by
#'
#' First define the data tbl and add grouping variables. After grouping
#' on the variables add summarizing variables to create scalar variable. The
#' scalar variable are saved as prefix "sum_" + varNAME.
#'
#' @param data a tbl.
#' @param group_vars listed variable names to group by.
#' @param summary_vars listed variable names to summarize.
#' @return an object of the same class as data.
#'

tbl.group.sum <- function(data, group_vars, summary_vars, prefix = TRUE) {
  stopifnot(
    is.list(group_vars),
    is.list(summary_vars)
  )


  if (prefix == TRUE) {
    # Detect and prefix unnamed arguments:
    unnamed <- names(summary_vars) == ""

    # Add the default names:
    summary_vars <- rlang::quos_auto_name(summary_vars)

    prefixed_nms <- paste0("sum_", names(summary_vars)[unnamed])
    names(summary_vars)[unnamed] <- prefixed_nms

    # Expand the argument _after_ giving the list its default names
    summary_vars <- purrr::map(summary_vars, function(var) {
      expr(sum(!!var, na.rm = TRUE))
    })

    data %>%
      group_by(!!!group_vars) %>%
      summarise(!!!summary_vars) %>% # Unquote-splice the renamed list
      ungroup()

  } else {


    # Add the default names:
    summary_vars <- rlang::quos_auto_name(summary_vars)

    # Expand the argument _after_ giving the list its default names
    summary_vars <- purrr::map(summary_vars, function(var) {
      expr(sum(!!var, na.rm = TRUE))
    })


    data %>%
      group_by(!!!group_vars) %>%
      summarise(!!!summary_vars) %>% # Unquote-splice the renamed list
      ungroup()
  }
}