added condition

Author: venom1204

R/tables.R

@@ -19,21 +19,62 @@ 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)) {
-    if (!silent) catf("No objects of class data.table exist in %s\n", if (identical(env, .GlobalEnv)) ".GlobalEnv" else format(env))
+  found_items = list()
+  if (recursive) {
+    agenda <- lapply(seq_along(obj), function(i) list(obj = obj[[i]], name = names[i]))
+    visited_env <- new.env(hash = TRUE)
+
+    while (length(agenda) > 0L) {
+      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(obj, is.data.table))
+    if (length(w)) {
+      found_items = lapply(w, function(i) list(name=names[i], obj=obj[[i]]))
+    }
+  }
+  if (!length(found_items)) { # MODIFIED: Check `found_items` instead of `w`
+    if (!silent) catf("No objects of class data.table exist in %s%s\n",
+                      if (identical(env, .GlobalEnv)) ".GlobalEnv" else format(env),
+                      if (recursive) " (recursively)" else "") # NEW: More informative message
     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(found_items, `[[`, "name", FUN.VALUE=character(1L)),
+                    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

inst/tests/tests.Rraw

@@ -21365,3 +21365,28 @@ test(2328.1, levels(droplevels(DT)$f), character())
 DT[, i := integer()]
 DT[, f2 := factor()]
 test(2328.2, droplevels(DT), data.table(f=factor(), i=integer(), f2=factor()))
+
+#2606
+test(2329.1, {
+  dt1 <- data.table(a = 1)
+  lst <- list(inner = dt1)
+  res <- tables(recursive=TRUE)
+  any(res$NAME == "lst$inner")
+}, TRUE)
+test(2329.2, {
+  lst <- list(data.table(b = 2))
+  res <- tables(recursive=TRUE)
+  any(grepl("^lst\\[\\[1\\]\\]$", res$NAME))
+}, TRUE)
+test(2329.3, {
+  nested <- list(l1 = list(l2 = data.table(c = 3)))
+  res <- tables(recursive=TRUE)
+  any(res$NAME == "nested$l1$l2")
+}, TRUE)
+test(2329.4, {
+  cycle <- list()
+  cycle[[1]] <- cycle
+  cycle[[2]] <- data.table(x = 1)
+  res <- tables(recursive=TRUE)
+  any(res$NAME == "cycle[[2]]") && !"cycle[[1]]" %in% res$NAME
+}, TRUE)

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 }