tests/testthat/test-labelled.r

In labelled: Manipulating Labelled Data

context("Labelled")

# var_label --------------------------------------------------------------

test_that("var_label works properly", {
  x <- 1:3
  var_label(x) <- "value"
  expect_equal(attr(x, "label"), "value")
  expect_equal(var_label(x), "value")
  var_label(x) <- NULL
  expect_null(attr(x, "label"))
  expect_null(var_label(x))

  x <- 1:3
  x <- set_variable_labels(x, "value")
  expect_equal(attr(x, "label"), "value")
  x <- set_variable_labels(x, .labels = "other value")
  expect_equal(attr(x, "label"), "other value")
  x <- set_variable_labels(x, NULL)
  expect_null(attr(x, "label"))
})

test_that("var_label works on data.frame", {
  df <- data.frame(x = 1:3, y = c("a", "b", "c"), stringsAsFactors = FALSE)
  var_label(df$x) <- "var x"
  expect_equal(var_label(df$x), "var x")
  expect_equal(var_label(df), list(x = "var x", y = NULL))
  var_label(df) <- list(y = "YY", x = "XX")
  expect_equal(var_label(df), list(x = "XX", y = "YY"))
  var_label(df) <- NULL
  expect_equal(var_label(df), list(x = NULL, y = NULL))
  var_label(df) <- c("var1", "var2")
  expect_equal(var_label(df), list(x = "var1", y = "var2"))
  df <- set_variable_labels(df, x = "XX", .labels = "other")
  expect_equal(var_label(df), list(x = "XX", y = "other"))
  df <- set_variable_labels(df, .labels = c("var1", "var2"))
  expect_equal(var_label(df), list(x = "var1", y = "var2"))
})


test_that("var_label produce appropriate errors", {
  df <- data.frame(x = 1:3, y = c("a", "b", "c"), stringsAsFactors = FALSE)
  expect_error(var_label(df) <- c("var1", "var2", "var3"))
  expect_error(var_label(df) <- list(x = "xx", z = "zz"))
  expect_error(
    df %>%
      set_variable_labels(.labels = list(x = "xx", z = "zz"))
  )
  expect_error(
    df %>%
      set_variable_labels(x = "ghj", z = "ggg")
  )
  # no error if .strict = FALSE
  expect_error(
    df %>%
      set_variable_labels(.labels = list(x = "xx", z = "zz"), .strict = FALSE),
    NA
  )
  expect_error(
    df %>%
      set_variable_labels(x = "ghj", z = "ggg", .strict = FALSE),
    NA
  )
})

test_that("var_label preserved data.frame type", {
  tb <- dplyr::tibble(x = 1:3, y = c("a", "b", "c"))
  before <- class(tb)
  var_label(tb$x) <- "var x"
  var_label(tb) <- list(y = "YY", x = "XX")
  after <- class(tb)
  expect_equal(before, after)
})

# labelled --------------------------------------------------------------

test_that("labelled return an object of class haven_labelled", {
  x <- labelled(c(1, 2, 3), c(yes = 1, maybe = 2, no = 3))
  expect_true(is.labelled(x))
  expect_s3_class(x, "haven_labelled")
})

test_that("x must be numeric or character", {
  expect_error(labelled(TRUE))
})

test_that("x and labels must be compatible", {
  expect_error(labelled(1, "a"))
  expect_error(labelled(1, c(female = 2L, male = 1L)), NA)
  expect_error(labelled(1L, c(female = 2, male = 1)), NA)
})

test_that("labels must have names", {
  expect_error(labelled(1, 1))
})


# val_labels and val_label ------------------------------------------------

test_that("val_labels preserves variable label", {
  x <- 1:3
  var_label(x) <- "test"
  val_labels(x) <- c(yes = 1, no = 2)
  expect_equal(attr(x, "label", exact = TRUE), "test")

  val_labels(x) <- NULL
  expect_equal(attr(x, "label", exact = TRUE), "test")
})

test_that("val_label preserves variable label", {
  x <- 1:3
  var_label(x) <- "test"
  val_label(x, 1) <- "yes"
  expect_equal(attr(x, "label", exact = TRUE), "test")

  val_label(x, 1) <- NULL
  expect_equal(attr(x, "label", exact = TRUE), "test")
})

test_that("val_labels and val_label preserves spss missing values", {
  x <- labelled_spss(
    1:10,
    c(Good = 1, Bad = 8),
    na_values = c(9, 10),
    na_range = c(11, Inf)
  )
  val_labels(x) <- c(yes = 1, no = 3)
  val_label(x, 2) <- "maybe"
  expect_true(inherits(x, "haven_labelled"))
  expect_true(inherits(x, "haven_labelled_spss"))
  expect_equal(attr(x, "na_values"), c(9, 10))
  expect_equal(attr(x, "na_range"), c(11, Inf))

  val_label(x, 2) <- "maybe"
  expect_true(inherits(x, "haven_labelled"))
  expect_true(inherits(x, "haven_labelled_spss"))
  expect_equal(attr(x, "na_values"), c(9, 10))
  expect_equal(attr(x, "na_range"), c(11, Inf))

  expect_equal(attr(x, "labels", exact = TRUE), c(yes = 1, no = 3, maybe = 2))
})

