R/bcat_extract_metadata.R

In Rbearcat: University of Cincinnati Themes and Utilities for Econometrics and Data Science

#' Extract metadata
#'
#' This utility function is useful for extracting column values that will be used for inline text
#' by saving metadata column values in a nested (named) list.
#'
#' @param df input data
#' @param id_col ID column used identify observations
#'
#' @return A named list. Each top-level element corresponds to a metadata column
#'   in \code{df}, and each nested element is named by \code{id_col} values and
#'   stores the matching column value.
#'
#' @author Saannidhya Rawat
#' @family utilities
#'
#' @export
#' @examples
#' library(Rbearcat)
#' library(tibble)
#'
#' lob_df <- tibble(lob = c("drl", "mla", "rac"),
#'                  balance = bcat_fmt_dollar(c(11, 26, 7)),
#'                  nco = bcat_fmt_dollar(c(80, 45, 800)))
#'
#' # extract metadata from each column and save to list
#' lob_meta <- bcat_extract_metadata(lob_df, lob)
#'
#' # extract individual values from list
#' lob_meta$balance$mla
#' lob_meta$nco$rac
#'
bcat_extract_metadata <- function(df,
                                  id_col){

  # get all values for ID variable
  id_all_vals <- dplyr::select(df, {{id_col}}) %>% dplyr::pull()

  # get unique values for ID variable
  id_values <- dplyr::distinct(df, {{id_col}}) %>% dplyr::pull()

  # error check: values in id_col must be unique
  if(length(id_values) != length(id_all_vals)){

    usethis::ui_stop("ID column values are not unique!
                      ID column must have distinct values")
  }

  # get metadata variables to loop through
  meta_vars <- dplyr::select(df, c(-{{id_col}}))
  meta_vars <- colnames(meta_vars)

  # define function to extract *one* metadata column
  extract_col <- function(x, data, id, meta){

    purrr::map(x,
               ~ data %>%
                 dplyr::filter({{id}} == .x) %>%
                 dplyr::pull({{meta}})
    ) %>%
      purrr::set_names(x)

  }

  # loop to extract *all* metadata column values
  purrr::map(meta_vars, ~extract_col(x = id_values, data = df, id = {{id_col}}, meta = .x)) %>%
    purrr::set_names(meta_vars)

}