R/get_level_labels.R

In kkmann/CENTERTBI: CENTER-TBI Utility Functions

#' Apply factor level labels
#'
#' @param df centertbi data frame with corresponding metadata (as returned by download())
#' @param label attribute field for the labels to use
#' @param dict the .xlsx dictionary file to use
#'
#' @value tiblle with all factors being relabeled according to the dictionary
#'
#' @export
get_level_labels <- function(df, label = "`label:en`",
                             dict = readxl::read_xlsx(
  system.file("CENTER-TBI_versionCurrent-dictionary.xlsx", package = "centertbi"),
  guess_max = 10^4, sheet = 2
)) {

  fct_colnames <- df %>% select_if(is.factor) %>% names

  if (length(fct_colnames) == 0) return(df)

  for (i in 1:length(fct_colnames)) {

    if (!(fct_colnames[i] %in% dict$variable)) {

      warning(sprintf("no label information on %s in dictionary!", fct_colnames[i]))

    } else {

      tmp <- dict %>%
        filter(variable == fct_colnames[i]) %>%
        select_("name", label)

      suppressWarnings( # forcats recode is too verbose
        df[[fct_colnames[i]]] <- do.call(
          forcats::fct_recode,
          c( list(df[[fct_colnames[i]]]), setNames(as.list(tmp[[1]]), tmp[[2]]))
        )
      )

    }

  }

  return(df)

}