Merge branch 'issue_2606' of https://github.com/Rdatatable/data.table into issue_2606

Author: venom1204

.ci/atime/tests.R

@@ -286,5 +286,18 @@ test.list <- atime::atime_test_list(
     Slow = "548410d23dd74b625e8ea9aeb1a5d2e9dddd2927",   # Parent of the first commit in the PR (https://github.com/Rdatatable/data.table/commit/548410d23dd74b625e8ea9aeb1a5d2e9dddd2927)
     Fast = "c0b32a60466bed0e63420ec105bc75c34590865e"),  # Commit in the PR (https://github.com/Rdatatable/data.table/pull/7144/commits) that uses a much faster implementation
 
+  "tables() !recursive refactor in #2606" = atime::atime_test(
+    N = as.integer(10^seq(1, 4, by=0.5)),
+    setup = {
+      test_env <- new.env()
+      for (i in 1:N) {
+        assign(paste0("dt_perf_test", i), data.table(a=1), envir = test_env)
+        assign(paste0("vec_perf_test", i), 1, envir = test_env)
+      }
+    },
+    expr = {data.table::tables(env = test_env, silent = TRUE, index = TRUE); NULL},
+    "before" = "5bb645082aa5c4a295cdd211a5a75c849d590b75",
+    "after" = "8978cf201d8d228506e1e96d3eda7e542471720a"),
+
     tests=extra.test.list)
 # nolint end: undesirable_operator_linter.

NEWS.md

