211 [.teal_data S3 method

DESCRIPTION

@@ -72,10 +72,11 @@ Collate:
     'join_keys.R'
     'teal.data.R'
     'teal_data-class.R'
+    'teal_data-constructor.R'
     'teal_data-datanames.R'
+    'teal_data-extract.R'
     'teal_data-get_code.R'
     'teal_data-show.R'
-    'teal_data.R'
     'testhat-helpers.R'
     'topological_sort.R'
     'verify.R'

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("[",join_keys)
+S3method("[",teal_data)
 S3method("[<-",join_keys)
 S3method("[[<-",join_keys)
 S3method("join_keys<-",join_keys)

R/teal_data.R → R/teal_data-constructor.R

@@ -21,6 +21,9 @@
 #'
 #' @export
 #'
+#' @name teal_data
+#' @rdname teal_data
+#'
 #' @examples
 #' teal_data(x1 = iris, x2 = mtcars)
 #'

R/teal_data-extract.R

@@ -0,0 +1,38 @@
+#'
+#' @section Subsetting:
+#' `x[names]` subsets objects in `teal_data` environment and limit the code to the necessary needed to build limited
+#' objects.
+#'
+#' @param names (`character`) names of objects included in `teal_subset` to subset
+#' @param x (`teal_data`)
+#'
+#' @examples
+#'
+#' # Subsetting
+#' data <- teal_data()
+#' data <- eval_code(data, "a <- 1;b<-2")
+#' data["a"]
+#' data[c("a", "b")]
+#'
+#' join_keys(data) <- join_keys(join_key("a", "b", "x"))
+#' join_keys(data["a"]) # should show empty keys
+#' join_keys(data["b"])
+#' join_keys(data)["a"] # should show empty keys
+#' join_keys(data)["b"]
+#'
+#' @rdname teal_data
+#'
+#' @export
+`[.teal_data` <- function(x, names) {
+  checkmate::assert_class(names, "character")
+  names <- intersect(names, ls(get_env(x)))
+  if (!length(names)) {
+    warning("None of `names` elements exist in `teal_data`. Returning empty `teal_data`.")
+    return(teal_data())
+  }
+
+  x <- NextMethod("`[`", x) # takes 'names' from function's environment
+  x@join_keys <- x@join_keys[names]
+
+  x
+}

tests/testthat/test-extract.R

@@ -0,0 +1,42 @@
+testthat::test_that("`[.` returns empty teal_data for improper names", {
+  data <- teal_data(x = 1, a = 2)
+  testthat::expect_warning(
+    testthat::expect_equal(data["y"], teal_data())
+  )
+})
+
+testthat::test_that("`[.` handles empty names", {
+  data <- teal_data(x = 1, a = 2)
+  testthat::expect_warning(
+    testthat::expect_equal(data[character(0)], teal_data())
+  )
+})
+
+testthat::test_that("`[.` handles names as NA_character_", {
+  data <- teal_data(x = 1, a = 2)
+  testthat::expect_warning(
+    testthat::expect_equal(data[NA_character_], teal_data())
+  )
+})
+
+testthat::test_that("`[.` thorws warnings if names is NULL", {
+  data <- teal_data(x = 1, a = 2)
+  testthat::expect_error(data[NULL], "Assertion on 'names' failed: Must inherit from class 'character'")
+})
+
+testthat::test_that("`[.` thorws warnings if names is numeric", {
+  data <- teal_data(x = 1, a = 2)
+  testthat::expect_error(data[1], "Assertion on 'names' failed: Must inherit from class 'character'")
+})
+
+testthat::test_that("`[.` returns limited join_keys", {
+  data <- teal_data(a = 1, b = 2)
+
+  join_keys(data) <- join_keys(join_key("a", "b", "x"))
+  empty_join_keys <- join_keys()
+  attr(empty_join_keys, "names") <- character(0)
+  testthat::expect_equal(
+    join_keys(data["a"]), # By default   named list || names() is character(0)
+    empty_join_keys # By default unnamed list || names() is NULL
+  )
+})

vignettes/teal-data.Rmd

@@ -30,18 +30,25 @@ my_data <- within(
   {
     data1 <- data.frame(id = 1:10, x = 11:20)
     data2 <- data.frame(id = 1:10, x = 21:30)
+    data3 <- data.frame(id = 1:10, x = 31:40)
   }
 )
 
 # get objects stored in teal_data
 my_data[["data1"]]
-my_data[["data1"]]
+my_data[["data2"]]
+
+# limit objects stored in teal_data
+my_data[c("data1", "data3")]
 
 # get reproducible code
 get_code(my_data)
 
+# get code just for specific object
+get_code(my_data, names = "data2")
+
 # get or set datanames
-datanames(my_data) <- c("data1", "data2")
+datanames(my_data) <- c("data1", "data2", "data3")
 datanames(my_data)
 
 # print
@@ -93,4 +100,7 @@ join_keys(my_data) <- join_keys(
 )
 
 join_keys(my_data)
+
+# join_keys for limited object
+join_keys(my_data["child"])
 ```