tests/testthat/test-defined.R

In dataset: Create Data Frames that are Easier to Exchange and Reuse

test_that("labelled_defined() works", {
  z <- defined(c(1, 1, 1, 0, 0, 0),
    label = "",
    labels = c("F" = 0, "M" = 1, "_N" = 99),
    concept = "https://registry.sdmx.org/sdmx/v2/structure/codelist/SDMX/CL_SEX/2.1#"
  )
  x <- defined(c(0, 1, 0, 1, 1, 0),
    label = "sex",
    labels = c("F" = 0, "M" = 1, "_N" = 99),
    concept = "https://registry.sdmx.org/sdmx/v2/structure/codelist/SDMX/CL_SEX/2.1#"
  )
  v <- defined(c(1, 0),
    label = "sex",
    labels = c("F" = 0, "M" = 1, "_N" = 99),
    concept = "https://registry.sdmx.org/sdmx/v2/structure/codelist/SDMX/CL_SEX/2.1#"
  )
  y <- defined(c(1, 1, 1, 0, 0, 0),
    label = "sex",
    labels = c("F" = 0, "M" = 1, "_N" = 99),
    concept = "https://registry.sdmx.org/sdmx/v2/structure/codelist/SDMX/CL_SEX/2.1#"
  )
  expect_equal(c(1:3, y), c(1, 2, 3, 1, 1, 1, 0, 0, 0))
  expect_equal(
    c("a", "b", y),
    c("a", "b", as.character(c(1, 1, 1, 0, 0, 0)))
  )
  expect_equal(
    c(x, y),
    defined(c(0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0),
      label = "sex",
      labels = c("F" = 0, "M" = 1, "_N" = 99),
      concept = "https://registry.sdmx.org/sdmx/v2/structure/codelist/SDMX/CL_SEX/2.1#"
    )
  )
  expect_equal(
    c(x, y, v),
    defined(c(0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0),
      label = "sex",
      labels = c("F" = 0, "M" = 1, "_N" = 99),
      concept = "https://registry.sdmx.org/sdmx/v2/structure/codelist/SDMX/CL_SEX/2.1#"
    )
  )
  a <- defined(c("a", "b"), label = "c")
  d <- defined(c("d", "e"), label = "c")
  expect_equal(
    c(a, d),
    defined(c("a", "b", "d", "e"),
      label = "c"
    )
  )
})

test_that("labelled_defined() works", {
  sepal_length <- defined(iris$Sepal.Length,
    labels = NULL,
    label = "Sepal length",
    unit = "centimeters",
    concept = "https://www.wikidata.org/wiki/Property:P2043"
  )
  myspecies <- defined(
    x = iris$Species,
    label = "Taxon name within the Iris genus",
    concept = "https://npgsweb.ars-grin.gov/gringlobal/taxon/taxonomygenus?id=6074",
    namespace = "Iris"
  )
  expect_equal(is.defined(sepal_length), TRUE)
  expect_equal(var_label(sepal_length), "Sepal length")
  expect_equal(var_unit(sepal_length), "centimeters")
  expect_equal(var_concept(sepal_length), "https://www.wikidata.org/wiki/Property:P2043")
  expect_equal(var_namespace(myspecies), "Iris")
  expect_true(all(as.character(sepal_length) == as.character(iris$Sepal.Length)))
})


test_that("Subsetting defined vectors works correctly", {
  v <- defined(10:20,
    label = "Test Vector",
    unit = "kg",
    concept = "http://example.com/def",
    namespace = "http://example.com/ns"
  )

  sub_v <- v[1:5]
  expect_true(is.defined(sub_v))
  expect_equal(var_label(sub_v), "Test Vector")
  expect_equal(var_unit(sub_v), "kg")
  expect_equal(length(sub_v), 5)

  single <- v[[3]]
  expect_equal(as_numeric(single), 12)
  expect_equal(var_label(single), "Test Vector")
  expect_equal(var_unit(single), "kg")
})

test_that("[[.haven_labelled_defined returns a scalar defined value with metadata", {
  x <- defined(
    c(10, 20, 30),
    label = "Measurement",
    unit = "cm",
    concept = "http://example.org/def",
    namespace = "http://example.org/ns",
    labels = c("Low" = 10, "Medium" = 20, "High" = 30)
  )

  val <- x[[2]]

  expect_true(is.defined(val))
  expect_equal(as_numeric(val), 20)
  expect_equal(var_label(val), "Measurement")
  expect_equal(var_unit(val), "cm")
  expect_equal(var_concept(val), "http://example.org/def")
  expect_equal(var_namespace(val), "http://example.org/ns")

  # Check that labels are preserved too
  expect_equal(attr(val, "labels"), c("Low" = 10, "Medium" = 20, "High" = 30))
})

