R/switch_labels.R

In kkmann/CENTERTBI: CENTER-TBI Utility Functions

#' Switch 'labels' and column names in a data frame
#'
#' @param df the data.frame (or tibble) to process
#' @param remove_prefix number of characters to skip from label at the beginning (4 removes standard (en) prefix)
#'
#' @return \code{df} where each column is renamed to its attribute 'label';
#'   previous column name is stored as attribute 'label'.
#'
#' @details If a column does not have a 'label' attribute, it is skipped.
#'   If labels are not unique, subsequent columns are ignored and a warning is issued.
#'
#' @export
switch_labels <- function(df, remove_prefix = 0) {

  colnames <- names(df)

  safely_get_label <- function(x) {
    tryCatch(attr(x, "label"), error = function(e) {NULL})
  }
  labels   <- as.character(sapply(df, safely_get_label))

  # save old variable names
  for (i in 1:ncol(df)) {
    colname <- names(df)[i]
    label   <- safely_get_label(df[[i]])
    if (!is.null(label)) {
      if (remove_prefix > 0) {
        label <- tryCatch(
          substr(label, remove_prefix + 1, nchar(label)), # start value is +1
          error = function(e) {label}
        )
      }
      if (label %in% names(df[1:i])) {
        warning(sprintf("label %s in column %s is not unique, skipping", label, colname))
        next
      }
      attr(df[[i]], "label") <- colname
      names(df)[i] <- label
    }
  }
  return(df)

} # switch_labels