test_that("value labels can be removed if missing values are defined", {
  x <- labelled_spss(1:10, c(Good = 1, Bad = 8), na_values = c(9, 10))
  val_labels(x) <- NULL
  expect_null(val_labels(x))

  x <- labelled_spss(1:10, c(Good = 1), na_range = c(9, 20))
  val_labels(x) <- NULL
  expect_null(val_labels(x))
})

test_that("value labels to NULL remove class if na_Values et na_range are NULL", { # nolint
  x <- labelled_spss(1:10, c(Good = 1, Bad = 8))
  val_labels(x) <- NULL
  expect_null(val_labels(x))
  expect_equal(match("labelled", names(attributes(x)), nomatch = 0), 0)
})

test_that("error with non character argument", {
  x <- 1
  expect_error(var_label(x) <- 1)
})

test_that("error with mutilple character argument", {
  x <- 1
  expect_error(var_label(x) <- c("a", "b"))
})

test_that("test if unlist argument works properly", {
  df <- data.frame(col1 = 1:2, col2 = 3:4, stringsAsFactors = FALSE)
  expect_equal(var_label(df, unlist = TRUE), c(col1 = "", col2 = ""))

  var_label(df) <- c("lb1", "lb2")
  expect_equal(var_label(df, unlist = TRUE), c(col1 = "lb1", col2 = "lb2"))
})


test_that("val_labels prefixed argument 100%", {
  v <- labelled(
    c(1, 2, 2, 2, 3, 9, 1, 3, 2, NA),
    c(yes = 1, no = 3, "don't know" = 9)
  )
  vlv <- val_labels(v)
  vlvp <- val_labels(v, prefixed = TRUE)

  noms_vlvp <- names(vlvp)
  pos <- regexpr("] ", noms_vlvp)
  noms_vlvp <- substring(noms_vlvp, pos + 2)
  names(vlvp) <- noms_vlvp
  expect_equal(vlv, vlvp)
})

test_that("val_labels works for dataframe", {
  v <- labelled(
    c(1, 2, 2, 2, 3, 9, 1, 3, 2, NA),
    c(yes = 1, no = 3, "don't know" = 9)
  )
  y <- 1:10
  df <- data.frame(v = v, y = y, stringsAsFactors = FALSE)
  res <- list(v = val_labels(v), y = NULL)
  expect_equal(val_labels(df), res)
})

test_that(" 'val_labels <-'  works for dataframe", {
  xhs <- labelled_spss(
    c(1:3, NA, 5:10),
    c(Good = 1, Bad = 8),
    na_values = c(9, 10),
    na_range = c(11, Inf)
  )
  num <- 1:10
  ch <- letters[1:10]
  fac <- factor(paste0("f", 1:10))
  df <- data.frame(
    xhs = xhs, num = num, ch = ch, fac = fac,
    stringsAsFactors = FALSE
  )

  expect_error(val_labels(df) <- c(one = 1))

  valeurs <- list(
    xhs = c(two = 2, five = 5),
    ch = c(leter_a = "a"),
    num = c(two = 2),
    fac = c(three = factor(2))
  )
  vldf <- df
  expect_error(val_labels(vldf) <- valeurs)

  valeurs <- list(
    xhs = c(two = 2, five = 5),
    ch = c(leter_a = "a"),
    num = c(two = 2)
  )
  vldf <- df
  expect_error(val_labels(vldf) <- valeurs, NA)

  expect_null(val_labels(vldf)$fac)
  expect_equal(df$fac, vldf$fac)
  noms <- c("xhs", "num", "ch")
  expect_equal(val_labels(vldf)[noms], valeurs[noms])

  val_labels(df) <- NULL
  expect_true(all(sapply(val_labels(df), is.null)))
})

test_that("val_label works for haven_labelled", {
  v <- labelled(
    c(1, 2, 2, 2, 3, 9, 1, 3, 2, NA),
    c(yes = 1, no = 3, "don't know" = 9)
  )
  expect_equal(val_label(v, 2), NULL)
  expect_equal(val_label(v, 1), "yes")
  expect_equal(val_label(v, 1, prefixed = TRUE), "[1] yes")
  expect_error(val_label(v, 1:2))
})

test_that("val_label works for default", {
  num <- 1:3
  ch <- letters[1:3]
  expect_equal(val_label(num, 2), NULL)
  expect_error(val_lable(num, 1:2))
  expect_equal(val_label(ch, 1, prefixed = TRUE), NULL)
  expect_error(val_label(ch, 1:2))
})

test_that("val_label works for for dataframe", {
  xhs <- labelled_spss(
    c(1:3, NA, 5:10),
    c(Good = 1, Bad = 8),
    na_values = c(9, 10),
    na_range = c(11, Inf)
  )
  xh <- labelled(
    c(1, 2, 2, 2, 3, 9, 1, 3, 2, NA),
    c(yes = 1, no = 3, "don't know" = 9)
  )
  num <- 1:10
  df <- data.frame(xhs = xhs, num = num, xh = xh, stringsAsFactors = FALSE)


  expect_true(all(sapply(val_label(df, 2), is.null)))
  expect_equal(
    val_label(df, 1),
    list(xhs = "Good", num = NULL, xh = "yes")
  )
  expect_equal(
    val_label(df, 3, prefixed = TRUE),
    list(xhs = NULL, num = NULL, xh = "[3] no")
  )
  expect_error(val_lable(df, 1:2))
})

