tests/testthat/test-join_keys-extract.R

In teal.data: Data Model for 'teal' Applications

# join_keys[i] -----------------------------------------------------------------
testthat::test_that("join_keys[i] returns join_keys object when i and j is missing", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c")
  )
  testthat::expect_identical(my_keys[], my_keys)
})

testthat::test_that("join_keys[i] returns empty join_keys when i or j are NULL", {
  my_keys <- join_keys(join_key("d1", "d1", "a"))
  testthat::expect_identical(my_keys[NULL], join_keys())
  testthat::expect_identical(my_keys[, NULL], join_keys())
})

testthat::test_that("join_keys[i] subsets join_keys object to specific datasets", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c")
  )
  testthat::expect_equal(
    my_keys[c("d1", "d2")],
    join_keys(join_key("d1", "d1", "a"), join_key("d2", "d2", "b"))
  )
})

testthat::test_that("join_keys[i] returns join_keys object with keys for given index", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c")
  )
  testthat::expect_equal(
    my_keys[c(1, 2)],
    join_keys(join_key("d1", "d1", "a"), join_key("d2", "d2", "b"))
  )
})

testthat::test_that("join_keys[-i] drops keys for given index", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c")
  )
  testthat::expect_equal(
    my_keys[-3],
    join_keys(join_key("d1", "d1", "a"), join_key("d2", "d2", "b"))
  )
})

testthat::test_that("join_keys[i] returns join_keys object for given dataset including its parent", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c"),
    join_key("d1", "d2", "ab"),
    join_key("d1", "d3", "ac")
  )

  expected <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d1", "d2", "ab")
  )

  testthat::expect_equal(my_keys["d2"], expected)
})

testthat::test_that("join_keys[i] returns join_keys object for given dataset and doesn't include its children", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c"),
    join_key("d1", "d2", "ab"),
    join_key("d1", "d3", "ac")
  )

  expected <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d1", "d2", "ab")
  )

  testthat::expect_equal(my_keys["d2"], expected)
})

testthat::test_that("join_keys[i] returns empty join_keys for inexisting dataset", {
  my_keys <- join_keys(join_key("d1", "d1", "a"))
  testthat::expect_length(my_keys["d2"], 0)
})

testthat::test_that("join_keys[i] ignores duplicate indexes - return only first occurrence", {
  jk <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d2", "d3", "b")
  )
  testthat::expect_equal(
    jk[c("d1", "d2", "d1")],
    join_keys(
      join_key("d1", "d1", "a"),
      join_key("d2", "d2", "b")
    )
  )
})

testthat::test_that("join_keys[,j] returns the same as join_keys[i,]", {
  my_keys <- join_keys(
    join_key("d1", "d1", "a"),
    join_key("d2", "d2", "b"),
    join_key("d3", "d3", "c")
  )
  testthat::expect_identical(
    my_keys[, c("d1", "d2")],
    my_keys[c("d1", "d2")]
  )
})

# join_keys[i, j]  -----------------------------------------------------------------
testthat::test_that("join_keys[i,j] returns keys for given pair", {
  my_keys <- join_keys(
    join_key("a", "a", "aa"),
    join_key("b", "b", "bb"),
    join_key("c", "c", "cc"),
    join_key("b", "a", "child-parent"),
    join_key("c", "a", "child-parent")
  )
  testthat::expect_identical(my_keys["b", "a"], c(`child-parent` = "child-parent"))
})

testthat::test_that("join_keys[i,j] returns keys for pair given by numeric indices", {
  my_keys <- join_keys(
    join_key("a", "a", "aa"),
    join_key("b", "b", "bb"),
    join_key("c", "c", "cc"),
    join_key("b", "a", "child-parent"),
    join_key("c", "a", "child-parent")
  )
  testthat::expect_identical(my_keys[2, 1], c(`child-parent` = "child-parent"))
})

testthat::test_that("join_keys[i,j] return NULL for given pair when no such key and no common parent", {
  my_keys <- join_keys(
    join_key("a", "a", "aa"),
    join_key("b", "b", "bb"),
    join_key("c", "c", "cc"),
    join_key("b", "a", "child-parent"),
    join_key("c", "a", "child-parent")
  )
  testthat::expect_null(my_keys["b", "c"])
})

testthat::test_that(
  "join_keys[i,j] doesn't infer keys between children if they don't have common key to parent",
  {
    my_keys <- join_keys(
      join_key("a", "a", "aa"),
      join_key("b", "b", "bb"),
      join_key("c", "c", "cc"),
      join_key("a", "b", c("a1" = "aa")),
      join_key("a", "c", c("a2" = "aa"))
    )
    testthat::expect_null(my_keys["b", "c"])
  }
)

testthat::test_that(
  "join_keys[i,j] doesn't infer keys between grandchildren",
  {
    my_keys <- join_keys(
      join_key("a", "a", "aa"),
      join_key("b", "b", "bb"),
      join_key("c", "c", "cc"),
      join_key("a", "b", "child-parent"),
      join_key("a", "c", "child-parent"),
      join_key("b", "d", "grandchild-child"),
      join_key("c", "e", "grandchild-child")
    )
    testthat::expect_null(my_keys["d", "e"])
  }
)

