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,50 @@
+#'
+#' @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_in_env <- intersect(names, ls(get_env(x)))
+  if (!length(names_in_env)) {
+    warning("None of `names` elements exist in `teal_data`. Returning empty `teal_data`.")
+    return(teal_data())
+  }
+  # From ?NextMethod
+  # To pass `names` to `NextMethod` - it looks like it needs to be called `names`
+  # and created in the environment of the function that calls `NextMehod`.
+
+  # NextMethod works by creating a special call frame for the next method. If no new arguments are supplied, the
+  # arguments will be the same in number, order and name as those to the current method but their values will be
+  # promises to evaluate their name in the current method and environment. Any named arguments matched to ... are
+  # handled specially: they either replace existing arguments of the same name or are appended to the argument list.
+  # They are passed on as the promise that was supplied as an argument to the current environment.
+  # (S does this differently!) If they have been evaluated in the current (or a previous environment) they remain
+  # evaluated. (This is a complex area, and subject to change: see the draft ‘R Language Definition’.)
+
+  names <- names_in_env
+  x <- NextMethod("`[`", x)
+  x@join_keys <- x@join_keys[names_in_env]
+
+  x
+}

tests/testthat/test-extract.R

@@ -0,0 +1,16 @@
+testthat::test_that("`[.` returns empty teal_data for improper names", {
+  data <- teal_data(x = 1, a = 2)
+  testthat::expect_equal(data["y"], teal_data())
+})
+
+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"])
 ```