test_that(" 'val_label<-' works properly", {
  xhs <- labelled_spss(
    c(1:3, NA, 5:10),
    c(Good = 1, Bad = 8),
    na_values = c(9, 10),
    na_range = c(11, Inf)
  )
  xh <- labelled(
    c(1, 2, 2, 2, 3, 9, 1, 3, 2, NA),
    c(yes = 1, no = 3, "don't know" = 9)
  )
  num <- 1:10
  ch <- letters[1:10]

  expect_error(val_label(num, "a") <- "a")

  expect_error(val_label(xh, 12) <- c("one", "two"))
  expect_error(val_label(xhs, c(12, 13)) <- "twenty_two")

  df <- data.frame(
    xhs = xhs,
    num = num,
    xh = xh,
    ch = ch,
    stringsAsFactors = FALSE
  )
  expect_error(val_label(df, 2) <- 2)
  expect_error(val_label(df, 2) <- two)
  expect_error(val_label(df, 2) <- c("a", "b"))
  expect_error(val_label(df, 2:3) <- "a")

  sub_df <- df[, -match("ch", names(df))]
})

test_that(" 'val_label<-.data.frame' works properly", {
  xhs <- labelled_spss(
    c(1:3, NA, 5:10),
    c(Good = 1, Bad = 8),
    na_values = c(9, 10),
    na_range = c(11, Inf)
  )
  num <- 1:10
  ch <- letters[1:10]
  df <- data.frame(xhs = xhs, num = num, ch = ch, stringsAsFactors = FALSE)

  valeurs <- list(xhs = "2", ch = "letter_a", num = "two")


  df_c <- df
  expect_error(val_label(df_c, 2) <- valeurs)
  expect_error(val_label(df_c, "a") <- valeurs)

  val_label(df_c, 2) <- valeurs[-2]
  val_label(df_c, "a") <- valeurs[2]
  res_labels <- list(
    xhs = c(Good = 1, Bad = 8, "2" = 2),
    num = c(two = 2),
    ch = c(letter_a = "a")
  )
  expect_equal(val_labels(df_c), res_labels)
})

# remove_labels --------------------------------------------------------------

test_that("remove_label works correctly", {
  x <- c(1, 2, 2, 9)
  na_values(x) <- 9
  val_labels(x) <- c(yes = 1, no = 2)
  var_label(x) <- "A test variable"

  expect_false(inherits(remove_labels(x), "haven_labelled"))
  expect_null(var_label(remove_labels(x)))
  expect_equal(
    var_label(remove_labels(x, keep_var_label = TRUE)),
    var_label(x)
  )
})


test_that("remove_labels strips labelled attributes", {
  var <- labelled(c(1L, 98L, 99L), c(not_answered = 98L, not_applicable = 99L))
  exp <- c(1L, 98L, 99L)
  expect_equal(remove_labels(var), exp)
})

test_that("remove_labels returns variables not of class('labelled') unmodified", { #nolint
  var <- c(1L, 98L, 99L)
  expect_equal(remove_labels(var), var)
})

test_that("remove_labels works with data.frame", {
  var <- labelled(c(1L, 98L, 99L), c(not_answered = 98L, not_applicable = 99L))
  exp <- c(1L, 98L, 99L)
  df <- data.frame(var = var, exp = exp, stringsAsFactors = FALSE)
  rmdf <- remove_labels(df)
  expect_equal(rmdf$exp, exp)
  expect_equal(rmdf$var, exp)
})


test_that("remove_labels works with labelled_spss", {
  xhs <- haven::labelled_spss(
    c(1, 2, 3, NA, 99),
    c(t1 = 1, t2 = 2, Missing = 99),
    na_value = 99,
    na_range = c(99, Inf),
    label = "A test variable"
  )
  expect_null(var_label(remove_labels(xhs)))
  expect_false(identical(var_label(remove_labels(xhs)), var_label(xhs)))
  expect_null(val_labels(remove_labels(xhs)))
})

# remove_val_labels ------------------------------------------------------------


test_that("remove_labels works properly", {
  var <- labelled(
    c(1L, 98L, 99L),
    c(not_answered = 98L, not_applicable = 99L),
    label = "A variable label"
  )
  exp <- c(1L, 98L, 99L)
  df <- data.frame(var = var, exp = exp, stringsAsFactors = FALSE)
  rmdf <- remove_val_labels(df)
  expect_null(val_labels(rmdf$var))
  expect_false(identical(rmdf$var, exp))
  expect_equal(rmdf$exp, exp)
})

# remove_var_label ------------------------------------------------------------


test_that("remove_labels works properly", {
  var <- labelled(
    c(1L, 98L, 99L),
    c(not_answered = 98L, not_applicable = 99L),
    label = "A variable label"
  )
  exp <- c(1L, 98L, 99L)
  df <- data.frame(var = var, exp = exp, stringsAsFactors = FALSE)
  rmdf <- remove_var_label(df)
  expect_null(var_label(rmdf$var))
  expect_false(identical(rmdf$var, exp))
  expect_equal(val_labels(rmdf$var), val_labels(var))
  expect_equal(rmdf$exp, exp)
})