testthat::test_that(
  "join_keys[i,j ] infer keys between children through foreign keys to parent. ",
  {
    my_keys <- join_keys(
      join_key("a", "a", "aa"),
      join_key("b", "b", "bb"),
      join_key("c", "c", "cc"),
      join_key("a", "b", c("aa" = "bb")),
      join_key("a", "c", c("aa" = "cc"))
    )
    # "bb" and "cc" are the names in child datasets, "aa" is the name in parent dataset
    testthat::expect_identical(my_keys["b", "c"], c(bb = "cc"))
  }
)

testthat::test_that("join_keys[i,j] returns NULL for inexisting key pair (can't even infer)", {
  my_keys <- join_keys(
    join_key("a", "a", "aa"),
    join_key("b", "b", "bb"),
    join_key("c", "c", "cc")
  )
  testthat::expect_null(my_keys["inexisting", "inexisting"])
})

testthat::test_that("join_keys[i,j] throws when one of the indices is longer than 1", {
  my_keys <- join_keys(
    join_key("a", "a", "aa"),
    join_key("b", "b", "bb"),
    join_key("c", "c", "cc")
  )
  testthat::expect_error(my_keys[c("a", "b"), "c"], "Can't extract keys for multiple pairs.")
})

# [<-.join_keys ------------------------------------------------
testthat::test_that("join_keys[i]<- throws when assigning anything", {
  my_keys <- join_keys()
  testthat::expect_error(my_keys["a"] <- join_key("a", "b", "test"), "specify both indices to set a key pair.")
})

testthat::test_that("join_keys[i]<- throws when no index specified", {
  my_keys <- join_keys()
  testthat::expect_error(my_keys[] <- join_key("a", "b", "test"), "specify both indices to set a key pair.")
})

testthat::test_that("join_keys[i,j]<- can set new value for existing pair", {
  my_keys <- join_keys(join_key("a", "a", "aa"))
  testthat::expect_no_error(my_keys["a", "a"] <- "new key")
  testthat::expect_identical(my_keys, join_keys(join_key("a", "a", "new key")))
})

testthat::test_that("join_keys[i,j]<- sets a new keys for inexisting pair", {
  my_keys <- join_keys(join_key("a", "a", "aa"))
  testthat::expect_no_error(my_keys["b", "c"] <- "new key")
  testthat::expect_identical(my_keys, join_keys(join_key("a", "a", "aa"), join_key("b", "c", "new key")))
})

testthat::test_that("join_keys[i,j]<- throws when assigning to inspecific index", {
  my_keys <- join_keys()
  testthat::expect_error(my_keys[, "b"] <- join_key("a", "b", "test"))
})

testthat::test_that("join_keys[i,j]<- throws when assigning to j only", {
  my_keys <- join_keys()
  testthat::expect_error(my_keys[, "b"] <- join_key("a", "b", "test"))
})

testthat::test_that("join_keys[i,j]<- throws when i or j are NULL", {
  my_keys <- join_keys()
  testthat::expect_error(my_keys[NULL, 1] <- join_key("a", "b", "test"), "NULL")
  testthat::expect_error(my_keys[1, NULL] <- join_key("a", "b", "test"), "NULL")
})

testthat::test_that("join_keys[i,j]<- throws when i or j are longer than 1", {
  my_keys <- join_keys()
  testthat::expect_error(my_keys[c("a", "b"), "a"] <- "new key")
  testthat::expect_error(my_keys["a", c("a", "b")] <- "new key")
})

testthat::test_that("join_keys[i,j]<- removes keys with NULL", {
  my_keys <- join_keys(
    join_key("d1", "d1", "A"),
    join_key("d2", "d2", "B"),
    join_key("d1", "d2", c("A" = "B"))
  )
  my_keys["d2", "d1"] <- NULL

  testthat::expect_equal(
    my_keys,
    join_keys(
      join_key("d1", "d1", "A"),
      join_key("d2", "d2", "B")
    )
  )
})

# [[<-.join_keys ------------------------------------------------
testthat::test_that("[[<-.join_keys accepts named list where each containing character", {
  jk <- join_keys()
  testthat::expect_no_error(
    jk[["d1"]] <- list(d1 = c("a", "b", "c"), d2 = c(b = "c", "d" = "d"))
  )
})

testthat::test_that("[[<-.join_keys accepts integerish as index", {
  jk <- join_keys(join_key("a", "a", "aa"))
  testthat::expect_no_error(
    jk[[1]][[1]] <- "bb"
  )
})

testthat::test_that("[[<-.join_keys accepts unnamed vector", {
  jk <- join_keys()
  testthat::expect_no_error(
    jk[["d1"]] <- list(d1 = c("a", "b", "c"))
  )
})

testthat::test_that("[[<-.join_keys doesn't accepts other list than named containing character", {
  jk <- join_keys()
  testthat::expect_error(jk[["d1"]] <- list(d1 = 1:5, d2 = c(b = "c", "d" = "d")))
  testthat::expect_error(jk[["d1"]] <- list(d1 = list(a = "a")))
  testthat::expect_error(jk[["d1"]] <- list(d1 = NULL))
})

