tests/testthat/test-variable_label.R

In tinylabels: Lightweight Variable Labels

context("variable_label() replacement methods")

test_that(
  "variable_label<-.default"
  , {
    object <- 1:4
    variable_label(object) <- "Label 1"

    expect_identical(
      object = object
      , expected = structure(
        1:4
        , label = "Label 1"
        , class = c("tiny_labelled", "integer")
      )
    )

    expect_error(
      variable_label(object) <- NULL
      , regexp = "Variable labels must not be NULL. To entirely remove variable labels, use unlabel()."
    )
    expect_error(
      variable_label(object) <- 1:2
      , regexp = "Trying to set a variable label of length greater than one: '1', '2'"
    )

    # Recursively use unlist() on list-like input
    variable_label(object) <- list(b = list("a"))
    expect_identical(
      variable_label(object)
      , "a"
    )
  }
)

test_that(
  "variable_label<-.data.frame"
  , {
    object <- data.frame(a = 1:4, b = 5:8)
    object$c <- list(1:2, 3:4, 5:6, 7:8) # add a list column

    expect_error(
      variable_label(object) <- c("not_in_data" = "test")
      , "While trying to set variable labels, some requested columns could not be found in data.frame:\n'not_in_data'"
      , fixed = TRUE
    )
    expect_error(
      variable_label(object) <- "a"
      , "The assigned variable label(s) must be passed as a named vector or a named list."
      , fixed = TRUE
    )
    variable_label(object) <- c("a" = "A beautiful test label.", c = "Deal with list columns")

    expect_identical(
      object = object
      , expected = structure(
        list(
          a = structure(
            1:4
            , label = "A beautiful test label."
            , class = c("tiny_labelled", "integer")
          )
          , b = 5:8
          , c = structure(
            list(1:2, 3:4, 5:6, 7:8)
            , label = "Deal with list columns"
            , class = c("tiny_labelled", "list")
          )
        )
        , row.names = c(NA, -4L)
        , class = "data.frame"
      )
    )

    object <- label_variables(
      object
      , a = "A different, but equally beautiful, test label."
      , b = "A mediocre reinterpretation of the a's label."
    )

    expect_identical(
      object = object
      , expected = structure(
        list(
          a = structure(
            1:4
            , label = "A different, but equally beautiful, test label."
            , class = c("tiny_labelled", "integer")
          )
          , b = structure(
            5:8
            , label = "A mediocre reinterpretation of the a's label."
            , class = c("tiny_labelled", "integer")
          )
          , c = structure(
            list(1:2, 3:4, 5:6, 7:8)
            , label = "Deal with list columns"
            , class = c("tiny_labelled", "list")
          )
        )
        , row.names = c(NA, -4L)
        , class = "data.frame"
      )
    )

    object <- npk
    variable_label(object) <- c(
      N = "Nitrogen"
      , P = NULL
    )
  }
)

test_that(
  "variable_label.data.frame() for duplicate column names"
  , {
    object <- data.frame(x = 1, x = 2, check.names = F)
    variable_label(object) <- c(x = "Test duplicate columns")
    expect_identical(
      variable_label(object)
      , list(x = "Test duplicate columns", x = "Test duplicate columns")
    )
  }
)

test_that(
  "variable_label.data.frame() -- only modify columns if value is not NULL"
  , {
    object <- data.frame(
      x = 1
      , y = 2
    )
    variable_labels(object) <- list(
      x = "A nice label"
      , y = NULL
    )

    expect_identical(
      variable_labels(object)
      , list(x = "A nice label", y = NULL)
    )

  }
)



context("variable_label() extraction methods")

test_that(
  "variable_label.tiny_labelled-method"
  , {
    object <- 1:10
    class(object) <- c("tiny_labelled", "integer")
    attr(object, "label") <- "label1"

    expect_identical(
      object = variable_label(object)
      , expected = "label1"
    )
  }
)

test_that(
  "variable_label.data.frame-method"
  , {
    x <- npk
    variable_label(x) <- list(N = "Nitrogen", P = "Phosphate", K = expression(italic(K)))

    expect_identical(
      variable_label(x)
      , list(
        block   = NULL
        , N     = "Nitrogen"
        , P     = "Phosphate"
        , K     = expression(italic(K))
        , yield = NULL
      )
    )
    expect_error(
      variable_label(x) <- list(N = "a", N = "b")
      , "Duplicated names for 'value'."
      , fixed = TRUE
    )
  }
)