@@ -56,6 +56,8 @@
 
 13. New `mergelist()` and `setmergelist()` similarly work _a la_ `Reduce()` to recursively merge a `list` of data.tables, [#599](https://github.com/Rdatatable/data.table/issues/599). Different join modes (_left_, _inner_, _full_, _right_, _semi_, _anti_, and _cross_) are supported through the `how` argument; duplicate handling goes through the `mult` argument. `setmergelist()` carefully avoids copies where one is not needed, e.g. in a 1:1 left join. Thanks Patrick Nicholson for the FR (in 2013!), @jangorecki for the PR, and @MichaelChirico for extensive reviews and fine-tuning.
 
+14. `tables()` now supports a `recursive=TRUE` argument to detect `data.table` objects nested within plain lists, such as those produced by `split()` or manual list construction, [#2606](https://github.com/Rdatatable/data.table/issues/2606). The recursive search skips data.frame and data.table objects to avoid descending into list-columns. Nested data.tables are reported with intuitive R-like names using $ and [[ ]] notation. Thanks to @MichaelChirico for the suggestion and @venom1204 for the implementation.
+
 ### BUG FIXES
 
 1. `fread()` no longer warns on certain systems on R 4.5.0+ where the file owner can't be resolved, [#6918](https://github.com/Rdatatable/data.table/issues/6918). Thanks @ProfFancyPants for the report and PR.

R/tables.R

@@ -19,30 +19,68 @@ type_size = function(DT) {
 }
 
 tables = function(mb=type_size, order.col="NAME", width=80L,
-                  env=parent.frame(), silent=FALSE, index=FALSE)
+                  env=parent.frame(), silent=FALSE, index=FALSE, recursive=FALSE)
 {
   # Prints name, size and colnames of all data.tables in the calling environment by default
   mb_name = as.character(substitute(mb))
   if (isTRUE(mb)) { mb=type_size; mb_name="type_size" }
   names = ls(envir=env, all.names=TRUE)  # include "hidden" objects (starting with .)
-  obj = mget(names, envir=env)  # doesn't copy; mget is ok with ... unlike get, #5197
-  w = which(vapply_1b(obj, is.data.table))
-  if (!length(w)) {
+  objs = mget(names, envir=env)  # doesn't copy; mget is ok with ... unlike get, #5197
+  found_items = list()
+  if (recursive) {
+    agenda = mapply(function(obj, name) list(obj=obj, name=name), objs, names, SIMPLIFY=FALSE, USE.NAMES=FALSE)
+    visited_env = new.env(hash=TRUE)
+
+    while (length(agenda)) {
+      current_item = agenda[[1L]]
+      agenda[[1L]] = NULL
+      x = current_item$obj
+      x_name = current_item$name
+      if (is.data.table(x)) {
+        found_items[[length(found_items) + 1L]] = list(name=x_name, obj=x)
+        next
+      }
+      if (is.list(x) && !is.data.frame(x)) {
+        # Cycle detection
+        addr = address(x)
+        if (exists(addr, envir=visited_env, inherits=FALSE)) next
+        assign(addr, TRUE, envir=visited_env)
+
+        item_names = names(x)
+        children_to_add = vector("list", length(x))
+        for (i in seq_along(x)) {
+          child_name = if (!is.null(item_names) && nzchar(item_names[i])) {
+            paste0(x_name, "$", item_names[i])
+          } else {
+            paste0(x_name, "[[", i, "]]")
+          }
+          children_to_add[[i]] = list(obj=x[[i]], name=child_name)
+        }
+        agenda = c(rev(children_to_add), agenda)
+      }
+    }
+  } else {
+    w = which(vapply_1b(objs, is.data.table))
+    if (length(w)) {
+      found_items = lapply(w, function(i) list(name=names[i], obj=objs[[i]]))
+    }
+  }
+  if (!length(found_items)) {
     if (!silent) catf("No objects of class data.table exist in %s\n", if (identical(env, .GlobalEnv)) ".GlobalEnv" else format(env))
     return(invisible(data.table(NULL)))
   }
-  info = data.table(NAME=names[w], NROW=0L, NCOL=0L, MB=0.0, COLS=list(), KEY=list(), INDICES=list())
-  for (i in seq_along(w)) {  # avoid rbindlist(lapply(DT_names)) in case of a large number of tables
-    DT = obj[[w[i]]]
+  info = data.table(NAME=vapply_1c(found_items, `[[`, "name"), NROW=0L, NCOL=0L, MB=0.0, COLS=list(), KEY=list(), INDICES=list())
+  for (i in seq_along(found_items)) {  # avoid rbindlist(lapply(DT_names)) in case of a large number of tables
+    DT = found_items[[i]]$obj
     set(info, i, "NROW", nrow(DT))
     set(info, i, "NCOL", ncol(DT))
     if (is.function(mb)) set(info, i, "MB", as.integer(mb(DT)/1048576L)) # i.e. 1024**2
     if (!is.null(tt<-names(DT))) set(info, i, "COLS", tt)  # TODO: don't need these if()s when #5526 is done
     if (!is.null(tt<-key(DT))) set(info, i, "KEY", tt)
     if (index && !is.null(tt<-indices(DT))) set(info, i, "INDICES", tt)
   }
-  if (!is.function(mb)) info[,MB:=NULL]
-  if (!index)           info[,INDICES:=NULL]
+  if (!is.function(mb)) info$MB = NULL
+  if (!index)           info$INDICES = NULL
   if (!order.col %chin% names(info)) stopf("order.col='%s' not a column name of info", order.col)
   info = info[base::order(info[[order.col]])]  # base::order to maintain locale ordering of table names
   if (!silent) {

inst/tests/tests.Rraw

@@ -21536,3 +21536,37 @@ f = tempfile()
 writeLines(c('a', rep('0x1.ffffp0', 10000L), '0x1.ff\x9fp0', rep('0x1.ffffp0', 20000L)), f)
 test(2334, names(fread(f)), "a")
 unlink(f)
+
+#2606 Recursive tables() naming convention
+local({
+  lst_named    <- list(inner=data.table(a=1))
+  lst_unnamed  <- list(data.table(b=2))
+  nested       <- list(l1=list(l2=data.table(c=3)))
+  mixed        <- list(data.table(x=1), y=data.table(z=2))
+  mixed_nested <- list(A=list(data.table(p=1), q=data.table(q=2)))
+  out <- tables(recursive=TRUE)$NAME
+  expected <- c(
+    "lst_named$inner", "lst_unnamed[[1]]", "nested$l1$l2",
+    "mixed[[1]]", "mixed$y",
+    "mixed_nested$A[[1]]", "mixed_nested$A$q")
+  test(2335.1, out, sort(expected))
+})
+local({
+  dt <- data.table(val=42)
+  e <- new.env()
+  e$dt <- dt
+  e$self <- e # possible infinite loop if we're not careful
+  test(2335.2, tables(recursive=TRUE, env=e)$NAME, "dt")
+})
+local({
+  test_obj <- local({
+    common_list <- list(dt_inner=data.table(d=4))
+    outer_list <- list(first=common_list, unique=data.table(e=5))
+    outer_list$second <- outer_list$first
+    outer_list
+  })
+  out <- tables(recursive=TRUE)$NAME
+  test(2335.3, length(out), 2L)
+  test(2335.4, "test_obj$unique" %in% out)
+  test(2335.5, sum(grepl("\\$dt_inner$", out)), 1L)
+})

man/tables.Rd

@@ -5,8 +5,9 @@
   Convenience function for concisely summarizing some metadata of all \code{data.table}s in memory (or an optionally specified environment).
 }
 \usage{
-tables(mb=type_size, order.col="NAME", width=80,
-       env=parent.frame(), silent=FALSE, index=FALSE)
+tables(mb=type_size, order.col="NAME", width=80L,
+       env=parent.frame(), silent=FALSE, index=FALSE,
+       recursive=FALSE)
 }
 \arguments{
   \item{mb}{ a function which accepts a \code{data.table} and returns its size in bytes. By default, \code{type_size} (same as \code{TRUE}) provides a fast lower bound by excluding the size of character strings in R's global cache (which may be shared) and excluding the size of list column items (which also may be shared). A column \code{"MB"} is included in the output unless \code{FALSE} or \code{NULL}. }
@@ -15,6 +16,9 @@ tables(mb=type_size, order.col="NAME", width=80,
   \item{env}{ An \code{environment}, typically the \code{.GlobalEnv} by default, see Details. }
   \item{silent}{ \code{logical}; should the output be printed? }
   \item{index}{ \code{logical}; if \code{TRUE}, the column \code{INDICES} is added to indicate the indices assorted with each object, see \code{\link{indices}}. }
+  \item{recursive}{ \code{logical}; if \code{TRUE}, \code{tables} will perform a full,
+    iterative search into list objects to find nested data.tables.
+    Defaults to \code{FALSE} for backward compatibility. }
 }
 \details{
 Usually \code{tables()} is executed at the prompt, where \code{parent.frame()} returns \code{.GlobalEnv}. \code{tables()} may also be useful inside functions where \code{parent.frame()} is the local scope of the function; in such a scenario, simply set it to \code{.GlobalEnv} to get the same behaviour as at prompt.
@@ -32,5 +36,12 @@ DT = data.table(A=1:10, B=letters[1:10])
 DT2 = data.table(A=1:10000, ColB=10000:1)
 setkey(DT,B)
 tables()
+
+# Finding data.tables nested in a list
+dt_list <- list(a = data.table(x=1:5), b = data.table(y=6:10))
+# By default, nested tables are not shown:
+tables()
+# Use recursive=TRUE to find them:
+tables(recursive = TRUE)
 }
 \keyword{ data }