# sort_val_labels ---------------------------------------------------------

test_that("sort_val_labels works properly", {
  df <- data.frame(
    lab = labelled(c(1, 2, 3), c(maybe = 2, yes = 1, no = 3)), num = c(3, 1, 2),
    stringsAsFactors = FALSE
  )
  sdf <- sort_val_labels(df)
  expect_equal(
    val_labels(sdf),
    list(lab = c(yes = 1, maybe = 2, no = 3), num = NULL)
  )
  sdf <- sort_val_labels(df, decreasing = TRUE)
  expect_equal(
    val_labels(sdf),
    list(lab = c(no = 3, maybe = 2, yes = 1), num = NULL)
  )
  sdf <- sort_val_labels(df, "l")
  expect_equal(
    val_labels(sdf),
    list(lab = c(maybe = 2, no = 3, yes = 1), num = NULL)
  )
  sdf <- sort_val_labels(df, "l", TRUE)
  expect_equal(
    val_labels(sdf),
    list(lab = c(yes = 1, no = 3, maybe = 2), num = NULL)
  )

  x <- c(2, tagged_na("z"), 1, tagged_na("a"))
  val_labels(x) <-
    c(no = 2, refused = tagged_na("z"), yes = 1, dk = tagged_na("a"))
  expect_equivalent(
    sort_val_labels(x, according_to = "v") %>%
      val_labels() %>%
      format_tagged_na() %>%
      trimws(),
    c("1", "2", "NA(a)", "NA(z)")
  )
  expect_equivalent(
    sort_val_labels(x, according_to = "l") %>% val_labels() %>% names(),
    c("dk", "no", "refused", "yes")
  )
})

# remove_user_na --------------------------------------------------------------


test_that("remove_user_na works properly", {
  var <- labelled(
    c(1L, 2L, NA, 98L, 99L),
    c(not_answered = 98L, not_applicable = 99L),
    label = "A variable label"
  )
  exp <- c(1L, 2L, NA, 98L, 99L)
  xhs <- haven::labelled_spss(
    c(1, 2, NA, 98, 99),
    c(t1 = 1, t2 = 2, Missing = 99),
    na_value = 99,
    na_range = c(99, Inf),
    label = "A test variable"
  )
  df <- data.frame(var = var, exp = exp, xhs = xhs, stringsAsFactors = FALSE)
  rmtdf <- remove_user_na(df, user_na_to_na = TRUE)
  expect_equal(rmtdf$var, var)
  expect_equal(rmtdf$exp, exp)
  expect_null(na_values(rmtdf$xhs))
  expect_equal(rmtdf$exp, exp)

  rmfdf <- remove_user_na(df, user_na_to_na = FALSE)
  expect_false(is.null(var_label(rmfdf$var)))

  rmfdf <- remove_user_na(df, user_na_to_tagged_na = TRUE)
  expect_equal(
    na_tag(rmfdf$xhs),
    c(NA, NA, NA, NA, "a")
  )

  x <- labelled_spss(1:100, na_range = c(50, 100))
  expect_warning(remove_user_na(x, user_na_to_tagged_na = TRUE))
})

# to_factor --------------------------------------------------------------------

test_that("to_factor preserves variable label", {
  x <- labelled(c(1, 1, 2), c(yes = 1, no = 2))
  var_label(x) <- "yes/no"
  expect_equal(var_label(to_factor(x)), var_label(x))
})

test_that("strict option of to_factor works correctly", {
  v <- labelled(c(1, 1, 2, 3), labels = c(No = 1, Yes = 2))
  expect_s3_class(to_factor(v, strict = FALSE), "factor")
  expect_s3_class(to_factor(v, strict = TRUE), "haven_labelled")
  expect_equal(class(to_factor(v, strict = TRUE, unclass = TRUE)), "numeric")
})

test_that("to_factor works on data.frame", {
  df <- data.frame(
    x = labelled(c(1, 1, 2), c(yes = 1, no = 2)),
    y = c("a", "a", "b"),
    z = 1:3,
    stringsAsFactors = FALSE
  )

  df2 <- to_factor(df)

  expect_true(is.factor(df2$x))
  expect_equal(class(df2$y), class(df$y))
  expect_equal(class(df2$z), class(df$z))

  df3 <- to_factor(df, labelled_only = FALSE)
  expect_true(is.factor(df3$y))
  expect_true(is.factor(df3$z))
})

test_that("to_factor does not change a factor", {
  x <- factor(1:2)
  expect_equal(to_factor(x), x)
})

test_that("to_factor keeps labels", {
  x <- 1:2
  lab_name <- "vector"
  var_label(x) <- lab_name
  expect_equal(var_label(to_factor(x)), lab_name)
})

test_that("to_factor boolean parameters", {
  x1 <- haven::labelled_spss(
    c(1, 2, 3, 5, 4, NA, 99),
    c(t1 = 1, t2 = 2, t5 = 5, Missing = 99),
    na_value = 99
  )

  tfx <- to_factor(x1, user_na_to_na = TRUE)
  expect_equal(which(is.na(tfx)), 6:7)
  expect_equal(levels(tfx), c("t1", "t2", "3", "4", "t5"))


  tfx <- to_factor(x1, nolabel_to_na = TRUE)
  expect_equal(which(is.na(tfx)), c(3, 5, 6))
  expect_equal(levels(tfx), c("t1", "t2", "t5", "Missing"))

  tfx <- to_factor(x1[1:3], drop_unused_labels = FALSE)
  expect_equal(levels(tfx), c("t1", "t2", "3", "t5", "Missing"))

  tfx <- to_factor(x1[1:3], drop_unused_labels = TRUE)
  expect_equal(levels(tfx), c("t1", "t2", "3"))
})

