feat(2606): adding list_search for nested data.table search

Author: manmita

R/tables.R

@@ -19,28 +19,98 @@ 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,
+                  list_search=FALSE, list_len_threshold=100000L)
 {
   # 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)) {
+
+  list_info = NULL
+  if (list_search) {
+    is_list = vapply_1b(obj, is.list)
+    dt_mask = logical(length(obj))
+    if (length(w)) dt_mask[w] = TRUE
+    is_df = vapply_1b(obj, is.data.frame)
+    list_candidates = which(is_list & !dt_mask & !is_df)
+
+    if (length(list_candidates)) {
+      n_extra = 0L
+      list_locations = vector("list", length(list_candidates))
+      for (j in seq_along(list_candidates)) {
+        obj_idx = list_candidates[j]
+        L = obj[[obj_idx]]
+        if (!is.list(L)) next
+        lenL = length(L)
+        if (is.finite(list_len_threshold) && lenL > list_len_threshold) next
+        elem_is_dt = vapply_1b(L, is.data.table)
+        idx = which(elem_is_dt)
+        if (length(idx)) {
+          list_locations[[j]] = idx
+          n_extra = n_extra + length(idx)
+        }
+      }
+
+      if (n_extra) {
+        list_info = data.table(NAME=character(n_extra), NROW=0L, NCOL=0L, MB=0.0, COLS=list(), KEY=list(), INDICES=list())
+        extra_row = 0L
+        for (j in seq_along(list_candidates)) {
+          obj_idx = list_candidates[j]
+          idx = list_locations[[j]]
+          if (is.null(idx) || !length(idx)) next
+          L = obj[[obj_idx]]
+          obj_name = names[obj_idx]
+          elem_names = names(L)
+          for (k in idx) {
+            extra_row = extra_row + 1L
+            DT = L[[k]]
+            if (!is.null(elem_names) && length(elem_names) >= k && nzchar(elem_names[k])) {
+              nm = paste0(obj_name, "$", elem_names[k])
+            } else {
+              nm = paste0(obj_name, "[[", k, "]]")
+            }
+            set(list_info, extra_row, "NAME", nm)
+            set(list_info, extra_row, "NROW", nrow(DT))
+            set(list_info, extra_row, "NCOL", ncol(DT))
+            if (is.function(mb)) set(list_info, extra_row, "MB", as.integer(mb(DT)/1048576L))
+            if (!is.null(tt<-names(DT))) set(list_info, extra_row, "COLS", tt)
+            if (!is.null(tt<-key(DT))) set(list_info, extra_row, "KEY", tt)
+            if (index && !is.null(tt<-indices(DT))) set(list_info, extra_row, "INDICES", tt)
+          }
+        }
+      }
+    }
+  }
+
+  info = NULL
+  if (length(w)) {
+    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]]]
+      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.null(list_info) && nrow(list_info)) {
+    if (is.null(info)) {
+      info = list_info
+    } else {
+      info = rbind(info, list_info)
+    }
+  }
+
+  if (is.null(info) || !nrow(info)) {
     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]]]
-    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 (!order.col %chin% names(info)) stopf("order.col='%s' not a column name of info", order.col)