R/set_names_from_template.R

In sarid-ins/saridr: An R package for common tasks related to market research analysis via R

#' Safe header renaming from a template file
#'
#' @details Renames a tibble or a data.frame from a template file.
#' The renaming is safe in the sense that if the template doesn't include a specific header, it remains unchanged.
#' Templates can be created with `make_header_template`.
#'
#' @param x a tbl() to rename
#' @param path the path to save the template into
#' @param use_column the column for the new names, expects a quasiquotation (dplyr style)
#'
#' @examples
#' mtcars %>% make_header_template(path = "mtcar_headers.csv")
#' mtcars %>% set_names_from_template(path = "mtcar_headers.csv")
#'
#' iris %>% make_header_template(path = "iris_headers.xlsx")
#' iris %>% set_names_from_template(path = "iris_headers.xlsx")
#'
#' @importFrom magrittr %>%
#'
#' @export
set_names_from_template <- function(x, path, use_column = new_name){

  is_csv <- stringr::str_sub(path, start = -3) == "csv"
  is_xlsx <- stringr::str_sub(path, start = -4) == "xlsx"

  if (!is_csv & !is_xlsx) {
    stop("This function only reads csv or xlsx files.")
  }

  if (is_csv) {
    renaming_template <- readr::read_csv(path)
  } else {
    renaming_template <- readxl::read_excel(path)
  }

  renaming_tibble <- tibble::tibble(old_name = names(x)) %>%
    dplyr::left_join(renaming_template, by = "old_name") %>%
    dplyr::mutate(new_name = dplyr::coalesce({{use_column}}, old_name))

  x %>%
    purrr::set_names(renaming_tibble$new_name)

}