test_that("to_factor parameters : sort_levels + levels", {
  x1 <- haven::labelled_spss(
    c(1, 2, 3, 5, 4, NA, 99),
    c(t1 = 1, t2 = 2, t5 = 5, Missing = 99),
    na_value = 99
  )

  tfx <- to_factor(x1, sort_levels = "auto")
  expect_equal(levels(tfx), c("t1", "t2", "3", "4", "t5", "Missing"))

  tfx <- to_factor(x1, sort_levels = "none")
  expect_equal(levels(tfx), c("t1", "t2", "t5", "Missing", "3", "4"))

  tfx <- to_factor(x1, sort_levels = "labels")
  expect_equal(levels(tfx), c("3", "4", "Missing", "t1", "t2", "t5"))

  tfx <- to_factor(x1, sort_levels = "values")
  expect_equal(levels(tfx), c("t1", "t2", "3", "4", "t5", "Missing"))

  tfx <- to_factor(x1, levels = "labels")
  expect_equal(levels(tfx), c("t1", "t2", "3", "4", "t5", "Missing"))

  tfx <- to_factor(x1, levels = "values")
  expect_equal(levels(tfx), c("1", "2", "3", "4", "5", "99"))

  tfx <- to_factor(x1, levels = "prefixed")
  expect_equal(
    levels(tfx),
    c("[1] t1", "[2] t2", "[3] 3", "[4] 4", "[5] t5", "[99] Missing")
  )
})

test_that("to_factor() and tagged NAs", {
  x <- c(1, 2, tagged_na("a"), 1, tagged_na("z"), 2, tagged_na("a"), NA)
  val_labels(x) <- c(
    yes = 1, no = 2,
    missing = tagged_na("a"),
    toto = NA
  )

  expect_equal(
    to_factor(x),
    structure(c(1L, 2L, NA, 1L, NA, 2L, NA, NA),
              .Label = c("yes", "no"), class = "factor")
  )
  expect_equal(
    to_factor(x, explicit_tagged_na = TRUE),
    structure(c(1L, 2L, 4L, 1L, 5L, 2L, 4L, 3L),
              .Label = c("yes", "no", "toto", "missing", "NA(z)"),
              class = "factor")
  )
})

# to_character -----------------------------------------------------------------

test_that("to_character produce an appropriate character vector", {
  x <- labelled(c(1, 1, 2), c(yes = 1, no = 2))
  expect_equal(class(to_character(x)), "character")
  expect_equal(to_character(x), c("yes", "yes", "no"))
})


test_that("to_character preserves variable label", {
  x <- labelled(c(1, 1, 2), c(yes = 1, no = 2))
  var_label(x) <- "yes/no"
  expect_equal(var_label(to_character(x)), var_label(x))
})

test_that("to_character produce an appropriate character vector", {
  x <- labelled(c(1, 1, 2), c(yes = 1, no = 2))
  expect_equal(class(to_character(x)), "character")
  expect_equal(to_character(x), c("yes", "yes", "no"))
})

test_that("to_character default (100%)", {
  x <- 1:3
  expect_equal(class(to_character(x)), "character")
  expect_equal(to_character(x), as.character(x))
})

test_that("to_character.double and explicit_tagged_na", {
  x <- c(1:3, tagged_na("a"), tagged_na("z"))
  expect_equal(
    to_character(x),
    c("1", "2", "3", NA, NA)
  )
  expect_equal(
    to_character(x, explicit_tagged_na = TRUE),
    c("1", "2", "3", "NA(a)", "NA(z)")
  )
})

# set_value_labels and add_value_labels ---------------------------------------

test_that("set_value_labels replaces all value labels", {
  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  df <- set_value_labels(
    df,
    s1 = c(Male = "M", Female = "F"),
    s2 = c(Yes = 1, No = 2)
  )
  expect_equal(val_labels(df$s1), c(Male = "M", Female = "F"))
  expect_equal(val_labels(df$s2), c(Yes = 1, No = 2))
  df <- set_value_labels(df, s2 = c(Yes = 1, Unknown = 9))
  expect_equal(val_labels(df$s2), c(Yes = 1, Unknown = 9))

  v <- set_value_labels(1:10, c(low = 1, high = 10))
  expect_equal(val_labels(v), c(low = 1, high = 10))
  v <- set_value_labels(1:10, low = 1, high = 10)
  expect_equal(val_labels(v), c(low = 1, high = 10))
  v <- set_value_labels(1:10, .labels = c(low = 1, high = 10))
  expect_equal(val_labels(v), c(low = 1, high = 10))
  v <- set_value_labels(v, NULL)
  expect_null(val_labels(v))
})

