R/drop_unused_value_labels.R

In larmarange/labelled: Manipulating Labelled Data

#' Drop unused value labels
#'
#' Drop value labels associated to a value not present in the data.
#'
#' @param x A vector, a data frame or a survey design.
#' @examples
#' x <- labelled(c(1, 2, 2, 1), c(yes = 1, no = 2, maybe = 3))
#' x
#' drop_unused_value_labels(x)
#' @export
drop_unused_value_labels <- function(x) {
  UseMethod("drop_unused_value_labels")
}


#' @export
drop_unused_value_labels.default <- function(x) {
  # do nothing
  x
}

#' @export
drop_unused_value_labels.haven_labelled <- function(x) {
  vl <- val_labels(x)
  val_labels(x) <- vl[vl %in% unique(x)]
  x
}


#' @export
drop_unused_value_labels.data.frame <- function(x) {
  x[] <- lapply(x, drop_unused_value_labels)
  x
}

#' @export
drop_unused_value_labels.survey.design <- function(x) {
  x$variables <- drop_unused_value_labels(x$variables)
  x
}

#' @export
drop_unused_value_labels.svyrep.design <- drop_unused_value_labels.survey.design