test_that("Comparison operations work on defined vectors", {
  a <- defined(1:5, label = "Test", unit = "x", concept = "def")
  b <- defined(5:1, label = "Test", unit = "x", concept = "def")

  expect_equal(a == b, c(FALSE, FALSE, TRUE, FALSE, FALSE))
  expect_equal(a < 3, c(TRUE, TRUE, FALSE, FALSE, FALSE))
  expect_equal(3 > b, c(FALSE, FALSE, FALSE, TRUE, TRUE))
  expect_equal(a != b, c(TRUE, TRUE, FALSE, TRUE, TRUE))
})


test_that("length, head, and tail work on defined vectors", {
  x <- defined(1:10, label = "Demo", unit = "m", concept = "test")

  expect_equal(length(x), 10)
  expect_equal(length(head(x, 3)), 3)
  expect_equal(length(tail(x, 2)), 2)
  expect_equal(as_numeric(head(x, 2)), c(1, 2))
  expect_equal(as_numeric(tail(x, 3)), c(8, 9, 10))

  expect_true(is.defined(head(x, 3)))
  expect_true(is.defined(tail(x, 2)))
  expect_equal(var_label(head(x, 3)), "Demo")
  expect_equal(var_unit(tail(x, 2)), "m")
  expect_equal(var_concept(head(x, 1)), "test")
})

test_that("print.haven_labelled_defined outputs correctly with/without definition and unit", {
  x1 <- defined(1:3, concept = "https://def", unit = "kg")
  x2 <- defined(1:3, concept = "https://def")
  x3 <- defined(1:3, unit = "kg")
  x4 <- defined(1:3)

  expect_output(print(x1), "Defined as https://def, measured in kg")
  expect_output(print(x2), "Defined as https://def")
  expect_output(print(x3), "Measured in kg")
  expect_output(print(x4), "Defined vector")
})

test_that("format.haven_labelled_defined works correctly", {
  x <- defined(1:3, unit = "kg", concept = "https://def")
  expect_equal(format(x), c("1 (kg)", "2 (kg)", "3 (kg)"))

  y <- defined(4:6, concept = "short-def")
  expect_equal(format(y), c("4 [short-def]", "5 [short-def]", "6 [short-def]"))

  z <- defined(7:9)
  expect_equal(format(z), c("7", "8", "9"))
})


test_that("as.vector.haven_labelled_defined works correctly", {
  x <- defined(1:3, unit = "kg", concept = "http://example.com")
  expect_equal(as.vector(x), c(1, 2, 3))
  expect_equal(as.vector(x, mode = "character"), c("1", "2", "3"))

  y <- defined(c("a", "b"))
  expect_equal(as.vector(y), c("a", "b"))
})

test_that("as.list.haven_labelled_defined preserves metadata", {
  x <- defined(1:2, label = "Test", unit = "kg", concept = "def")
  lst <- as.list(x)
  expect_length(lst, 2)
  expect_true(all(vapply(lst, is.defined, logical(1))))
  expect_equal(var_unit(lst[[1]]), "kg")
})

test_that("labelled_defined() throws error", {
  expect_error(var_unit(sepal_length) <- c("cm", "mm"))
  expect_error(var_unit(sepal_length) <- 1)
  expect_error(defined(
    x = iris$Species,
    label = "Taxon name within the Iris genus",
    concept = 1,
    concept = "Iris"
  ))
  expect_error(defined(
    x = iris$Species,
    label = "Taxon name within the Iris genus",
    unit = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = iris$Species,
    label = "Taxon name within the Iris genus",
    namespace = 1
  ))
})

test_that("new_datetime_defined() throws errors", {
  expect_error(defined(
    x = Sys.Date(),
    label = c("Today's date", "Extra label"),
    concept = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = Sys.Date(),
    label = 1,
    concept = "Definition",
    namespace = "Iris"
  ))
  expect_error(defined(
    x = Sys.Date(),
    label = "Today's date",
    concept = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = Sys.Date(),
    label = "Today's date", ,
    unit = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = Sys.Date(),
    label = "Today's date",
    namespace = 1
  ))
})

test_that("new_labelled_defined() throws errors", {
  expect_error(defined(
    x = c(1:3),
    label = c("Numbers", "Numbers"),
    concept = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = c(1:3),
    label = "Numbers",
    concept = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = c(1:3),
    label = "Numbers",
    concept = 1,
    unit = 1,
    namespace = "Iris"
  ))
  expect_error(defined(
    x = c(1:3),
    label = "Numbers",
    namespace = 1
  ))
})