test_that("set_value_labels errors", {
  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  expect_error(
    df %>%
      set_value_labels(
        s1 = c(Male = "M", Female = "F"),
        s3 = c(Yes = 1, No = 2)
      )
  )
  expect_error(
    df %>%
      set_value_labels(
        .labels = list(
          s1 = c(Male = "M", Female = "F"),
          s3 = c(Yes = 1, No = 2)
        )
      )
  )
  # no error if .strict = FALSE
  expect_error(
    df %>%
      set_value_labels(
        s1 = c(Male = "M", Female = "F"),
        s3 = c(Yes = 1, No = 2),
        .strict = FALSE
      ),
    NA
  )
  expect_error(
    df %>%
      set_value_labels(
        .labels = list(
          s1 = c(Male = "M", Female = "F"),
          s3 = c(Yes = 1, No = 2)
        ),
        .strict = FALSE
      ),
    NA
  )
})

test_that("add_value_labels errors", {
  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  expect_error(
    df %>%
      add_value_labels(
        s1 = c(Male = "M", Female = "F"),
        s3 = c(Yes = 1, No = 2)
      )
  )
  expect_error(
    df %>%
      add_value_labels(
        .labels = list(
          s1 = c(Male = "M", Female = "F"),
          s3 = c(Yes = 1, No = 2)
        )
      )
  )
  # no error if .strict = FALSE
  expect_error(
    df %>%
      add_value_labels(
        s1 = c(Male = "M", Female = "F"),
        s3 = c(Yes = 1, No = 2),
        .strict = FALSE
      ),
    NA
  )
  expect_error(
    df %>%
      add_value_labels(
        .labels = list(
          s1 = c(Male = "M", Female = "F"),
          s3 = c(Yes = 1, No = 2)
        ),
        .strict = FALSE
      ),
    NA
  )

  expect_error(add_value_labels(df, s1 = c("F", Male = "M")))
})

test_that("add_value_labels and remove_value_labels updates the list of value labels", { # nolint
  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  df <- set_value_labels(
    df,
    s1 = c(Male = "M", Female = "F"),
    s2 = c(Yesss = 1, No = 2)
  )
  df <- add_value_labels(df, s2 = c(Yes = 1, Unknown = 9))
  expect_equal(val_labels(df$s2), c(Yes = 1, No = 2, Unknown = 9))
  df <- remove_value_labels(df, s2 = 9)
  expect_equal(val_labels(df$s2), c(Yes = 1, No = 2))

  expect_error(remove_value_labels(df, 9))

  v <- set_value_labels(1:10, low = 1, high = 10)
  v <- add_value_labels(v, middle = 5)
  v <- remove_value_labels(v, 10)
  expect_equal(val_labels(v), c(low = 1, middle = 5))
})

# set_variable_labels  --------------------------------------------------------

test_that("set_variable_labels updates variable labels", {
  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  df <- set_variable_labels(df, s1 = "Sex", s2 = "Question")
  expect_equal(var_label(df$s1), "Sex")
  df <- set_variable_labels(df, s2 = NULL)
  expect_null(var_label(df$s2))
})

# missing values --------------------------------------------------------------

test_that("it is possible to define missing values if no value labels were defined", {# nolint
  x <- c(1, 2, 2, 9)
  na_values(x) <- 9
  expect_equal(na_values(x), 9)

  x <- c(1, 2, 2, 9)
  na_range(x) <- 9:10
  expect_equal(na_range(x), 9:10)
})

test_that("na_values and na_range keep variable label", {
  vl <- "variable label"
  x <- 1:9
  var_label(x) <- vl
  na_values(x) <- 8
  na_range(x) <- c(9, Inf)
  expect_equal(var_label(x), vl)
})

# recode (dplyr) ---------------------------------------------------------------
test_that("dplyr::recode could be applied to numeric labelled vector", {
  x <- dplyr::recode(labelled(1:3, c(yes = 1, no = 2)), `3` = 2L)
  expect_equal(x, labelled(c(1L, 2L, 2L), c(yes = 1, no = 2)))
})

test_that("dplyr::recode could be applied to character labelled vector", {
  x <- dplyr::recode(
    labelled(c("a", "b", "c"), c(yes = "a", no = "b")),
    c = "b"
  )
  expect_equal(x, labelled(c("a", "b", "b"), c(yes = "a", no = "b")))
})

# update_labelled ----------------------------------------

test_that("update_labelled update previous haven's labelled objects but not Hmisc's labelled objects", { # nolint
  vhaven <- structure(
    1:4,
    label = "label",
    labels = c(No = 1, Yes = 2),
    class = "labelled"
  )
  vHmisc <- structure(1:4, label = "label", class = "labelled")

  expect_s3_class(update_labelled(vhaven), "haven_labelled")
  expect_s3_class(update_labelled(vHmisc), "labelled")

  df <- dplyr::tibble(vhaven, vHmisc)
  expect_s3_class(update_labelled(df)$vhaven, "haven_labelled")
  expect_s3_class(update_labelled(df)$vHmisc, "labelled")
})

test_that("update_labelled update to haven_labelled_spss if there are na values", { #nolint
  v1 <- structure(1:4,
    label = "label", labels = c(No = 1, Yes = 2),
    na_values = c(8, 9), class = c("labelled_spss", "labelled")
  )
  v2 <- structure(1:4,
    label = "label", labels = c(No = 1, Yes = 2),
    na_range = c(8, 9), class = c("labelled_spss", "labelled")
  )

  expect_s3_class(update_labelled(v1), "haven_labelled_spss")
  expect_s3_class(update_labelled(v1), "haven_labelled_spss")
})

