R/to_factor.R

In adayim/cctab: Tables of Descriptive Statistics in word

#' Replace vector/matrix/data.frame/list values with corresponding value labels.
#' 
#' \code{val2lab} replaces vector/matrix/data.frame/list values with
#' corresponding value labels. If there are no labels for some values they are
#' converted to characters in most cases. If there are no labels at all for
#' variable it remains unchanged. \code{v2l} is just shortcut to \code{val2lab}.
#' 
#' @param x vector/matrix/data.frame/list
#' @return Object of the same form as x but with value labels instead of values.
#'  
#' @seealso \link{val_lab}, \link{var_lab}
#' @examples
#' data(mtcars)
#' mtcars = within(mtcars,{
#'                 var_lab(mpg) = NULL
#'                 val_lab(am) = c(" automatic" = 0, " manual" =  1)
#' })
#' 
#' summary(lm(mpg ~ ., data = val2lab(mtcars[,c("mpg","am")])))
#' @export
val2lab <- function(x){
  UseMethod("val2lab")
}

#' @export
val2lab.default <- function(x){
  vallab = val_lab(x)
  if(is.null(vallab)) 
    return(x)
  res = names(vallab)[match(x,vallab,incomparables = NA)]
  res_na = is.na(res)
  if(any(res_na)) res[res_na] = x[res_na]
  var_lab(res) = var_lab(x)
  res
  
}

#' @export
val2lab.matrix <- function(x){
  res = val2lab.default(x)
  res = matrix(res, nrow = nrow(x), ncol = ncol(x))
  res
}

#' @export
val2lab.data.frame <- function(x){
  val2lab.list(x)
}


#' @export
val2lab.list <- function(x){
  for (each in seq_along(x)){
    x[[each]] = val2lab(x[[each]])
  }
  x
}

#' Convert vector to factor/character with corresponding value/value labels.
#' 
#' \code{to_factor} Convert vector to factor with corresponding value labels or
#' unique values in the vector. Note that the `NA` or blank values will be excluded.
#' It will return a factor with original values if there's no value label.
#' 
#' @param x vector
#' @param ordered logical flag to determine if the levels should be regarded as ordered.
#' @return Factor of the same form as x but with value labels instead of values.
#'  
#' @seealso \link{val_lab},  \link{var_lab}
#' @examples
#' data(mtcars)
#' mtcars = within(mtcars,{
#'                 var_lab(am) = "Transmission"
#'                 val_lab(am) = c(" automatic" = 0, " manual" =  1)
#' })
#' 
#' mtcars$am <- to_factor(mtcars$am)
#' mtcars$gear <- to_character(mtcars$gear)
#' @export
to_factor <- function(x, ordered = TRUE){
  
  if(!is.null(val_lab(x))){
    vallab <- val_lab(x)
  }else{
    vallab <- sort(unique(na.omit(x[trimws(x)!=""])))
    names(vallab) <- vallab
  }

  res <- factor(unlab(x), 
                levels = vallab, 
                labels = names(vallab),
                ordered = ordered)

  var_lab(res) = var_lab(x)
  res
}

#' @describeIn to_factor Convert vector to character with corresponding unique 
#' values in the vector as value labels and keep the variable labels. Note that 
#' the `NA` or blank values will be excluded. It will return a character with
#'  original values as value labels if there's no value label.
#' @export
to_character <- function(x){
  
  if(!is.null(val_lab(x))){
    vallab <- val_lab(x)
  }else{
    vallab <- sort(unique(na.omit(x[trimws(x)!=""])))
    names(vallab) <- vallab
  }
  res <- as.character(x)
  val_lab(res) <- vallab
  var_lab(res) <- var_lab(x)
  res
}

#' @describeIn to_factor Convert vector to numeric and keep the variable labels.
#' @export
to_numeric <- function(x){
  res <- as.numeric(x)
  var_lab(res) <- var_lab(x)
  res
}