R/harmonize_var_names.R

In antaldaniel/retroharmonize: Ex Post Survey Data Harmonization

#' @title Harmonize the variable names of surveys
#' 
#' @description The function harmonizes the variable names of surveys (of class \code{survey}) that 
#' are imported from an external file as a wave.
#' 
#' @details If the \code{metadata} that contains subsetting information is subsetted, then 
#' it will subset the surveys in 
#' \code{survey_list}.
#' 
#' @param survey_list A list of surveys imported with \code{\link{read_surveys}}
#' @param metadata A metadata table created by \code{metadata_create} and binded together for 
#' all surveys in \code{survey_list}.
#' @param old The column name in \code{metadata} that contains the old, not harmonized variable names.
#' @param new The column name in \code{metadata} that contains the new, harmonized variable names.
#' @param rowids Rename var labels of original vars \code{rowid} to simply \code{uniqid}?
#' @importFrom dplyr mutate left_join select inner_join
#' @importFrom tidyselect all_of
#' @importFrom rlang set_names
#' @importFrom assertthat assert_that
#' @importFrom glue glue
#' @family harmonization functions
#' @return The list of surveys with harmonized variable names.
#' @examples
#' examples_dir <- system.file("examples", package = "retroharmonize")
#' survey_list <- dir(examples_dir)[grepl("\\.rds", dir(examples_dir))]
#' 
#' example_surveys <- read_surveys(
#'   file.path( examples_dir, survey_list)
#'   )
#'   
#' metadata <- metadata_create(example_surveys)
#' metadata$var_name_suggested <- label_normalize(metadata$var_name)
#' metadata$var_name_suggested[metadata$label_orig == "age_education"] <- "age_education"
#' 
#' harmonize_var_names(survey_list = example_surveys, 
#'                     metadata    = metadata )
#' @export
#' @seealso crosswalk


harmonize_var_names <- function ( survey_list, 
                                  metadata,
                                  old = "var_name_orig",
                                  new = "var_name_suggested",
                                  rowids = TRUE ) {

  assert_that( all(c(new, old, "filename") %in% names(metadata)), 
               msg = glue::glue("'{old}', '{new}' and 'filename' must be column names in metadata.")
  )
  
  metadata <- metadata %>%
    select ( all_of(c(old, new, "filename"))) %>%
    set_names ( c("var_name_orig", "var_name_suggested", "filename") )
 
      
  rename_this_survey <- function (this_survey) {
    
    this_metadata <- metadata[attr(this_survey, "filename") == metadata$filename, ]
    
    if ( ! attr(this_survey, "filename") %in% metadata$filename ) {
      warning (glue::glue("The metadata of {attr(this_survey, 'filename')} cannot be found") )
    }
    
    renaming <- data.frame ( var_name_orig = names(this_survey) ) %>%
      inner_join ( this_metadata %>% 
                    select ( all_of (c("var_name_orig", "var_name_suggested"))), 
                  by = "var_name_orig")
    
    subset_this_survey <- this_survey %>%
      select ( all_of (renaming$var_name_orig) ) 
    
    rlang::set_names(subset_this_survey, 
                     nm = renaming$var_name_suggested)
     
  }

 lapply ( survey_list, rename_this_survey )

}