test_that("iris_dataset() prints", {
  expect_output(str(iris_dataset),
                "https://doi.org/10.5281/zenodo.10396807",
                ignore.case = FALSE)
  expect_output(print(iris_dataset), "Iris Dataset.", ignore.case = FALSE)
})


test_that("c() works", {
  a <- defined(iris$Sepal.Length[1:3],
    labels = NULL,
    label = "Sepal length",
    unit = "centimeters",
    concept = "https://www.wikidata.org/wiki/Property:P2043"
  )


  b <- defined(iris$Sepal.Length[4:6],
    labels = NULL,
    label = "Sepal length",
    unit = "centimeters",
    concept = "https://www.wikidata.org/wiki/Property:P2043"
  )

  bmm <- defined(iris$Sepal.Length[7:9] * 10,
    labels = NULL,
    label = "Sepal length",
    unit = "milimeters",
    concept = "https://www.wikidata.org/wiki/Property:P2043"
  )
  expect_equal(is.defined(c(a, b)), TRUE)
  expect_equal(length(c(a, b)), 6)
  expect_error(c(a, bmm))
})


test_that("summary.haven_labelled_defined() works ", {
  sepal_length <- iris_dataset$Sepal.Length
  expect_output(summary(sepal_length),
                "Length of the sepal in cm \\(centimeter\\)")
  expect_equal(names(summary(sepal_length))[1], "Min.")
})


test_that("summary() produces no output when label/unit are missing", {
  x <- defined(1:5)
  expect_silent(summary(x)) # expect no printed title
})


test_that("as_numeric() returns underlying numeric vector", {
  x <- defined(1:3, label = "Test", unit = "kg")
  expect_equal(as_numeric(x, preserve_attributes = FALSE), c(1, 2, 3))
  expect_equal(attr(as_numeric(x, TRUE), "unit"), "kg")
  expect_type(as_numeric(x), "integer")
})

test_that("as_numeric() returns underlying numeric vector", {
  x <- defined(1:3, label = "Test", unit = "kg")
  expect_equal(as.numeric(x), c(1, 2, 3))
})

test_that("as_character() returns underlying character vector", {
  fruits <- defined(c("apple", "avocado", "kiwi"),
                    label = "Fruit", unit = "kg")
  expect_equal(as_character(fruits, preserve_attributes = FALSE),
               c("apple", "avocado", "kiwi"))
  expect_equal(attr(as_character(fruits, TRUE), "unit"), "kg")
  expect_type(as_character(fruits), "character")
  expect_error(as_numeric(fruits),
               regexp = "underlying data is not numeric")
})

test_that("as_factor() works with defined vector", {
  x <- defined(
    c(0, 1, 1, 0),
    label = "Sex",
    labels = c("Female" = 0, "Male" = 1)
  )
  f <- as_factor(x)
  expect_s3_class(f, "factor")
  expect_equal(levels(f), c("Female", "Male"))
  expect_equal(as.character(f), c("Female", "Male", "Male", "Female"))
})


test_that("c.haven_labelled_defined() works ", {
  a <- defined(1:3, label = "testlabel", unit = "meter",
               concept = "testdef", namespace = "http://example.com")
  b <- defined(4:6, label = "testlabel", unit = "meter",
               concept = "testdef", namespace = "http://example.com")
  ab <- defined(1:6, label = "testlabel", unit = "meter",
                concept = "testdef", namespace = "http://example.com")
  expect_equal(ab, c(a, b))
  cm <- defined(4:6, label = "testlabel", unit = "centimeter",
                concept = "test", namespace = "http://example.com")
  def <- defined(4:6, label = "testlabel", unit = "meter",
                 concept = "def", namespace = "http://example.com")
  nsp <- defined(4:6, label = "testlabel", unit = "meter",
                 concept = "testdef", namespace = "http://examples.com")
  lbl <- defined(4:6, label = "tested", unit = "meter",
                 concept = "def", namespace = "http://example.com")
  expect_error(c(a, cm),
    regexp = "must have no unit or the same unit"
  )
  expect_error(c(a, def),
    regexp = "must have no concept definition or the same concept definition"
  )
  expect_error(c(a, nsp),
    regexp = "must have no namespace or the same namespace"
  )
  expect_error(c(a, lbl),
    regexp = "must have no var_label or the same var_label"
  )
})

## Test type_sum ------------------------------------------------
test_that("type_sum returns <defined> when no label is set", {
  x <- defined(c(1, 2, 3))
  expect_equal(type_sum(x), "defined")
})