R/meta_demographics.R

In Ingenuity-Inc/artlookR: Work with artlook data

#' artlookR demographics metadata
#'
#' There is only one set of \code{demographics} categories and names used across the entire artlookR platform (i.e., this table is listed in the
#' \code{public} schema). These categories and names are based on the US Census categories and names.
#' Because of that there is no requirement in this function to identify a \code{comm_name}.
#' @return A list with the artlookR id, display name, and label name for all \code{demographics} groups in the artlookR database.
#' Also presents the information broken down by those groups that are race-ethnicity and those that are other demographics (e.g., reduced lunch).
#' @details You will need to run the \code{connection.R} script and create a connection object named \code{myconn} for this script to run.
#' @examples meta_demo()
#' @export
meta_demo <- function(...){

  temp <- tbl(myconn, in_schema("public", "demographics")) %>%
    select(id, name, display_name) %>%
    collect  %>%
    mutate(display_name = ifelse(is.na(display_name), str_to_title(str_replace_all(name, "_", " ")), display_name),
           oth = case_when(name == "other_na" ~ 1,
                           TRUE ~ 0)) %>%
    group_by(oth) %>%
    arrange(display_name, .by_group = T) %>%
    ungroup

  output <- list(demo_id = temp %>% pull(id),
                 demo_label = temp %>% pull(display_name),
                 demo_level = temp %>% pull(name),
                 oth_demo_id = temp$id[temp$name %in% c("limited_english", "reduced_lunch", "special_education")],
                 oth_demo_label = temp$display_name[temp$name %in% c("limited_english", "reduced_lunch", "special_education")],
                 oth_demo_level = c("limited_english", "reduced_lunch", "special_education"),
                 race_id = temp$id[!temp$name %in% c("limited_english", "reduced_lunch", "special_education")],
                 race_label = temp$display_name[!temp$name %in% c("limited_english", "reduced_lunch", "special_education")],
                 race_level = temp$name[!temp$name %in% c("limited_english", "reduced_lunch", "special_education")])

  output
}