test_that("update_labelled preserve variable and value labels", {
  v <- structure(
    1:4,
    label = "variable label",
    labels = c(No = 1, Yes = 2),
    class = "labelled"
  )

  expect_equal(var_label(update_labelled(v)), "variable label")
  expect_equal(val_labels(update_labelled(v)), c(No = 1, Yes = 2))
})

test_that("update_labelled do nothing if it's not a labelled vector", {
  x <- 1:10
  expect_equal(update_labelled(x), x)
})

test_that("update_labelled works with labelled from haven 2.0", {
  data(x_haven_2.0)
  x <- labelled(c(1, 2, 1, 2, 10, 9), c(Unknown = 9, Refused = 10))
  expect_false(identical(x, x_haven_2.0))
  up_x_haven_2.0 <- update_labelled(x_haven_2.0)
  expect_equal(x, up_x_haven_2.0)

  data(x_spss_haven_2.0)
  x2 <- labelled_spss(
    1:10, c(Good = 1, Bad = 8),
    na_range = c(9, Inf), label = "Quality rating"
  )
  expect_false(identical(x2, x_spss_haven_2.0))
  up_x_spss_haven_2.0 <- update_labelled(x_spss_haven_2.0)
  expect_equal(x2, up_x_spss_haven_2.0)
})



# remove_attributes ------------------------------------------------------------

test_that("remove_attributes does not transform characters into factors", {
  d <- data.frame(
    ch = structure(letters[1:2], some_attribute = TRUE),
    stringsAsFactors = FALSE
  )
  d <- remove_attributes(d, "some_attribute")
  expect_true(is.character(d$ch))
})



# unlabelled ------------------------------------------------------------------

test_that("unlabelled works correctly", {
  df <- data.frame(
    a = labelled(c(1, 1, 2, 3), labels = c(No = 1, Yes = 2)),
    b = labelled(c(1, 1, 2, 3), labels = c(No = 1, Yes = 2, DK = 3)),
    c = labelled(c("a", "a", "b", "c"), labels = c(No = "a", Yes = "b")),
    stringsAsFactors = FALSE
  )

  df <- unlabelled(df)
  expect_equal(class(df$a), "numeric")
  expect_s3_class(df$b, "factor")
  expect_equal(class(df$c), "character")

  v <- labelled(c(1, 1, 2, 3), labels = c(No = 1, Yes = 2, DK = 3))
  expect_s3_class(unlabelled(v), "factor")

  v <- labelled(c(1, 1, 2, 3), labels = c(No = 1, Yes = 2))
  expect_false(inherits(unlabelled(v), "haven_labelled"))

  expect_false(is.factor(unlabelled(1:4)))
})

# remove_label ------------------------------------------


test_that("remove_label works correctly", {
  x <- c(1, 2, 2, 9)
  na_values(x) <- 9
  val_labels(x) <- c(yes = 1, no = 2)
  var_label(x) <- "A test variable"

  expect_false(inherits(remove_labels(x), "haven_labelled"))
  expect_null(var_label(remove_labels(x)))
  expect_equal(
    var_label(remove_labels(x, keep_var_label = TRUE)),
    var_label(x)
  )
})

# recode --------------------------------------------------------------

test_that("dplyr::recode works properly with labelled vectors", {
  x <- labelled(1:3, c(yes = 1, no = 2))

  r <- dplyr::recode(x, `3` = 2L)
  expect_equal(r, labelled(c(1L, 2L, 2L), val_labels(x)))

  r <- dplyr::recode(x, `3` = 2L, .keep_value_labels = FALSE)
  expect_equal(r, c(1L, 2L, 2L))

  expect_warning(dplyr::recode(x, `3` = "a", .default = "b"))

  x <- labelled(1:4, c(a = 1, b = 2, c = 3, d = 4))

  r <- dplyr::recode(
    x, `1` = 1L, `2` = 1L, `3` = 2L, `4` = 2L,
    .combine_value_labels = TRUE
  )
  expect_equal(val_labels(r), c("a / b" = 1L, "c / d" = 2L))

  r <- dplyr::recode(x, `2` = 1L, `4` = 3L, .combine_value_labels = TRUE)
  expect_equal(val_labels(r), c("a / b" = 1L, "c / d" = 3L))

  r <- dplyr::recode(
    x, `2` = 1L, `4` = 3L,
    .combine_value_labels = TRUE,
    .sep = " or "
  )
  expect_equal(val_labels(r), c("a or b" = 1L, "c or d" = 3L))

  y <- labelled(1:4, c(a = 1))
  r <- dplyr::recode(y, `2` = 1L, `4` = 3L, .combine_value_labels = TRUE)
  expect_equal(val_labels(r), c(a = 1L))
})

# tidy dots --------------------------------------------------------------

