R/tt_fix.R

In mgunther87/ipumsPMA: Common functions for IPUMS PMA staff

#' @title Find and replace metadata in an existing translation table
#' 
#' @description Use "find" arguments to identify a string of text to be 
#' overwritten with "replace" arguments in a variable name, label, output 
#' codes, output labels, universe statements, or manual recode fields. If 
#' "replace" arguments are provided without corresponding "find" arguments, 
#' the full text of each value will be replaced (except for output codes and 
#' output labels, which cannot be disambiguated automatically).
#' 
#' @param path_or_variable Character: Either a full path to a translation 
#' table or the variable name associated with a translation table currently 
#' in the PMA variables folder
#' @param name_find Optional character: a string in the existing variable name 
#' @param name_replace Optional character: a string to replace name_find. If 
#' name_find is not provided, name_replace will replace the entire variable 
#' name. The new file will be renamed accordingly.
#' @param label_find Optional character: a string in the existing variable label
#' @param label_replace Optional character: a string to replace label_find.  
#' If label_find is not provided, label_replace will replace the entire variable 
#' label.
#' @param output_find Optional character: a string in the existing output codes 
#' or output labels
#' @param output_replace Optional character: a string to replace output_find. 
#' If no output_find is provided, no replacement will be made. If an 
#' output code is changed, the all rows in the tt block will be re-sorted 
#' in ascending order with the new output code included.
#' @param univ_find Optional character: a string in the existing block of 
#' universe statements
#' @param univ_replace Optional character: a string to replace univ_find. If 
#' no univ_find to provided, all samples in the universe block will be 
#' assigned the same universe statement in univ_replace.
#' @param manual_recode Optional character: a string to replace the 
#' manual recode value for all samples (usually "2", "1", or empty "")
#' @param write Logical: Defaults TRUE. If FALSE, the translation table will 
#' be returned as a tibble and not written.
#' 
#' @author Matt Gunther
#' 
#' @export tt_fix
tt_fix <- function(
  path_or_variable,
  name_find,
  name_replace,
  label_find,
  label_replace,
  output_find,
  output_replace,
  univ_find,
  univ_replace,
  manual_recode, 
  write = T
){
  # load tt ----
  tt <- py$TranslationTable(path_or_variable, "pma")$ws %>% tibble
  names(tt) <- tolower(names(tt))
  
  # name change ----
  if(!missing(name_replace)){
    if(!missing(name_find)){
      tt$label[1] <- gsub(
        pattern = name_find,
        replacement = toupper(name_replace),
        x = tt$label[1], 
        ignore.case = T
      )
    } else {
      tt$label[1] <- toupper(name_replace)
    }
  }
  
  # label change ----
  if(!missing(label_replace)){
    if(!missing(label_find)){
      tt$label[2] <- gsub(
        pattern = label_find,
        replacement = label_replace,
        x = tt$label[2]
      )
    } else {
      tt$label[2] <- label_replace
    }
  }
  
  # output change ----
  if(!missing(output_replace)){
    if(!missing(output_find)){
      tt_block <- 12:{which(tt$code == "</tt>")-1}
      tt$code[tt_block] <- gsub(
        pattern = output_find,
        replacement = output_replace,
        x = tt$code[tt_block]
      )
      tt$label[tt_block] <- gsub(
        pattern = output_find,
        replacement = output_replace,
        x = tt$label[tt_block]
      )
      tt[tt_block,] <- tt %>% 
        slice(tt_block) %>% 
        mutate(code = as.numeric(code)) %>% 
        arrange(code) %>% 
        mutate(code = as.character(code))
    }
  }
  
  # univ change ----
  if(!missing(univ_replace)){
    if(!missing(univ_find)){
      univ_block <- {which(tt$code == "<univ>") + 1}:{nrow(tt)-1}
      tt$syntax[univ_block] <- gsub(
        pattern = univ_find,
        replacement = univ_replace,
        x = tt$syntax[univ_block]
      )
    }
  }
  
  # manual recode change ----
  if(!missing(manual_recode)){
    tt[, 7:ncol(tt)] <- map_df(tt %>% select(!1:6), ~{
      .x[3] <- manual_recode
      .x
    })
  }
  
  # write xls ----
  if(write == F){
    return(tt)
  } else {
    tt_to_xls(tt)
  }
}