review 1

R/join_keys-extract.R

@@ -41,12 +41,12 @@
     if (
       !any(
         checkmate::test_string(i),
-        checkmate::test_integerish(i, len = 1),
+        checkmate::test_number(i),
         checkmate::test_logical(i, len = length(x)) && sum(j) == 1
       ) ||
         !any(
           checkmate::test_string(j),
-          checkmate::test_integerish(j, len = 1),
+          checkmate::test_number(j),
           checkmate::test_logical(j, len = length(x)) && sum(j) == 1
         )
     ) {
@@ -56,6 +56,8 @@
         call. = FALSE
       )
     }
+    if (is.numeric(i)) i <- names(x)[i]
+    if (is.numeric(j)) j <- names(x)[j]
 
     subset_x <- update_keys_given_parents(x[union(i, j)])
     return(subset_x[[i]][[j]])
@@ -68,13 +70,13 @@
   checkmate::assert(
     combine = "or",
     checkmate::check_character(i),
-    checkmate::check_integerish(i),
+    checkmate::check_numeric(i),
     checkmate::check_logical(i)
   )
 
 
   # Convert integer/logical index to named index
-  if (checkmate::test_integerish(i) || checkmate::test_logical(i)) {
+  if (checkmate::test_numeric(i) || checkmate::test_logical(i)) {
     i <- names(x)[i]
   }
 
@@ -148,12 +150,12 @@
   } else if (
     !any(
       checkmate::test_string(i),
-      checkmate::test_integerish(i, len = 1),
+      checkmate::test_number(i),
       checkmate::test_logical(i, len = length(x)) && sum(j) == 1
     ) ||
       !any(
         checkmate::test_string(j),
-        checkmate::test_integerish(j, len = 1),
+        checkmate::test_number(j),
         checkmate::test_logical(j, len = length(x)) && sum(j) == 1
       )
   ) {
@@ -193,11 +195,11 @@
   checkmate::assert(
     combine = "or",
     checkmate::check_string(i),
-    checkmate::check_integerish(i, len = 1),
+    checkmate::check_number(i),
     checkmate::check_logical(i, len = length(x))
   )
   checkmate::assert_list(value, names = "named", types = "character", null.ok = TRUE)
-  if (checkmate::test_integerish(i) || checkmate::test_logical(i)) {
+  if (checkmate::test_numeric(i) || checkmate::test_logical(i)) {
     i <- names(x)[[i]]
   }
 
@@ -229,17 +231,15 @@
   # Safe to do as duplicated are the same
   norm_value[duplicated(names(norm_value))] <- NULL
 
-  # Remove elements with length == 0L
-  norm_value <- Filter(function(.x) length(.x) > 0, norm_value)
+  # Keep only elements with length > 0L
+  norm_value <- Filter(length, norm_value)
 
   # Remove classes to use list-based get/assign operations
   new_x <- unclass(x)
 
   # In case a pair is removed, also remove the symmetric pair
   removed_names <- setdiff(names(new_x[[i]]), names(norm_value))
-  if (length(removed_names) > 0) {
-    for (.x in removed_names) new_x[[.x]][[i]] <- NULL
-  }
+  for (.x in removed_names) new_x[[.x]][[i]] <- NULL
 
   new_x[[i]] <- norm_value
 

R/join_keys-names.R

@@ -20,13 +20,8 @@
     # changing name in the parents
     if (length(parent_list)) {
       names(parent_list)[names(parent_list) == old_name] <- new_name
-      parent_list <- lapply(parent_list, function(.x) {
-        if (identical(.x, old_name)) {
-          new_name
-        } else {
-          .x
-        }
-      })
+      ind <- vapply(parent_list, identical, logical(1), old_name)
+      parent_list[ind] <- new_name
       attr(new_x, "__parents__") <- parent_list
     }
   }

tests/testthat/test-join_keys-extract.R

@@ -38,6 +38,18 @@ testthat::test_that("join_keys[i] returns join_keys object with keys for given i
   )
 })
 
+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_identical(
+    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"),
@@ -119,6 +131,17 @@ testthat::test_that("join_keys[i,j] returns keys for given pair", {
   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"),
@@ -131,17 +154,17 @@ testthat::test_that("join_keys[i,j] return NULL for given pair when no such key
 })
 
 testthat::test_that(
-  "join_keys[i,j] infer keys between children through unnamed foreign keys to parent (reglardless keys order)",
+  "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("b", "a", sample(letters[1:5])),
-      join_key("c", "a", sample(letters[1:5]))
+      join_key("b", "a", c(child = "a1")),
+      join_key("c", "a", c(child = "a2"))
     )
     parents(my_keys) <- list("b" = "a", "c" = "a")
-    testthat::expect_identical(my_keys["b", "c"], setNames(letters[1:5], letters[1:5]))
+    testthat::expect_null(my_keys["b", "c"])
   }
 )
 

tests/testthat/test-join_keys-print.R

@@ -42,6 +42,27 @@ testthat::test_that("format.join_keys for parents", {
   )
 })
 
+testthat::test_that("format.join_keys print inferred keys for children sharing parent", {
+  my_keys <- join_keys(
+    join_key("d1", "d1", "a"),
+    join_key("d2", "d2", "b"),
+    join_key("d3", "d3", "c"),
+    join_key("d2", "d1", "child-a"),
+    join_key("d3", "d1", "child-a")
+  )
+  parents(my_keys) <- list("d2" = "d1", "d3" = "d1")
+  testthat::expect_identical(
+    format(my_keys),
+    paste(
+      "A join_keys object containing foreign keys between 3 datasets:",
+      "d1: [a]", "  <-- d2: [child-a]", "  <-- d3: [child-a]",
+      "d2: [b]", "  --> d1: [child-a]", "  --* (implicit via parent with): d3",
+      "d3: [c]", "  --> d1: [child-a]", "  --* (implicit via parent with): d2",
+      sep = "\n"
+    )
+  )
+})
+
 testthat::test_that("print.join_keys produces output same as format", {
   my_keys <- join_keys(
     join_key("d1", "d1", "a"),

tests/testthat/test-join_keys.R

@@ -150,10 +150,3 @@ testthat::test_that("join_keys()[]<-.join_keys with empty value in a named vecto
   testthat::expect_message(join_keys(jk)[["d1"]][["d2"]] <- c("A" = "B", ""), "are ignored")
   testthat::expect_equal(jk[["d1"]][["d2"]], c(A = "B"))
 })
-
-
-
-# -----------------------------------------------------------------------------
-#
-# Setting names (names<-join_keys)
-#