test_that("functions with dots accept tidy evaluation (`!!!` operator)", {
  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  variable_list <- list(s1 = "Sex", s2 = "Question")
  df <- set_variable_labels(df, !!!variable_list)
  expect_equal(var_label(df$s1), "Sex")
  expect_equal(var_label(df$s2), "Question")

  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  labels_list <- list(
    s1 = c(Male = "M", Female = "F"),
    s2 = c(Yes = 1, No = 2)
  )
  df <- set_value_labels(df, !!!labels_list)
  expect_equal(val_labels(df$s1), c(Male = "M", Female = "F"))
  expect_equal(val_labels(df$s2), c(Yes = 1, No = 2))

  df <- data.frame(
    s1 = c("M", "M", "F"),
    s2 = c(1, 1, 2),
    stringsAsFactors = FALSE
  )
  df <- set_value_labels(
    df,
    s1 = c(Male = "M", Female = "F"),
    s2 = c(Yesss = 1, No = 2)
  )
  added_values_list <- list(s2 = c(Yes = 1, Unknown = 9))
  df <- add_value_labels(df, !!!added_values_list)
  expect_equal(val_labels(df$s2), c(Yes = 1, No = 2, Unknown = 9))
  removed_values_list <- list(s2 = 9)
  df <- remove_value_labels(df, !!!removed_values_list)
  expect_equal(val_labels(df$s2), c(Yes = 1, No = 2))
})


# drop_unused_value_labels ------------------------------------------------

test_that("drop_unused_value_labels works properly with data.frame", {
  x <- labelled(c(1, 2, 2, 1), c(yes = 1, no = 2, maybe = 3))
  y <- 1:4
  df <- data.frame(x = x, y = y, stringsAsFactors = FALSE)
  ddf <- drop_unused_value_labels(df)
  expect_false(identical(ddf$x, x))
  expect_equal(ddf$y, y)
  expect_false(identical(val_labels(ddf$x), val_labels(x)))
  expect_equal(val_labels(ddf$x), val_labels(x)[-3])
})


# nolabel_to_na -----------------------------------------------------------

test_that("nolabel_to_na works properly", {
  x <- labelled(c(1, 2, 9, 1, 9), c(yes = 1, no = 2))
  y <- 1:5
  df <- data.frame(x = x, y = y, stringsAsFactors = FALSE)
  nldf <- nolabel_to_na(df)
  expect_false(identical(nldf$x, x))
  expect_equal(nldf$y, y)
  expect_equal(which(is.na(nldf$x)), c(3L, 5L))
})

# val_labels_to_na -----------------------------------------------------------

test_that("val_labels_to_na works properly", {
  x <- labelled(c(1, 2, 9, 1, 9), c(dk = 9))
  y <- 1:5
  df <- data.frame(x = x, y = y, stringsAsFactors = FALSE)
  vldf <- val_labels_to_na(df)
  expect_false(identical(vldf$x, x))
  expect_equal(vldf$y, y)
  expect_null(val_labels(vldf$x))
  expect_equal(which(is.na(vldf$x)), c(3L, 5L))
})


# names_prefixed_by_values ------------------------------------------------


test_that("names_prefixed_by_values works properly", {
  df <- dplyr::tibble(
    c1 = labelled(c("M", "M", "F"), c(Male = "M", Female = "F")),
    c2 = labelled(c(1, 1, 2), c(Yes = 1, No = 2)),
  )

  res_names_prefixed <- list(
    c1 = c("[M] Male", "[F] Female"),
    c2 = c("[1] Yes", "[2] No")
  )
  expect_equivalent(
    names_prefixed_by_values(val_labels(df)),
    res_names_prefixed
  )

  expect_true(is.null(names_prefixed_by_values(NULL)))
})

test_that("null_action in var_label() works as expected", {
  df <- datasets::iris %>%
    set_variable_labels(
      Petal.Length = "length of petal",
      Petal.Width = "width of petal"
    )
  expect_equal(
    var_label(df),
    list(
      Sepal.Length = NULL,
      Sepal.Width = NULL,
      Petal.Length = "length of petal",
      Petal.Width = "width of petal",
      Species = NULL
    )
  )
  expect_equal(
    var_label(df, null_action = "fi"),
    list(
      Sepal.Length = "Sepal.Length",
      Sepal.Width = "Sepal.Width",
      Petal.Length = "length of petal",
      Petal.Width = "width of petal",
      Species = "Species"
    )
  )
  expect_equal(
    var_label(df, null_action = "skip"),
    list(
      Petal.Length = "length of petal",
      Petal.Width = "width of petal"
    )
  )
  expect_error(var_label(df$Species, null_action = "skip"))
})

test_that("var_label works with packed columns", {
  d <- iris %>%
    tidyr::as_tibble() %>%
    tidyr::pack(
      Sepal = starts_with("Sepal"),
      Petal = starts_with("Petal"),
      .names_sep = "."
    )

  d <- d %>% set_variable_labels(Sepal = "Label of the Sepal df-column")
  expect_equal(
    label_attribute(d$Sepal),
    "Label of the Sepal df-column"
  )

  d$Petal <- d$Petal %>%
    set_variable_labels(
      Length = "Petal length",
      Width = "Petal width"
    )
  expect_equal(
    label_attribute(d$Petal$Length),
    "Petal length"
  )

  expect_equal(
    length(var_label(d)),
    3L
  )

  expect_equal(
    length(var_label(d, recurse = TRUE)),
    3L
  )

  expect_equal(
    length(var_label(d, recurse = TRUE, unlist = TRUE)),
    5L
  )

})