testthat::test_that("[[<-.join_keys doesn't accepts other list than named containing character", {
  jk <- join_keys()
  testthat::expect_error(jk[["d1"]] <- list(d1 = 1:5, d2 = c(b = "c", "d" = "d")))
  testthat::expect_error(jk[["d1"]] <- list(d1 = list(a = "a")))
  testthat::expect_error(jk[["d1"]] <- list(d1 = NULL))
  testthat::expect_error(jk[["d1"]] <- "test")
})

testthat::test_that("[[<-.join_keys adds join_keys specified as named list to the list of keys", {
  jk <- join_keys()
  jk[["d1"]] <- list(d1 = "a")
  testthat::expect_equal(jk, join_keys(join_key("d1", "d1", "a")))
})

testthat::test_that("[[<-.join_keys assigning NULL drops a key", {
  jk <- join_keys(join_key("d1", "d1", "a"))
  jk[["d1"]] <- NULL
  testthat::expect_null(jk[["d1"]])
})

testthat::test_that("[[<-.join_keys adds symmetrical change without parents to the foreign dataset", {
  jk <- join_keys()
  jk[["d1"]][["d2"]] <- c("A" = "B", "C" = "C")

  testthat::expect_equal(
    jk,
    structure(
      list(
        d1 = list(
          d2 = c(c("A" = "B", "C" = "C"))
        ),
        d2 = list(
          d1 = c("B" = "A", "C" = "C")
        )
      ),
      class = c("join_keys", "list")
    )
  )
})

testthat::test_that("[[<- can mutate existing keys", {
  my_keys <- join_keys(join_key("d1", "d2", "A"))
  my_keys[["d1"]][["d2"]] <- "B"
  testthat::expect_identical(my_keys, join_keys(join_key("d1", "d2", "B")))
})

testthat::test_that("[[<- mutating non-existing keys adds them", {
  my_keys <- join_keys(join_key("d1", "d2", "A"))
  my_keys[["d2"]][["d3"]] <- "B"
  testthat::expect_identical(
    my_keys,
    join_keys(
      join_key("d1", "d2", "A"),
      join_key("d2", "d3", "B", directed = FALSE) # [[<- doesn't set parent
    )
  )
})

testthat::test_that("[[<- setting a key to character(0) drops the key", {
  my_keys <- join_keys(
    join_key("d1", "d2", "A"),
    join_key("d2", "d3", "B")
  )

  my_keys[["d1"]][["d2"]] <- character(0)

  testthat::expect_identical(
    my_keys,
    join_keys(join_key("d2", "d3", "B"))
  )
})

testthat::test_that("[[<-.join_keys removes keys with NULL", {
  my_keys <- join_keys(
    join_key("d1", "d1", "A"),
    join_key("d2", "d2", "B")
  )
  my_keys[["d2"]][["d2"]] <- NULL

  testthat::expect_identical(
    my_keys,
    join_keys(
      join_key("d1", "d1", "A")
    )
  )
})

testthat::test_that("[[<-.join_keys removes keys with NULL and applies symmetrical changes", {
  my_keys <- join_keys(
    join_key("d1", "d2", "A"),
    join_key("d2", "d3", "B")
  )
  my_keys[["d1"]][["d2"]] <- NULL


  testthat::expect_equal(
    my_keys,
    join_keys(join_key("d2", "d3", "B"))
  )
})

testthat::test_that("[[<-.join_keys with empty name is changed to the key value", {
  # set empty key name
  jk <- join_keys()
  jk[["d1"]][["d2"]] <- c("A" = "B", "C")
  testthat::expect_equal(jk[["d1"]][["d2"]], stats::setNames(c("B", "C"), c("A", "C")))
})

testthat::test_that("[[<-.join_keys with empty value is set to its name", {
  jk <- join_keys()
  jk[["d1"]][["d2"]] <- c("A" = "B", "C" = "")
  testthat::expect_equal(jk[["d1"]][["d2"]], stats::setNames(c("B", "C"), c("A", "C")))
})

testthat::test_that("[[<-.join_keys passing key unnamed 'empty' value is ignored", {
  # set key on empty variable name equal to ""
  jk <- join_keys()
  testthat::expect_message(jk[["d1"]][["d2"]] <- c("A" = "B", ""), "are ignored")
  testthat::expect_equal(jk[["d1"]][["d2"]], c(A = "B"))
})

testthat::test_that("[[<-.join_keys fails when provided foreign key pairs for same datasets, but different keys", {
  jk <- join_keys()
  testthat::expect_error(
    jk[["ds1"]] <- list(ds2 = "new", ds2 = "new_but_different"),
    "cannot specify multiple different join keys between datasets"
  )
})

testthat::test_that("[[<-.join_keys allows when provided foreign key pairs for same datasets and same keys", {
  jk <- join_keys()
  testthat::expect_silent(jk[["ds1"]] <- list(ds2 = "new", ds2 = c("new" = "new")))
  testthat::expect_equal(jk, join_keys(join_key("ds1", "ds2", "new", directed = FALSE)))
})