topological_sort for datanames(teal_data())

DESCRIPTION

@@ -54,7 +54,7 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate:
     'cdisc_data.R'
     'data.R'

R/join_keys.R

@@ -142,6 +142,7 @@ join_keys.teal_data <- function(...) {
 #' join_keys(td)
 `join_keys<-.teal_data` <- function(x, value) {
   join_keys(x@join_keys) <- value
+  datanames(x) <- x@datanames # datanames fun manages some exceptions
   x
 }
 

R/teal_data-class.R

@@ -82,6 +82,8 @@ new_teal_data <- function(data,
   new_env <- rlang::env_clone(list2env(data), parent = parent.env(.GlobalEnv))
   lockEnvironment(new_env, bindings = TRUE)
 
+  datanames <- .get_sorted_datanames(datanames = datanames, join_keys = join_keys, env = env)
+
   methods::new(
     "teal_data",
     env = new_env,

R/teal_data-datanames.R

@@ -42,11 +42,27 @@ setMethod("datanames", signature = "qenv.error", definition = function(x) {
 setGeneric("datanames<-", function(x, value) standardGeneric("datanames<-"))
 setMethod("datanames<-", signature = c("teal_data", "character"), definition = function(x, value) {
   checkmate::assert_subset(value, names(x@env))
-  x@datanames <- value
+  x@datanames <- .get_sorted_datanames(datanames = value, join_keys = x@join_keys, env = x@env)
   methods::validObject(x)
   x
 })
 setMethod("datanames<-", signature = c("qenv.error", "character"), definition = function(x, value) {
   methods::validObject(x)
   x
 })
+
+
+#' @keywords internal
+.get_sorted_datanames <- function(datanames, join_keys, env) {
+  child_parent <- sapply(
+    datanames,
+    function(name) parent(join_keys, name),
+    USE.NAMES = TRUE,
+    simplify = FALSE
+  )
+
+  union(
+    intersect(unlist(topological_sort(child_parent)), ls(env)),
+    datanames
+  )
+}

tests/testthat/test-datanames.R

@@ -41,3 +41,44 @@
   qec <- qe
   testthat::expect_identical(qe, qec)
 })
+
+# topological_order ----
+
+testthat::test_that("datanames are set in topological in constructor if join_keys are specified", {
+  data <-
+    teal_data(b = data.frame(), a = data.frame(), join_keys = join_keys(join_key("a", "b", "id")))
+  testthat::expect_identical(
+    datanames(data),
+    c("a", "b")
+  )
+})
+
+testthat::test_that("datanames return topological order of datasets once join_keys are specified", {
+  data <- within(teal_data(), {
+    ADTTE <- teal.data::rADTTE
+    iris <- iris
+    ADSL <- teal.data::rADSL
+  })
+  datanames(data) <- c("ADTTE", "iris", "ADSL")
+  join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
+  testthat::expect_identical(
+    datanames(data),
+    c("ADSL", "ADTTE", "iris")
+  )
+})
+
+testthat::test_that("datanames return topological order of datasets after datanames are caled after join_keys", {
+  data <- within(teal_data(), {
+    ADTTE <- teal.data::rADTTE
+    iris <- iris
+    ADSL <- teal.data::rADSL
+  })
+
+  join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADTTE")]
+  datanames(data) <- c("ADTTE", "iris", "ADSL")
+
+  testthat::expect_identical(
+    datanames(data),
+    c("ADSL", "ADTTE", "iris")
+  )
+})