lobstr/0000755000176200001440000000000015105623727011567 5ustar liggesuserslobstr/tests/0000755000176200001440000000000015105455414012725 5ustar liggesuserslobstr/tests/testthat/0000755000176200001440000000000015105623727014571 5ustar liggesuserslobstr/tests/testthat/test-ast.R0000644000176200001440000000142015105450613016445 0ustar liggesuserstest_that("quosures print same as expressions", { expect_equal(ast_tree(quo(x)), ast_tree(expr(x))) }) test_that("can print complex expression", { skip_on_os("windows") x <- expr(function(x) if (x > 1) f(y$x, "x", g())) expect_snapshot({ ast(!!x) }) }) test_that("can print complex expression without unicode", { old <- options(lobstr.fancy.tree = FALSE) on.exit(options(old)) x <- expr(function(x) if (x > 1) f(y$x, "x", g())) expect_snapshot({ ast(!!x) }) }) test_that("can print scalar expressions nicely", { old <- options(lobstr.fancy.tree = FALSE) on.exit(options(old)) x <- expr(list( logical = c(FALSE, TRUE, NA), integer = 1L, double = 1, character = "a", complex = 1i )) expect_snapshot({ ast(!!x) }) }) lobstr/tests/testthat/test-tree.R0000644000176200001440000001156415105450613016627 0ustar liggesuserstest_that("Array-like indices can be shown or hidden", { testthat::skip_on_os("windows") expect_snapshot({ tree(list(a = "a", "b", "c"), index_unnamed = TRUE) }) expect_snapshot({ tree(list(a = "a", "b", "c"), index_unnamed = FALSE) }) }) test_that("Atomic arrays have sensible defaults w/ truncation for longer than 10-elements", { testthat::skip_on_os("windows") expect_snapshot( tree( list( name = "vectored list", num_vec = 1:10, char_vec = letters ) ) ) expect_snapshot( tree( list( name = "vectored list", num_vec = 1:10, char_vec = letters ), hide_scalar_types = FALSE ) ) }) test_that("Large and multiline strings are handled gracefully", { testthat::skip_on_os("windows") expect_snapshot({ long_strings <- list( "normal string" = "first element", "really long string" = paste(rep(letters, 4), collapse = ""), "vec of long strings" = c( "a long\nand multi\nline string element", "a fine length", "another long\nand also multi\nline string element" ) ) # No truncation of first string # Really long single string is truncated and elipsesed # Short string inside vector with long strings is not truncated tree(long_strings) # Newline removal can be disabled tree(long_strings, remove_newlines = FALSE) }) }) test_that("Max depth and length can be enforced", { # This test also disables the unicode printing so it can be run on windows # platforms old_opts <- options("lobstr.fancy.tree" = FALSE) on.exit(options(old_opts)) expect_snapshot({ deep_list <- list( list( id = "b", val = 1, children = list( list(id = "b1", val = 2.5), list( id = "b2", val = 8, children = list( list(id = "b21", val = 4) ) ) ) ), list(id = "a", val = 2) ) tree(deep_list, max_depth = 1) tree(deep_list, max_depth = 2) tree(deep_list, max_depth = 3) tree(deep_list, max_length = 0) tree(deep_list, max_length = 2) tree(deep_list, max_depth = 1, max_length = 4) }) }) test_that("Missing values are caught and printed properly", { testthat::skip_on_os("windows") expect_snapshot( tree( list( "null-element" = NULL, "NA-element" = NA ) ) ) }) test_that("non-named elements in named list", { testthat::skip_on_os("windows") expect_snapshot( tree(list("a" = 1, "el w/o id")) ) }) test_that("Attributes are properly displayed as special children nodes", { testthat::skip_on_os("windows") expect_snapshot({ list_w_attrs <- structure( list( structure( list(id = "a", val = 2), level = 2, name = "first child" ), structure( list( id = "b", val = 1, children = list( list(id = "b1", val = 2.5) ) ), level = 2, name = "second child", class = "custom-class" ), level = "1", name = "root" ) ) # Shows attributes tree(list_w_attrs, show_attributes = TRUE) # Hides attributes (default) tree(list_w_attrs, show_attributes = FALSE) }) }) test_that("Can optionally recurse into environments", { testthat::skip_on_os("windows") # Wrapped in a local to avoid different environment setup for code running in # test_that instead of interactively # Can't use snapshots here because environment address change on each run env_printing <- capture.output( local( { ea <- rlang::env(d = 4, e = 5) tree(rlang::env(ea, a = 1, b = 2, c = 3)) }, envir = rlang::global_env() ) ) # Seven total nodes should be printed expect_equal( length(env_printing), 4 ) # Printed only the names we expected expect_equal( mean( grepl( pattern = "(environment|a|b|c):", env_printing ) ), 1 ) # Should only print two environment nodes (aka didn't escape past global env) expect_equal( sum(grepl(pattern = " "3.5.0") # Currently reported size is 640 B # If regular vector would be 4,000,040 B # This test is conservative so shouldn't fail in case representation # changes in the future expect_true(obj_size(1:1e6) < 10000) }) test_that("can compute size of deferred string vectors", { x <- 1:10 names(x) <- 10:1 y <- names(x) obj_size(y) # Just assert that it doesn't crash succeed("Didn't crash") }) # Environment sizes ----------------------------------------------------------- test_that("terminal environments have size zero", { expect_equal(obj_size(globalenv()), new_bytes(0)) expect_equal(obj_size(baseenv()), new_bytes(0)) expect_equal(obj_size(emptyenv()), new_bytes(0)) expect_equal(obj_size(asNamespace("stats")), new_bytes(0)) }) test_that("environment size computed recursively", { e <- new.env(parent = emptyenv()) e_size <- obj_size(e) f <- new.env(parent = e) obj_size(f) expect_equal(obj_size(f), 2 * obj_size(e)) }) test_that("size of function includes environment", { f <- function() { y <- 1:1e3 a ~ b } g <- function() { y <- 1:1e3 function() 10 } expect_true(obj_size(f()) > obj_size(1:1e3)) expect_true(obj_size(g()) > obj_size(1:1e3)) }) test_that("size doesn't include parents of current environment", { x <- c(1:1e4) embedded <- (function() { g <- function() { x <- c(1:1e3) a ~ b } obj_size(g()) })() expect_true(embedded < obj_size(x)) }) test_that("support dots in closure environments", { fn <- (function(...) function() NULL)(foo) expect_error(obj_size(fn), NA) }) test_that("supports cons cells", { cell <- new_node(1, 2) expect_equal( obj_size(cell), obj_size(new_node(NULL, NULL)) + obj_size(1) + obj_size(2) ) non_nil_terminated_list <- new_node(1, new_node(2, 3)) expect_equal( obj_size(non_nil_terminated_list), obj_size(new_node(1, NULL)) + obj_size(cell) ) }) lobstr/tests/testthat/test-sxp.R0000644000176200001440000000425415105452054016501 0ustar liggesuserstest_that("computes spanning tree", { x <- 1:10 y <- list(x, x, x) obj <- sxp(y) expect_false(attr(obj[[1]], "has_seen")) expect_true(attr(obj[[2]], "has_seen")) }) test_that("captures names of special environments", { x <- list( emptyenv(), baseenv(), globalenv() ) obj <- sxp(x) expect_equal(attr(obj[[1]], "value"), "empty") expect_equal(attr(obj[[2]], "value"), "base") expect_equal(attr(obj[[3]], "value"), "global") }) test_that("captures names of lists", { x <- list(a = 1, b = 2, c = 3) obj <- sxp(x) expect_named(obj, c(names(x), "_attrib")) }) test_that("can expand lists", { x <- c("xxx", "xxx", "y") obj <- sxp(x, expand = "character") expect_length(obj, 3) expect_equal(attr(obj[[1]], "ref"), attr(obj[[2]], "ref")) }) test_that("can inspect active bindings", { e <- new.env(hash = FALSE) env_bind_active(e, f = function() stop("!")) x <- sxp(e) expect_named(x, c("f", "_enclos")) }) # Regression tests -------------------------------------------------------- test_that("can inspect all atomic vectors", { x <- list( TRUE, 1L, 1, "3", 1i, raw(1) ) expect_snapshot(sxp(x)) }) test_that("can inspect functions", { f <- function(x, y = 1, ...) x + 1 attr(f, "srcref") <- NULL environment(f) <- globalenv() expect_snapshot(sxp(f)) }) test_that("can inspect environments", { e1 <- new.env(parent = emptyenv(), size = 5L) e1$x <- 10 e1$y <- e1 e2 <- new.env(parent = e1, size = 5L) expect_snapshot({ print(sxp(e2)) print(sxp(e2, expand = "environment", max_depth = 5L)) }) }) test_that("can expand altrep", { skip_if_not(getRversion() >= "3.5") skip_if_not(.Machine$sizeof.pointer == 8) # _class RAWSXP has different size expect_snapshot({ x <- 1:10 print(sxp(x, expand = "altrep", max_depth = 4L)) }) }) test_that("can inspect cons cells", { expect_snapshot({ cell <- new_node(1, 2) sxp(cell) non_nil_terminated_list <- new_node(1, new_node(2, 3)) sxp(non_nil_terminated_list) }) }) test_that("fix error message when `expand` argument contains invalid classes", { expect_snapshot(error = TRUE, { sxp(1, expand = "invalid_class") }) }) lobstr/tests/testthat/_snaps/0000755000176200001440000000000015105452054016045 5ustar liggesuserslobstr/tests/testthat/_snaps/sxp.md0000644000176200001440000000450215105452054017202 0ustar liggesusers# can inspect all atomic vectors Code sxp(x) Output [1] () [2] () [3] () [4] () [5] () [6] () [7] () # can inspect functions Code sxp(f) Output [1] () _formals [2] () x [3] () y [4] () ... [3] _body [5] () ... _env [6] () # can inspect environments Code print(sxp(e2)) Output [1] () _enclos [2] () x [3] () y [2] _enclos [4] () Code print(sxp(e2, expand = "environment", max_depth = 5L)) Output [1] () _frame _hashtab [3] () _enclos [4] () _frame _hashtab [5] () [6] () x [7] () [8] () y [4] _enclos [9] () # can expand altrep Code x <- 1:10 print(sxp(x, expand = "altrep", max_depth = 4L)) Output [1] (altrep ) _class [2] () _attrib [3] () [4] () [5] () [6] () _data1 [7] () _data2 # can inspect cons cells Code cell <- new_node(1, 2) sxp(cell) Output [1] () [2] () _cdr [3] () Code non_nil_terminated_list <- new_node(1, new_node(2, 3)) sxp(non_nil_terminated_list) Output [1] () [2] () [3] () _cdr [4] () # fix error message when `expand` argument contains invalid classes Code sxp(1, expand = "invalid_class") Condition Error in `sxp()`: ! `expand` must contain only values from: 'character', 'altrep', 'environment', 'call', 'bytecode'. lobstr/tests/testthat/_snaps/size.md0000644000176200001440000000016015104665430017341 0ustar liggesusers# combined bytes are aligned Code new_bytes(c(400, 4e+05)) Output * 400 B * 400 kB lobstr/tests/testthat/_snaps/ast.md0000644000176200001440000000173415104665430017166 0ustar liggesusers# can print complex expression Code ast(!!x) Output █─`function` ├─█─x = `` ├─█─`if` │ ├─█─`>` │ │ ├─x │ │ └─1 │ └─█─f │ ├─█─`$` │ │ ├─y │ │ └─x │ ├─"x" │ └─█─g └─ # can print complex expression without unicode Code ast(!!x) Output o-`function` +-o-x = `` +-o-`if` | +-o-`>` | | +-x | | \-1 | \-o-f | +-o-`$` | | +-y | | \-x | +-"x" | \-o-g \- # can print scalar expressions nicely Code ast(!!x) Output o-list +-logical = o-c | +-FALSE | +-TRUE | \-NA +-integer = 1L +-double = 1 +-character = "a" \-complex = 1i lobstr/tests/testthat/_snaps/ref.md0000644000176200001440000000213015104665430017142 0ustar liggesusers# basic list display Code x <- 1:10 y <- list(x, x) ref(x, list(), list(x, x, x), list(a = x, b = x), letters) Output [1:0x001] █ [2:0x002] █ [3:0x003] ├─[1:0x001] ├─[1:0x001] └─[1:0x001] █ [4:0x004] ├─a = [1:0x001] └─b = [1:0x001] [5:0x005] # basic environment display Code e <- env(a = 1:10) e$b <- e$a e$c <- e ref(e) Output █ [1:0x001] ├─a = [2:0x002] ├─b = [2:0x002] └─c = [1:0x001] # environment shows objects beginning with . Code e <- env(. = 1:10) ref(e) Output █ [1:0x001] └─. = [2:0x002] # can display ref to global string pool on request Code ref(c("string", "string", "new string"), character = TRUE) Output █ [1:0x001] ├─[2:0x002] ├─[2:0x002] └─[3:0x003] lobstr/tests/testthat/_snaps/tree.md0000644000176200001440000001313315104665431017333 0ustar liggesusers# Array-like indices can be shown or hidden Code tree(list(a = "a", "b", "c"), index_unnamed = TRUE) Output ├─a: "a" ├─2: "b" └─3: "c" --- Code tree(list(a = "a", "b", "c"), index_unnamed = FALSE) Output ├─a: "a" ├─"b" └─"c" # Atomic arrays have sensible defaults w/ truncation for longer than 10-elements Code tree(list(name = "vectored list", num_vec = 1:10, char_vec = letters)) Output ├─name: "vectored list" ├─num_vec: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 └─char_vec: "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", ... --- Code tree(list(name = "vectored list", num_vec = 1:10, char_vec = letters), hide_scalar_types = FALSE) Output ├─name: "vectored list" ├─num_vec: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 └─char_vec: "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", ... # Large and multiline strings are handled gracefully Code long_strings <- list(`normal string` = "first element", `really long string` = paste( rep(letters, 4), collapse = ""), `vec of long strings` = c( "a long\nand multi\nline string element", "a fine length", "another long\nand also multi\nline string element")) tree(long_strings) Output ├─normal string: "first element" ├─really long string: "abcdefghijklmnopqrstuvwxyzabcdef..." └─vec of long strings: "a long↵and m...", "a fine length", "another long..." Code tree(long_strings, remove_newlines = FALSE) Output ├─normal string: "first element" ├─really long string: "abcdefghijklmnopqrstuvwxyzabcdef..." └─vec of long strings: "a long and m...", "a fine length", "another long..." # Max depth and length can be enforced Code deep_list <- list(list(id = "b", val = 1, children = list(list(id = "b1", val = 2.5), list(id = "b2", val = 8, children = list(list(id = "b21", val = 4))))), list( id = "a", val = 2)) tree(deep_list, max_depth = 1) Output +-... \-... Code tree(deep_list, max_depth = 2) Output +- | +-id: "b" | +-val: 1 | \-children: ... \- +-id: "a" \-val: 2 Code tree(deep_list, max_depth = 3) Output +- | +-id: "b" | +-val: 1 | \-children: | +-... | \-... \- +-id: "a" \-val: 2 Code tree(deep_list, max_length = 0) Output ... Code tree(deep_list, max_length = 2) Output +- ... Code tree(deep_list, max_depth = 1, max_length = 4) Output +-... \-... # Missing values are caught and printed properly Code tree(list(`null-element` = NULL, `NA-element` = NA)) Output ├─null-element: └─NA-element: NA # non-named elements in named list Code tree(list(a = 1, "el w/o id")) Output ├─a: 1 └─"el w/o id" # Attributes are properly displayed as special children nodes Code list_w_attrs <- structure(list(structure(list(id = "a", val = 2), level = 2, name = "first child"), structure(list(id = "b", val = 1, children = list(list( id = "b1", val = 2.5))), level = 2, name = "second child", class = "custom-class"), level = "1", name = "root")) tree(list_w_attrs, show_attributes = TRUE) Output ├─ │ ├─id: "a" │ ├─val: 2 │ ├┄attr(,"names"): "id", "val" │ ├┄attr(,"level"): 2 │ └┄attr(,"name"): "first child" ├─S3 │ ├─id: "b" │ ├─val: 1 │ ├─children: │ ┊ └─ │ ┊ ├─id: "b1" │ ┊ ├─val: 2.5 │ ┊ └┄attr(,"names"): "id", "val" │ ├┄attr(,"names"): "id", "val", "children" │ ├┄attr(,"level"): 2 │ ├┄attr(,"name"): "second child" │ └┄attr(,"class"): "custom-class" ├─level: "1" ├─name: "root" └┄attr(,"names"): "", "", "level", "name" Code tree(list_w_attrs, show_attributes = FALSE) Output ├─ │ ├─id: "a" │ └─val: 2 ├─S3 │ ├─id: "b" │ ├─val: 1 │ └─children: │ └─ │ ├─id: "b1" │ └─val: 2.5 ├─level: "1" └─name: "root" # Function arguments get printed Code tree(list(no_args = function() { }, few_args = function(a, b, c) { }, lots_of_args = function(d, e, f, g, h, i, j, k, l, m, n, o, p) { })) Output ├─no_args: function() ├─few_args: function(a, b, c) └─lots_of_args: function(d, e, f, g, h, ...) # Handles expressions Code tree(list(a = quote(a), b = quote(a + 1), c = y ~ mx + b)) Output ├─a: a ├─b: a + 1 └─c: S3 y ~ mx + b # Hidden lists dont cause infinite recursion Code tree(package_version("1.2.3")) Output S3 └─1, 2, 3 lobstr/tests/testthat/test-ref.R0000644000176200001440000000211014253143157016434 0ustar liggesuserstest_that("basic list display", { skip_on_os("windows") test_addr_reset() expect_snapshot({ x <- 1:10 y <- list(x, x) ref( x, list(), list(x, x, x), list(a = x, b = x), letters ) }) }) test_that("basic environment display", { skip_on_os("windows") test_addr_reset() expect_snapshot({ e <- env(a = 1:10) e$b <- e$a e$c <- e ref(e) }) }) test_that("environment shows objects beginning with .", { skip_on_os("windows") test_addr_reset() expect_snapshot({ e <- env(. = 1:10) ref(e) }) }) test_that("can display ref to global string pool on request", { skip_on_os("windows") test_addr_reset() expect_snapshot({ ref(c("string", "string", "new string"), character = TRUE) }) }) test_that("custom methods are never called (#30)", { # `[[.numeric_number` causes infinite recursion expect_error(ref(package_version("1.1.1")), NA) e <- env(a = 1:10) e$b <- e$a e$c <- e # `as.list.data.frame`(, ...) fails class(e) <- "data.frame" expect_error(ref(e), NA) }) lobstr/tests/testthat.R0000644000176200001440000000007013162455060014703 0ustar liggesuserslibrary(testthat) library(lobstr) test_check("lobstr") lobstr/MD50000644000176200001440000000432415105623727012102 0ustar liggesusersda8c27655e2b76fb66061454a878cf48 *DESCRIPTION 55585878199a4aa76ee6070d47853de8 *LICENSE d15184f1067513154810f50b2839bf67 *NAMESPACE 8c92cefe5879a6ce2f0996e0236ba7ee *NEWS.md 93d58f53eeb7461eb9be11353d16243b *R/address.R 887513c48bdad71580fe033e2b2552ec *R/ast.R 35a421512b15bd05139b98bda4e2cfbb *R/cpp11.R 67faf9bf8522879cbbb2e94170f96f4c *R/cst.R df6cc46bc7fae1a55b713f3d5065b35a *R/lobstr-package.R 8ff1133e3902f5f682911cb060af0d78 *R/lobstr.R 77012918976575fd5b176b95a1d18fb3 *R/mem.R 471b6c034f79b901e05a6577ffd9b537 *R/ref.R f4bbdecc00615ef10fce35e53a901772 *R/size.R c23930f95645b37710493c4bdee0f756 *R/sxp.R 4ce288d1cacc4fa2220d726b1959c950 *R/tree.R 03aab0d1289681e1df94ae9c0121e6c8 *R/utils.R b6cfd4c5de698c60682b683233fb33fc *README.md 267bfee1a7dd458cb068810b671a9c35 *man/ast.Rd ec937196239fb6b6959b59e5f7764caa *man/cst.Rd b51d8ae702c213f25503ea546758b280 *man/figures/logo.png 17061ea6756974cbb5d3a5242ec19c80 *man/lobstr-package.Rd b6292677acd723224e8bb27b7938225e *man/mem_used.Rd de54fc026d86e22ce7e10db07ab32377 *man/obj_addr.Rd f8b5ee446ac342e149827cad29a7f658 *man/obj_size.Rd dcb225128ccb2e5e9828868ac64a5bff *man/ref.Rd 9f1f4cd1468e49216fa231ba3ef4176e *man/sxp.Rd 89e3465b46568090f937cf5f74fb1f96 *man/tree.Rd 0b86e73f611aed90ccdbbf5e4b47c719 *man/tree_label.Rd 7c62303a0a4b1c458db6c9ddb414bbe0 *src/address.cpp e43e492d938def548457ba14753bbcdf *src/cpp11.cpp bb13ebf70223e108d7297240ad3623bf *src/inspect.cpp 657ca1bb38d32fd5e28a6642587927d8 *src/size.cpp 116ee3d8ba3358749868e32ee00718ab *src/utils.h 35f98f5a6ad54e371e4e1f6638702a56 *tests/testthat.R d1c5d4f6ca1bb06511f91dcc97e4411c *tests/testthat/_snaps/ast.md 5edf1832e72c5c1b136d22b718fbc5a5 *tests/testthat/_snaps/ref.md 49c177f4b6c0498ea010271f15c41f09 *tests/testthat/_snaps/size.md e626cf8f4af98873b6b2b52fdbfb9e2f *tests/testthat/_snaps/sxp.md 5beb76d4bc2736d98bead602cace3859 *tests/testthat/_snaps/tree.md 6dbe9bae43164489a61eafc76d13efdd *tests/testthat/test-address.R 8516fb7771e07a79d042097e54b52955 *tests/testthat/test-ast.R 7a1b90369e931672aff2d32874300b72 *tests/testthat/test-ref.R a9db43ed65811b50a5295a645cf14441 *tests/testthat/test-size.R fd876417491e0cae430590d9f5b4c7c0 *tests/testthat/test-sxp.R 91439f783675942e53423287c3e3b5b4 *tests/testthat/test-tree.R lobstr/R/0000755000176200001440000000000015105452054011761 5ustar liggesuserslobstr/R/size.R0000644000176200001440000000736515105450613013070 0ustar liggesusers#' Calculate the size of an object. #' #' `obj_size()` computes the size of an object or set of objects; #' `obj_sizes()` breaks down the individual contribution of multiple objects #' to the total size. #' #' @section Compared to `object.size()`: #' Compared to [object.size()], `obj_size()`: #' #' * Accounts for all types of shared values, not just strings in #' the global string pool. #' #' * Includes the size of environments (up to `env`) #' #' * Accurately measures the size of ALTREP objects. #' #' @section Environments: #' `obj_size()` attempts to take into account the size of the #' environments associated with an object. This is particularly important #' for closures and formulas, since otherwise you may not realise that you've #' accidentally captured a large object. However, it's easy to over count: #' you don't want to include the size of every object in every environment #' leading back to the [emptyenv()]. `obj_size()` takes #' a heuristic approach: it never counts the size of the global environment, #' the base environment, the empty environment, or any namespace. #' #' Additionally, the `env` argument allows you to specify another #' environment at which to stop. This defaults to the environment from which #' `obj_size()` is called to prevent double-counting of objects created #' elsewhere. #' #' @export #' @param ... Set of objects to compute size. #' @param env Environment in which to terminate search. This defaults to the #' current environment so that you don't include the size of objects that #' are already stored elsewhere. #' #' Regardless of the value here, `obj_size()` never looks past the #' global or base environments. #' #' @return An estimate of the size of the object, in bytes. #' @examples #' # obj_size correctly accounts for shared references #' x <- runif(1e4) #' obj_size(x) #' #' z <- list(a = x, b = x, c = x) #' obj_size(z) #' #' # this means that object size is not transitive #' obj_size(x) #' obj_size(z) #' obj_size(x, z) #' #' # use obj_size() to see the unique contribution of each component #' obj_sizes(x, z) #' obj_sizes(z, x) #' obj_sizes(!!!z) #' #' # obj_size() also includes the size of environments #' f <- function() { #' x <- 1:1e4 #' a ~ b #' } #' obj_size(f()) #' #' #' # In R 3.5 and greater, `:` creates a special "ALTREP" object that only #' # stores the first and last elements. This will make some vectors much #' # smaller than you'd otherwise expect #' obj_size(1:1e6) obj_size <- function(..., env = parent.frame()) { dots <- list2(...) size <- obj_size_(dots, env, size_node(), size_vector()) new_bytes(size) } #' @rdname obj_size #' @export obj_sizes <- function(..., env = parent.frame()) { dots <- list2(...) size <- obj_csize_(dots, env, size_node(), size_vector()) names(size) <- names(dots) new_bytes(size) } size_node <- function(x) as.vector(utils::object.size(quote(expr = ))) size_vector <- function(x) as.vector(utils::object.size(logical())) new_bytes <- function(x) { structure(x, class = "lobstr_bytes") } #' @export format.lobstr_bytes <- function(x, ...) { prettyunits::pretty_bytes(unclass(x)) } #' @export print.lobstr_bytes <- function(x, ...) { fx <- format(x) if (length(x) == 1) { cat_line(fx) } else { if (!is.null(names(x))) { cat_line(format(names(x)), ": ", fx) } else { cat_line("* ", fx) } } invisible(x) } #' @export c.lobstr_bytes <- function(...) { new_bytes(NextMethod()) } #' @export `[.lobstr_bytes` <- function(...) { new_bytes(NextMethod()) } # Helpers for interactive exploration ------------------------------------- comp <- function(x) { base <- utils::object.size(x) lobstr <- obj_size(x) c(base = base, lobstr = lobstr, diff = base - lobstr) } insp <- function(x) { eval(quote(.Internal(inspect(x)))) } lobstr/R/sxp.R0000644000176200001440000001333715105452054012725 0ustar liggesusers#' Inspect an object #' #' `sxp(x)` is similar to `.Internal(inspect(x))`, recursing into the C data #' structures underlying any R object. The main difference is the output is a #' little more compact, it recurses fully, and avoids getting stuck in infinite #' loops by using a depth-first search. It also returns a list that you can #' compute with, and carefully uses colour to highlight the most important #' details. #' #' The name `sxp` comes from `SEXP`, the name of the C data structure that #' underlies all R objects. #' #' @param x Object to inspect #' @param max_depth Maximum depth to recurse. Use `max_depth = Inf` (with care!) #' to recurse as deeply as possible. Skipped elements will be shown as `...`.` #' @param expand Optionally, expand components of the true that are usually #' suppressed. Use: #' #' * "character" to show underlying entries in the global string pool. #' * "environment" to show the underlying hashtables. #' * "altrep" to show the underlying data. #' * "call" to show the full AST (but [ast()] is usually superior) #' * "bytecode" to show generated bytecode. #' @family object inspectors #' @export #' @examples #' x <- list( #' TRUE, #' 1L, #' runif(100), #' "3" #' ) #' sxp(x) #' #' # Expand "character" to see underlying CHARSXP entries in the global #' # string pool #' x <- c("banana", "banana", "apple", "banana") #' sxp(x) #' sxp(x, expand = "character") #' #' # Expand altrep to see underlying data #' x <- 1:10 #' sxp(x) #' sxp(x, expand = "altrep") #' #' # Expand environmnets to see the underlying implementation details #' e1 <- new.env(hash = FALSE, parent = emptyenv(), size = 3L) #' e2 <- new.env(hash = TRUE, parent = emptyenv(), size = 3L) #' e1$x <- e2$x <- 1:10 #' #' sxp(e1) #' sxp(e1, expand = "environment") #' sxp(e2, expand = "environment") sxp <- function(x, expand = character(), max_depth = 5L) { opts <- c("character", "altrep", "environment", "call", "bytecode") if (any(!expand %in% opts)) { abort( sprintf( "`expand` must contain only values from: '%s'.", paste(opts, collapse = "', '") ) ) } obj_inspect_( x, max_depth - 1L, opts[[1]] %in% expand, opts[[2]] %in% expand, opts[[3]] %in% expand, opts[[4]] %in% expand, opts[[5]] %in% expand ) } #' @export format.lobstr_inspector <- function(x, ..., depth = 0, name = NA) { indent <- paste0(rep(" ", depth), collapse = "") id <- crayon::bold(attr(x, "id")) if (!is_testing()) { addr <- paste0(":", crayon::silver(attr(x, "addr"))) } else { addr <- "" } if (attr(x, "type") == 0) { desc <- crayon::silver("") } else if (attr(x, "has_seen")) { desc <- paste0("[", attr(x, "id"), addr, "]") } else { type <- sexp_type(attr(x, "type")) if (sexp_is_vector(type)) { length <- paste0("[", attr(x, "length"), "]") } else { length <- NULL } if (!is.null(attr(x, "value"))) { value <- paste0(": ", attr(x, "value")) } else { value <- NULL } if (!is_testing()) { no_references <- attr(x, "no_references") maybe_shared <- attr(x, "maybe_shared") if (no_references == 1) { references <- "refs:0" } else if (maybe_shared == 0) { references <- "refs:1" } else { references <- "refs:2+" } } else { references <- NULL } # show altrep, object, named etc sxpinfo <- paste0( if (attr(x, "altrep")) "altrep ", if (attr(x, "object")) "object ", references ) desc <- paste0( "[", id, addr, "] ", "<", crayon::cyan(type), length, value, "> ", "(", sxpinfo, ")" ) } name <- if (!identical(name, "")) { paste0(crayon::italic(crayon::silver(name)), " ") } paste0(indent, name, desc) } #' @export print.lobstr_inspector <- function(x, ..., depth = 0, name = "") { cat_line(format(x, depth = depth, name = name)) if (isTRUE(attr(x, "skip"))) { indent <- paste0(rep(" ", depth + 1), collapse = "") cat_line(indent, crayon::silver("...")) } for (i in seq_along(x)) { print(x[[i]], depth = depth + 1, name = names(x)[[i]]) } } sxp_view <- function(x, expand = character()) { if (!"tools:rstudio" %in% search()) { abort("Can only be called from within RStudio") } env <- as.environment("tools:rstudio") old_opt <- options(crayon.enabled = FALSE) on.exit(options(old_opt), add = TRUE) old_fun <- env$.rs.explorer.objectDesc on.exit(env$.rs.addFunction("explorer.objectDesc", old_fun), add = TRUE) assign(".rs.explorer.objectDesc", envir = env, function(x) { if (inherits(x, "lobstr_inspector")) { format.lobstr_inspector(x) } else { old_fun(x) } }) obj <- sxp(x, expand = expand) env$.rs.viewHook(NULL, obj, "Object inspector") # explorer.objectDesc() is called lazily so this is a crude hack Sys.sleep(10) } # helpers ----------------------------------------------------------------- sexp_type <- function(x) { unname(SEXPTYPE[as.character(x)]) } sexp_is_vector <- function(x) { x %in% c( "LGLSXP", "INTSXP", "REALSXP", "STRSXP", "RAWSXP", "CPLXSXP", "VECSXP", "EXPRSXP" ) } SEXPTYPE <- c( "0" = "NILSXP", "1" = "SYMSXP", "2" = "LISTSXP", "3" = "CLOSXP", "4" = "ENVSXP", "5" = "PROMSXP", "6" = "LANGSXP", "7" = "SPECIALSXP", "8" = "BUILTINSXP", "9" = "CHARSXP", "10" = "LGLSXP", "13" = "INTSXP", "14" = "REALSXP", "15" = "CPLXSXP", "16" = "STRSXP", "17" = "DOTSXP", "18" = "ANYSXP", "19" = "VECSXP", "20" = "EXPRSXP", "21" = "BCODESXP", "22" = "EXTPTRSXP", "23" = "WEAKREFSXP", "24" = "RAWSXP", "25" = "S4SXP", "30" = "NEWSXP", "31" = "FREESXP", "99" = "FUNSXP" ) lobstr/R/cpp11.R0000644000176200001440000000144015104666125013034 0ustar liggesusers# Generated by cpp11: do not edit by hand obj_addr_ <- function(name, env) { .Call(`_lobstr_obj_addr_`, name, env) } obj_addrs_ <- function(x) { .Call(`_lobstr_obj_addrs_`, x) } obj_inspect_ <- function(x, max_depth, expand_char, expand_altrep, expand_env, expand_call, expand_bytecode) { .Call(`_lobstr_obj_inspect_`, x, max_depth, expand_char, expand_altrep, expand_env, expand_call, expand_bytecode) } v_size <- function(n, element_size) { .Call(`_lobstr_v_size`, n, element_size) } obj_size_ <- function(objects, base_env, sizeof_node, sizeof_vector) { .Call(`_lobstr_obj_size_`, objects, base_env, sizeof_node, sizeof_vector) } obj_csize_ <- function(objects, base_env, sizeof_node, sizeof_vector) { .Call(`_lobstr_obj_csize_`, objects, base_env, sizeof_node, sizeof_vector) } lobstr/R/ast.R0000644000176200001440000000454515105450613012702 0ustar liggesusers#' Display the abstract syntax tree #' #' This is a useful alternative to `str()` for expression objects. #' #' @param x An expression to display. Input is automatically quoted, #' use `!!` to unquote if you have already captured an expression object. #' @family object inspectors #' @export #' @examples #' # Leaves #' ast(1) #' ast(x) #' #' # Simple calls #' ast(f()) #' ast(f(x, 1, g(), h(i()))) #' ast(f()()) #' ast(f(x)(y)) #' #' ast((x + 1)) #' #' # Displaying expression already stored in object #' x <- quote(a + b + c) #' ast(x) #' ast(!!x) #' #' # All operations have this same structure #' ast(if (TRUE) 3 else 4) #' ast(y <- x * 10) #' ast(function(x = 1, y = 2) { x + y } ) #' #' # Operator precedence #' ast(1 * 2 + 3) #' ast(!1 + !1) ast <- function(x) { expr <- enexpr(x) new_raw(ast_tree(expr)) } ast_tree <- function(x, layout = box_chars()) { if (is_quosure(x)) { x <- quo_squash(x) } # base cases if (rlang::is_syntactic_literal(x)) { return(ast_leaf_constant(x)) } else if (is_symbol(x)) { return(ast_leaf_symbol(x)) } else if (!is.pairlist(x) && !is.call(x)) { return(paste0("")) } # recursive case subtrees <- lapply(x, ast_tree, layout = layout) subtrees <- name_subtree(subtrees) n <- length(x) if (n == 0) { character() } else if (n == 1) { str_indent(subtrees[[1]], paste0(layout$n, layout$h), " ") } else { c( str_indent( subtrees[[1]], paste0(layout$n, layout$h), paste0(layout$v, " ") ), unlist(lapply( subtrees[-c(1, n)], str_indent, paste0(layout$j, layout$h), paste0(layout$v, " ") )), str_indent(subtrees[[n]], paste0(layout$l, layout$h), " ") ) } } name_subtree <- function(x) { nm <- names(x) if (is.null(nm)) { return(x) } has_name <- nm != "" label <- paste0(crayon::italic(grey(nm)), " = ") indent <- str_dup(" ", nchar(nm) + 3) x[has_name] <- Map(str_indent, x[has_name], label[has_name], indent[has_name]) x } ast_leaf_symbol <- function(x) { x <- as.character(x) if (!is.syntactic(x)) { x <- encodeString(x, quote = "`") } crayon::bold(crayon::magenta(x)) } ast_leaf_constant <- function(x) { if (is.complex(x)) { paste0(Im(x), "i") } else { deparse(x) } } is.syntactic <- function(x) make.names(x) == x lobstr/R/ref.R0000644000176200001440000000664115105450613012666 0ustar liggesusers#' Display tree of references #' #' This tree display focusses on the distinction between names and values. #' For each reference-type object (lists, environments, and optional character #' vectors), it displays the location of each component. The display #' shows the connection between shared references using a locally unique id. #' #' @param ... One or more objects #' @param character If `TRUE`, show references from character vector in to #' global string pool #' @export #' @family object inspectors #' @examples #' x <- 1:100 #' ref(x) #' #' y <- list(x, x, x) #' ref(y) #' ref(x, y) #' #' e <- new.env() #' e$e <- e #' e$x <- x #' e$y <- list(x, e) #' ref(e) #' #' # Can also show references to global string pool if requested #' ref(c("x", "x", "y")) #' ref(c("x", "x", "y"), character = TRUE) ref <- function(..., character = FALSE) { x <- list(...) seen <- child_env(emptyenv(), `__next_id` = 1) out <- lapply(x, ref_tree, character = character, seen = seen) n <- length(x) if (n > 1) { out[-n] <- lapply(out[-n], function(x) c(x, "")) } new_raw(unlist(out)) } ref_tree <- function( x, character = FALSE, seen = child_env(emptyenv()), layout = box_chars() ) { addr <- obj_addr(x) has_seen <- env_has(seen, addr) id <- obj_id(seen, addr) desc <- obj_desc(addr, type_sum(x), has_seen, id) # Not recursive or already seen if (!has_references(x, character) || has_seen) { return(desc) } # Remove classes to avoid custom methods (note that environments cannot be unclasse()ed) attr(x, "class") <- NULL # recursive cases if (is.list(x)) { subtrees <- lapply( x, ref_tree, layout = layout, seen = seen, character = character ) } else if (is.environment(x)) { subtrees <- lapply( as.list(x, all.names = TRUE), ref_tree, layout = layout, seen = seen, character = character ) } else if (is.character(x)) { subtrees <- ref_tree_chr(x, layout = layout, seen = seen) } subtrees <- name_subtree(subtrees) self <- str_indent(desc, paste0(layout$n, " "), paste0(layout$v, " ")) n <- length(subtrees) if (n == 0) { return(self) } c( self, unlist(lapply( subtrees[-n], str_indent, paste0(layout$j, layout$h), paste0(layout$v, " ") )), str_indent(subtrees[[n]], paste0(layout$l, layout$h), " ") ) } type_sum <- function(x) { if (is_installed("pillar")) { pillar::type_sum(x) } else { typeof(x) } } obj_desc <- function(addr, type, has_seen, id) { if (has_seen) { paste0("[", grey(paste0(id, ":", addr)), "]") } else { paste0("[", crayon::bold(id), ":", addr, "] ", "<", type, ">") } } has_references <- function(x, character = FALSE) { is_list(x) || is.environment(x) || (character && is_character(x)) } ref_tree_chr <- function( x, layout = box_chars(), seen = child_env(emptyenv()) ) { addrs <- obj_addrs(x) has_seen <- logical(length(x)) ids <- integer(length(x)) for (i in seq_along(addrs)) { has_seen[[i]] <- env_has(seen, addrs[[i]]) ids[[i]] <- obj_id(seen, addrs[[i]]) } type <- paste0('string: "', str_truncate(x, 10), '"') out <- Map(obj_desc, addrs, type, has_seen, ids) names(out) <- names(x) out } obj_id <- function(env, ref) { if (env_has(env, ref)) { env_get(env, ref) } else { id <- env_get(env, "__next_id") env_poke(env, "__next_id", id + 1) env_poke(env, ref, id) id } } lobstr/R/cst.R0000644000176200001440000000213115104665254012701 0ustar liggesusers#' Call stack tree #' #' Shows the relationship between calls on the stack. This function #' combines the results of [sys.calls()] and [sys.parents()] yielding a display #' that shows how frames on the call stack are related. #' #' @export #' @examples #' # If all evaluation is eager, you get a single tree #' f <- function() g() #' g <- function() h() #' h <- function() cst() #' f() #' #' # You get multiple trees with delayed evaluation #' try(f()) #' #' # Pay attention to the first element of each subtree: each #' # evaluates the outermost call #' f <- function(x) g(x) #' g <- function(x) h(x) #' h <- function(x) x #' try(f(cst())) #' #' # With a little ingenuity you can use it to see how NSE #' # functions work in base R #' with(mtcars, {cst(); invisible()}) #' invisible(subset(mtcars, {cst(); cyl == 0})) #' #' # You can also get unusual trees by evaluating in frames #' # higher up the call stack #' f <- function() g() #' g <- function() h() #' h <- function() eval(quote(cst()), parent.frame(2)) #' f() cst <- function() { x <- rlang::trace_back() print(x, simplify = "none") invisible() } lobstr/R/tree.R0000644000176200001440000003201215105450613013040 0ustar liggesusers#' Pretty tree-like object printing #' #' A cleaner and easier to read replacement for `str` for nested list-like #' objects #' #' @param x A tree like object (list, etc.) #' @param index_unnamed Should children of containers without names have indices #' used as stand-in? #' @param max_depth How far down the tree structure should be printed. E.g. `1` #' means only direct children of the root element will be shown. Useful for #' very deep lists. #' @param show_environments Should environments be treated like normal lists and #' recursed into? #' @param hide_scalar_types Should atomic scalars be printed with type and #' length like vectors? E.g. `x <- "a"` would be shown as `x: "a"` #' instead of `x: "a"`. #' @param max_length How many elements should be printed? This is useful in case #' you try and print an object with 100,000 items in it. #' @param val_printer Function that values get passed to before being drawn to #' screen. Can be used to color or generally style output. #' @param class_printer Same as `val_printer` but for the the class types of #' non-atomic tree elements. #' @param show_attributes Should attributes be printed as a child of the list or #' avoided? #' @param remove_newlines Should character strings with newlines in them have #' the newlines removed? Not doing so will mess up the vertical flow of the #' tree but may be desired for some use-cases if newline structure is #' important to understanding object state. #' @param tree_chars List of box characters used to construct tree. Needs #' elements `$h` for horizontal bar, `$hd` for dotted horizontal bar, `$v` for #' vertical bar, `$vd` for dotted vertical bar, `$l` for l-bend, and `$j` for #' junction (or middle child). #' @param ... Ignored (used to force use of names) #' #' @return console output of structure #' #' @examples #' #' x <- list( #' list(id = "a", val = 2), #' list( #' id = "b", #' val = 1, #' children = list( #' list(id = "b1", val = 2.5), #' list( #' id = "b2", #' val = 8, #' children = list( #' list(id = "b21", val = 4) #' ) #' ) #' ) #' ), #' list( #' id = "c", #' val = 8, #' children = list( #' list(id = "c1"), #' list(id = "c2", val = 1) #' ) #' ) #' ) #' #' # Basic usage #' tree(x) #' #' # Even cleaner output can be achieved by not printing indices #' tree(x, index_unnamed = FALSE) #' #' # Limit depth if object is potentially very large #' tree(x, max_depth = 2) #' #' # You can customize how the values and classes are printed if desired #' tree(x, val_printer = function(x) { #' paste0("_", x, "_") #' }) #' @export tree <- function( x, ..., index_unnamed = FALSE, max_depth = 10L, max_length = 1000L, show_environments = TRUE, hide_scalar_types = TRUE, val_printer = crayon::blue, class_printer = crayon::silver, show_attributes = FALSE, remove_newlines = TRUE, tree_chars = box_chars() ) { rlang::check_dots_empty() # Pack up the unchanging arguments into a list and send to tree_internal termination_type <- tree_internal( x, opts = list( index_unnamed = index_unnamed, max_depth = max_depth, max_length = max_length, show_envs = show_environments, hide_scalar_types = hide_scalar_types, val_printer = val_printer, class_printer = class_printer, show_attributes = show_attributes, remove_newlines = remove_newlines, tree_chars = tree_chars ) ) if (termination_type == "early") { cat("...", "\n") } invisible(x) } # Tree printing internal function # # This is the internal function for the main tree printing code. It wraps the # static options arguments from the user-facing `tree()` into a single opts # list to make recursive calls cleaner. It also has arguments that as it is # called successively but the end-user shouldn't see or use. tree_internal <- function( x, x_id = NULL, branch_hist = character(0), opts, attr_mode = FALSE, counter_env = rlang::new_environment( data = list(n_printed = 0, envs_seen = c()) ) ) { counter_env$n_printed <- counter_env$n_printed + 1 # Stop if we've reached the max number of times printed desired if (counter_env$n_printed > opts$max_length) { return("early") } # Since self-loops can occur in environments check to see if we've seen any # environments before already_seen <- FALSE if (rlang::is_environment(x)) { already_seen <- any(vapply( counter_env$envs_seen, identical, x, FUN.VALUE = logical(1) )) if (!already_seen) { # If this environment is new, add it to the seen counter_env$envs_seen[[length(counter_env$envs_seen) + 1]] <- x } } depth <- length(branch_hist) # Build branch string from branch history # Start with empty spaces branch_chars <- rep_len(" ", depth) branch_chars[branch_hist == "child"] <- paste0(opts$tree_chars$v, " ") branch_chars[grepl("attr", branch_hist, fixed = TRUE)] <- paste0( opts$tree_chars$vd, " " ) # Next update the final element (aka the current step) with the correct branch type last_step <- branch_hist[depth] root_node <- length(branch_hist) == 0 branch_chars[depth] <- if (root_node) { "" } else { paste0( if (grepl("last", last_step)) opts$tree_chars$l else opts$tree_chars$j, if (grepl("attribute", last_step)) { opts$tree_chars$hd } else { opts$tree_chars$h } ) } # Build label label <- paste0( x_id, make_type_abrev(x, opts$hide_scalar_types), if (!rlang::is_null(x_id) && x_id != "") ": ", tree_label(x, opts), if (already_seen) " (Already seen)" ) # Figure out how many children we have (plus attributes if they are being # printed) so we can setup how to proceed x_attributes <- attributes(x) if (attr_mode) { # Filter out "names" attribute as this is already shown by tree x_attributes <- x_attributes[names(x_attributes) != "names"] } has_attributes <- length(x_attributes) > 0 && opts$show_attributes has_children <- has_attributes || length(x) > 1 max_depth_reached <- depth >= opts$max_depth && has_children # Do the actual printing to the console with an optional ellipses to indicate # we've reached the max depth and won't recurse more cat( paste(branch_chars, collapse = ""), label, if (max_depth_reached) "...", "\n", sep = "" ) # ===== Start recursion logic if (already_seen || max_depth_reached) { return("Normal finish") } if (rlang::is_list(x) || is_printable_env(x)) { # Coerce current object to a plain list. This is necessary as some s3 # classes override `[[` and return funky stuff like themselves (see s3 class # "package_version") children <- if (is_printable_env(x)) { # Environments are funky as they don't have names before conversion to list # but do after, so let them handle their conversion. # We use all.names = TRUE in an effort to fully explain the object as.list.environment(x, all.names = TRUE) } else { # By wiping all attributes except for the names we force the object to be # a plain list. This is inspired by the (now depreciated) rlang::as_list(). attributes(x) <- list(names = names(x)) as.list(x) } # Traverse children, if any exist n_children <- length(children) child_names <- names(children) # If children have names, give them the names for (i in seq_along(children)) { id <- child_names[i] if ((rlang::is_null(id) || id == "") && opts$index_unnamed) { id <- crayon::italic(i) } child_type <- if (i < n_children) { "child" } else if (has_attributes) { # We use "attrs" here instead of full "attribute" so a grep for # attributes just gets plain "attribute" or "last-attribute" but a grep # for "attr" gets all attribute related types "pre-attrs" } else { "last-child" } termination_type <- Recall( x = children[[i]], x_id = id, branch_hist = c(branch_hist, child_type), opts = opts, counter_env = counter_env ) if (termination_type == "early") { return(termination_type) } } } # ===== End recursion logic # Add any attributes as an "attr" prefixed children at end if (has_attributes) { n_attributes <- length(x_attributes) for (i in seq_len(n_attributes)) { termination_type <- Recall( x = x_attributes[[i]], x_id = crayon::italic(paste0( "attr(,\"", names(x_attributes)[i], "\")" )), opts = opts, branch_hist = c( branch_hist, paste0(if (i == n_attributes) "last-", "attribute") ), attr_mode = TRUE, # Let tree know this is an attribute counter_env = counter_env ) if (termination_type == "early") { return(termination_type) } } } # If all went smoothly we reach here "Normal finish" } # There are a few environments we don't want to recurse into is_printable_env <- function(x) { is_environment(x) && !(identical(x, rlang::global_env()) || identical(x, rlang::empty_env()) || identical(x, rlang::base_env()) || rlang::is_namespace(x)) } #' Build element or node label in tree #' #' These methods control how the value of a given node is printed. New methods #' can be added if support is needed for a novel class #' #' @inheritParams tree #' @param opts A list of options that directly mirrors the named arguments of #' [tree]. E.g. `list(val_printer = crayon::red)` is equivalent to #' `tree(..., val_printer = crayon::red)`. #' #' @export tree_label <- function(x, opts) { UseMethod("tree_label") } #' @export tree_label.function <- function(x, opts) { func_args <- collapse_and_truncate_vec(methods::formalArgs(x), 5) crayon::italic(paste0("function(", func_args, ")")) } #' @export tree_label.environment <- function(x, opts) { format.default(x) } #' @export tree_label.NULL <- function(x, opts) { "" } #' @export tree_label.character <- function(x, opts) { # Get rid of new-line so they don't break tree flow if (opts$remove_newlines) { x <- gsub("\\n", replacement = "\u21B5", x = x, perl = TRUE) } # Shorten strings if needed max_standalone_length <- 35 max_vec_length <- 15 max_length <- if (length(x) == 1) max_standalone_length else max_vec_length x <- truncate_string(x, max_length) tree_label.default(paste0("\"", x, "\""), opts) } #' @export tree_label.default <- function(x, opts) { if (rlang::is_atomic(x)) { opts$val_printer(collapse_and_truncate_vec(x, 10)) } else if (rlang::is_function(x)) { # Lots of times function-like functions don't actually trigger the s3 method # for function because they dont have function in their class-list. This # catches those. tree_label.function(x, opts) } else if (rlang::is_environment(x)) { # Environments also tend to have the same trouble as functions. For instance # the srcobject attached to a function's attributes is an environment but # doesn't report as one to s3. tree_label.environment(x, opts) } else if (rlang::is_expression(x) || rlang::is_formula(x)) { paste0(label_class(x, opts), " ", crayon::italic(deparse(x))) } else { # The "base-case" is simply a list-like object. label_class(x, opts) } } collapse_and_truncate_vec <- function(vec, max_length) { vec <- as.character(vec) too_long <- length(vec) > max_length if (too_long) { vec <- utils::head(vec, max_length) vec <- c(vec, "...") } paste0(vec, collapse = ", ") } truncate_string <- function(char_vec, max_length) { ifelse( nchar(char_vec) > max_length, # Since we add an elipses we need to take a bit more than the max length # off. The gsub adds elipses but also makes sure we dont awkwardly end on # a space. gsub( x = substr(char_vec, start = 1, max_length - 3), pattern = "\\s*$", replacement = "...", perl = TRUE ), char_vec ) } make_type_abrev <- function(x, omit_scalars) { if (!rlang::is_atomic(x) || (rlang::is_scalar_atomic(x) && omit_scalars)) { return("") } type_abrev <- switch( typeof(x), logical = "lgl", integer = "int", double = "dbl", character = "chr", complex = "cpl", expression = "expr", raw = "raw", "unknown" ) paste0("<", type_abrev, " [", format(length(x), big.mark = ","), "]>") } # Inspired by waldo:::friendly_type_of(). Prints the class name and hierarchy # encased in angle brackets along with a prefix that tells you what OO system # the object belongs to (if it does.) label_class <- function(x, opts) { if (is_missing(x)) { return("absent") } oo_prefix <- "" class_list <- if (!is.object(x)) { typeof(x) } else if (isS4(x)) { oo_prefix <- "S4" methods::is(x) } else if (inherits(x, "R6")) { oo_prefix <- "R6" setdiff(class(x), "R6") } else { oo_prefix <- "S3" class(x) } opts$class_printer( paste0(oo_prefix, "<", paste(class_list, collapse = "/"), ">") ) } lobstr/R/utils.R0000644000176200001440000000317615105450613013252 0ustar liggesusersis_testing <- function() { identical(Sys.getenv("TESTTHAT"), "true") } # CLI --------------------------------------------------------------------- box_chars <- function() { fancy <- getOption("lobstr.fancy.tree") %||% l10n_info()$`UTF-8` orange <- crayon::make_style("orange") if (fancy) { list( "h" = "\u2500", # - horizontal "hd" = "\u2504", # - horizontal dotted "v" = "\u2502", # | vertical "vd" = "\u250A", # | vertical dotted "l" = "\u2514", # \ leaf "j" = "\u251C", # + junction "n" = orange("\u2588") # X node ) } else { list( "h" = "-", "hd" = "-", # Just use normal chars for dotted "v" = "|", "vd" = "|", "l" = "\\", "j" = "+", "n" = orange("o") ) } } grey <- function(...) { crayon::make_style(grDevices::grey(0.5), grey = TRUE)(...) } # string ----------------------------------------------------------------- str_dup <- function(x, n) { vapply(n, function(i) paste0(rep(x, i), collapse = ""), character(1)) } str_indent <- function(x, first, rest) { if (length(x) == 0) { character() } else if (length(x) == 1) { paste0(first, x) } else { c( paste0(first, x[[1]]), paste0(rest, x[-1L]) ) } } str_truncate <- function(x, n) { too_long <- nchar(x, type = "width") > n x[too_long] <- paste0(substr(x[too_long], 1, n - 3), "...") x } new_raw <- function(x) { structure(x, class = "lobstr_raw") } #' @export print.lobstr_raw <- function(x, ...) { cat(paste(x, "\n", collapse = ""), sep = "") invisible(x) } cat_line <- function(...) { cat(paste0(..., "\n", collapse = "")) } lobstr/R/lobstr.R0000644000176200001440000000010113762501764013413 0ustar liggesusers#' @import rlang #' @useDynLib lobstr, .registration = TRUE NULL lobstr/R/lobstr-package.R0000644000176200001440000000013515104665254015010 0ustar liggesusers#' @keywords internal "_PACKAGE" ## usethis namespace: start ## usethis namespace: end NULL lobstr/R/address.R0000644000176200001440000000264213406773157013551 0ustar liggesusers#' Find memory location of objects and their children. #' #' `obj_addr()` gives the address of the value that `x` points to; #' `obj_addrs()` gives the address of the components the list, #' environment, and character vector `x` point to. #' #' `obj_addr()` has been written in such away that it avoids taking #' references to an object. #' #' @param x An object #' @export #' @examples #' # R creates copies lazily #' x <- 1:10 #' y <- x #' obj_addr(x) == obj_addr(y) #' #' y[1] <- 2L #' obj_addr(x) == obj_addr(y) #' #' y <- runif(10) #' obj_addr(y) #' z <- list(y, y) #' obj_addrs(z) #' #' y[2] <- 1.0 #' obj_addrs(z) #' obj_addr(y) #' #' # The address of an object is different every time you create it: #' obj_addr(1:10) #' obj_addr(1:10) #' obj_addr(1:10) obj_addr <- function(x) { x <- enquo(x) addr <- obj_addr_(quo_get_expr(x), quo_get_env(x)) if (is_testing()) { test_addr_get(addr) } else { addr } } #' @export #' @rdname obj_addr obj_addrs <- function(x) { addrs <- obj_addrs_(x) if (is_testing()) { vapply(addrs, test_addr_get, character(1), USE.NAMES = FALSE) } else { addrs } } test_addr <- child_env(emptyenv(), "__next_id" = 1) test_addr_get <- function(addr) { if (env_has(test_addr, addr)) { addr <- env_get(test_addr, addr) } else { addr <- obj_id(test_addr, addr) } sprintf("0x%03i", addr) } test_addr_reset <- function() { env_poke(test_addr, "__next_id", 1) } lobstr/R/mem.R0000644000176200001440000000143113251235323012657 0ustar liggesusers#' How much memory is currently used by R? #' #' `mem_used()` wraps around `gc()` and returns the exact number of bytes #' currently used by R. Note that changes will not match up exactly to #' [obj_size()] as session specific state (e.g. [.Last.value]) adds minor #' variations. #' #' @export #' @examples #' prev_m <- 0; m <- mem_used(); m - prev_m #' #' x <- 1:1e6 #' prev_m <- m; m <- mem_used(); m - prev_m #' obj_size(x) #' #' rm(x) #' prev_m <- m; m <- mem_used(); m - prev_m #' #' prev_m <- m; m <- mem_used(); m - prev_m mem_used <- function() { new_bytes(sum(gc()[, 1] * c(node_size(), 8))) } node_size <- function() { bit <- 8L * .Machine$sizeof.pointer if (!(bit == 32L || bit == 64L)) { stop("Unknown architecture", call. = FALSE) } if (bit == 32L) 28L else 56L } lobstr/src/0000755000176200001440000000000015105455415012353 5ustar liggesuserslobstr/src/size.cpp0000644000176200001440000002041415105452054014026 0ustar liggesusers#include #include #include #include #include #include "utils.h" [[cpp11::register]] double v_size(double n, int element_size) { if (n == 0) return 0; double vec_size = std::max(sizeof(SEXP), sizeof(double)); double elements_per_byte = vec_size / element_size; double n_bytes = ceil(n / elements_per_byte); // Rcout << n << " elements, each of " << elements_per_byte << " = " << // n_bytes << "\n"; double size = 0; // Big vectors always allocated in 8 byte chunks if (n_bytes > 16) size = n_bytes * 8; // For small vectors, round to sizes allocated in small vector pool else if (n_bytes > 8) size = 128; else if (n_bytes > 6) size = 64; else if (n_bytes > 4) size = 48; else if (n_bytes > 2) size = 32; else if (n_bytes > 1) size = 16; else if (n_bytes > 0) size = 8; // Size is pointer to struct + struct size return size; } bool r_env_has(SEXP env, SEXP symbol) { #if R_VERSION >= R_Version(4, 2, 0) return R_existsVarInFrame(env, symbol); #else return Rf_findVarInFrame3(env, symbol, FALSE) != R_UnboundValue; #endif } bool is_namespace(cpp11::environment env) { return env == R_BaseNamespace || r_env_has(env, Rf_install(".__NAMESPACE__.")); } // R equivalent // https://github.com/wch/r-source/blob/master/src/library/utils/src/size.c#L41 double obj_size_tree(SEXP x, cpp11::environment base_env, int sizeof_node, int sizeof_vector, std::set& seen, int depth) { // NILSXP is a singleton, so occupies no space. Similarly SPECIAL and // BUILTIN are fixed and unchanging if (TYPEOF(x) == NILSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP) return 0; // Don't count objects that we've seen before if (!seen.insert(x).second) return 0; // Rcout << "\n" << std::string(depth * 2, ' '); // Rprintf("type: %s", Rf_type2char(TYPEOF(x))); // Use sizeof(SEXPREC) and sizeof(VECTOR_SEXPREC) computed in R. // CHARSXP are treated as vectors for this purpose double size = (Rf_isVector(x) || TYPEOF(x) == CHARSXP) ? sizeof_vector : sizeof_node; #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) // Handle ALTREP objects if (ALTREP(x)) { SEXP klass = ALTREP_CLASS(x); size += 3 * sizeof(SEXP); size += obj_size_tree(klass, base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(R_altrep_data1(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(R_altrep_data2(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); return size; } #endif // CHARSXPs have fake attributes if (TYPEOF(x) != CHARSXP ) size += obj_size_tree(ATTRIB(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); switch (TYPEOF(x)) { // Vectors ------------------------------------------------------------------- // See details in v_size() // Simple vectors case LGLSXP: case INTSXP: size += v_size(XLENGTH(x), sizeof(int)); break; case REALSXP: size += v_size(XLENGTH(x), sizeof(double)); break; case CPLXSXP: size += v_size(XLENGTH(x), sizeof(Rcomplex)); break; case RAWSXP: size += v_size(XLENGTH(x), 1); break; // Strings case STRSXP: size += v_size(XLENGTH(x), sizeof(SEXP)); for (R_xlen_t i = 0; i < XLENGTH(x); i++) { size += obj_size_tree(STRING_ELT(x, i), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } break; case CHARSXP: size += v_size(LENGTH(x) + 1, 1); break; // Generic vectors case VECSXP: case EXPRSXP: case WEAKREFSXP: size += v_size(XLENGTH(x), sizeof(SEXP)); for (R_xlen_t i = 0; i < XLENGTH(x); ++i) { size += obj_size_tree(VECTOR_ELT(x, i), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } break; // Nodes --------------------------------------------------------------------- // https://github.com/wch/r-source/blob/master/src/include/Rinternals.h#L237-L249 // All have enough space for three SEXP pointers // Linked lists case DOTSXP: case LISTSXP: case LANGSXP: { if (x == R_MissingArg) { // Needed for DOTSXP break; } SEXP cons = x; for (; is_linked_list(cons); cons = CDR(cons)) { if (cons != x) { size += sizeof_node; } size += obj_size_tree(TAG(cons), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CAR(cons), base_env, sizeof_node, sizeof_vector, seen, depth + 1); } // Handle non-nil CDRs size += obj_size_tree(cons, base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; } case BCODESXP: size += obj_size_tree(TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CAR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CDR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; // Environments case ENVSXP: if (x == R_BaseEnv || x == R_GlobalEnv || x == R_EmptyEnv || x == base_env || is_namespace(x)) return 0; // Using node-based object accessors: CAR for FRAME, and TAG for HASHTAB. // If these accessors type-check their inputs in the future, we'll need to // iterate over environment elements using the environment API to collect // the sizes of contained elements. Unfortunately this means we'll have to // infer the size of the hash table frame itself using heuristics. size += obj_size_tree(CAR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(R_ParentEnv(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; // Functions case CLOSXP: #if (R_VERSION >= R_Version(4, 5, 0)) size += obj_size_tree(R_ClosureFormals(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); // R_ClosureBody/BODY is either a bare expression or a byte code that wraps // the expression along with other data. size += obj_size_tree(R_ClosureBody(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(R_ClosureEnv(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); #else size += obj_size_tree(FORMALS(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(BODY(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CLOENV(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); #endif break; case PROMSXP: // Using node-based object accessors: CAR for PRVALUE, CDR for PRCODE, and // TAG for PRENV. TODO: Iterate manually over the environment using // environment accessors. size += obj_size_tree(CAR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(CDR(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case EXTPTRSXP: size += sizeof(void *); // the actual pointer size += obj_size_tree(R_ExternalPtrProtected(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); size += obj_size_tree(R_ExternalPtrTag(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case S4SXP: size += obj_size_tree(TAG(x), base_env, sizeof_node, sizeof_vector, seen, depth + 1); break; case SYMSXP: break; default: cpp11::stop("Can't compute size of %s", Rf_type2char(TYPEOF(x))); } // Rprintf("type: %-10s size: %6.0f\n", Rf_type2char(TYPEOF(x)), size); return size; } [[cpp11::register]] double obj_size_(cpp11::list objects, cpp11::environment base_env, int sizeof_node, int sizeof_vector) { std::set seen; double size = 0; int n = objects.size(); for (int i = 0; i < n; ++i) { size += obj_size_tree(objects[i], base_env, sizeof_node, sizeof_vector, seen, 0); } return size; } [[cpp11::register]] cpp11::doubles obj_csize_(cpp11::list objects, cpp11::environment base_env, int sizeof_node, int sizeof_vector) { std::set seen; int n = objects.size(); cpp11::writable::doubles out(n); for (int i = 0; i < n; ++i) { out[i] = obj_size_tree(objects[i], base_env, sizeof_node, sizeof_vector, seen, 0); } return out; } lobstr/src/utils.h0000644000176200001440000000126315105452054013662 0ustar liggesusers#include #include inline std::string obj_addr_(SEXP x) { std::stringstream ss; ss << static_cast(x); return ss.str(); } static inline bool is_linked_list(SEXP x) { switch (TYPEOF(x)) { case DOTSXP: case LISTSXP: case LANGSXP: return true; default: return false; } } // Rf_length() crashes on flexible cells static inline R_xlen_t sxp_length(SEXP x) { if (TYPEOF(x) == LISTSXP) { R_xlen_t i = 0; while (is_linked_list(x)) { ++i; x = CDR(x); } return i; } else { return Rf_length(x); } } #if R_VERSION < R_Version(4, 5, 0) static inline SEXP R_ParentEnv(SEXP x) { return ENCLOS(x); } #endif lobstr/src/cpp11.cpp0000644000176200001440000000637015104666125014012 0ustar liggesusers// Generated by cpp11: do not edit by hand // clang-format off #include "cpp11/declarations.hpp" #include // address.cpp std::string obj_addr_(SEXP name, cpp11::environment env); extern "C" SEXP _lobstr_obj_addr_(SEXP name, SEXP env) { BEGIN_CPP11 return cpp11::as_sexp(obj_addr_(cpp11::as_cpp>(name), cpp11::as_cpp>(env))); END_CPP11 } // address.cpp std::vector obj_addrs_(SEXP x); extern "C" SEXP _lobstr_obj_addrs_(SEXP x) { BEGIN_CPP11 return cpp11::as_sexp(obj_addrs_(cpp11::as_cpp>(x))); END_CPP11 } // inspect.cpp cpp11::list obj_inspect_(SEXP x, double max_depth, bool expand_char, bool expand_altrep, bool expand_env, bool expand_call, bool expand_bytecode); extern "C" SEXP _lobstr_obj_inspect_(SEXP x, SEXP max_depth, SEXP expand_char, SEXP expand_altrep, SEXP expand_env, SEXP expand_call, SEXP expand_bytecode) { BEGIN_CPP11 return cpp11::as_sexp(obj_inspect_(cpp11::as_cpp>(x), cpp11::as_cpp>(max_depth), cpp11::as_cpp>(expand_char), cpp11::as_cpp>(expand_altrep), cpp11::as_cpp>(expand_env), cpp11::as_cpp>(expand_call), cpp11::as_cpp>(expand_bytecode))); END_CPP11 } // size.cpp double v_size(double n, int element_size); extern "C" SEXP _lobstr_v_size(SEXP n, SEXP element_size) { BEGIN_CPP11 return cpp11::as_sexp(v_size(cpp11::as_cpp>(n), cpp11::as_cpp>(element_size))); END_CPP11 } // size.cpp double obj_size_(cpp11::list objects, cpp11::environment base_env, int sizeof_node, int sizeof_vector); extern "C" SEXP _lobstr_obj_size_(SEXP objects, SEXP base_env, SEXP sizeof_node, SEXP sizeof_vector) { BEGIN_CPP11 return cpp11::as_sexp(obj_size_(cpp11::as_cpp>(objects), cpp11::as_cpp>(base_env), cpp11::as_cpp>(sizeof_node), cpp11::as_cpp>(sizeof_vector))); END_CPP11 } // size.cpp cpp11::doubles obj_csize_(cpp11::list objects, cpp11::environment base_env, int sizeof_node, int sizeof_vector); extern "C" SEXP _lobstr_obj_csize_(SEXP objects, SEXP base_env, SEXP sizeof_node, SEXP sizeof_vector) { BEGIN_CPP11 return cpp11::as_sexp(obj_csize_(cpp11::as_cpp>(objects), cpp11::as_cpp>(base_env), cpp11::as_cpp>(sizeof_node), cpp11::as_cpp>(sizeof_vector))); END_CPP11 } extern "C" { static const R_CallMethodDef CallEntries[] = { {"_lobstr_obj_addr_", (DL_FUNC) &_lobstr_obj_addr_, 2}, {"_lobstr_obj_addrs_", (DL_FUNC) &_lobstr_obj_addrs_, 1}, {"_lobstr_obj_csize_", (DL_FUNC) &_lobstr_obj_csize_, 4}, {"_lobstr_obj_inspect_", (DL_FUNC) &_lobstr_obj_inspect_, 7}, {"_lobstr_obj_size_", (DL_FUNC) &_lobstr_obj_size_, 4}, {"_lobstr_v_size", (DL_FUNC) &_lobstr_v_size, 2}, {NULL, NULL, 0} }; } extern "C" attribute_visible void R_init_lobstr(DllInfo* dll){ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); } lobstr/src/address.cpp0000644000176200001440000000303015105452054014474 0ustar liggesusers#include "utils.h" #include #include [[cpp11::register]] std::string obj_addr_(SEXP name, cpp11::environment env) { return obj_addr_(Rf_eval(name, env)); } void frame_addresses(SEXP frame, std::vector* refs) { for(SEXP cur = frame; cur != R_NilValue; cur = CDR(cur)) { SEXP obj = CAR(cur); if (obj != R_UnboundValue) refs->push_back(obj_addr_(obj)); } } void hash_table_addresses(SEXP table, std::vector* refs) { int n = Rf_length(table); for (int i = 0; i < n; ++i) frame_addresses(VECTOR_ELT(table, i), refs); } [[cpp11::register]] std::vector obj_addrs_(SEXP x) { int n = Rf_length(x); std::vector out; switch(TYPEOF(x)) { case STRSXP: for (int i = 0; i < n; ++i) { out.push_back(obj_addr_(STRING_ELT(x, i))); } break; case VECSXP: for (int i = 0; i < n; ++i) { out.push_back(obj_addr_(VECTOR_ELT(x, i))); } break; case ENVSXP: { // Using node-based object accessors: CAR for FRAME, and TAG for HASHTAB. // TODO: Iterate over environments using environment accessors. // We won't be able to provide an address for things like promises though. bool isHashed = TAG(x) != R_NilValue; if (isHashed) { hash_table_addresses(TAG(x), &out); } else { frame_addresses(CAR(x), &out); } break; } default: cpp11::stop( "`x` must be a list, environment, or character vector, not a %s.", Rf_type2char(TYPEOF(x)) ); } return out; } lobstr/src/inspect.cpp0000644000176200001440000002450515105452054014526 0ustar liggesusers#include #include #include #include #include #include "utils.h" struct Expand { bool alrep; bool charsxp; bool env; bool call; bool bytecode; }; class GrowableList { cpp11::writable::list data_; cpp11::writable::strings names_; R_xlen_t n_; public: GrowableList(R_xlen_t size = 10) : data_(size), names_(size), n_(0) { } void push_back(const char* string, SEXP x) { int n_protected = 0; if (Rf_xlength(data_) == n_) { data_ = PROTECT(Rf_xlengthgets(data_, n_ * 2)); n_protected++; names_ = PROTECT(Rf_xlengthgets(names_, n_ * 2)); n_protected++; } SEXP string_ = PROTECT(Rf_mkChar(string)); n_protected++; SET_STRING_ELT(names_, n_, string_); SET_VECTOR_ELT(data_, n_, x); n_++; UNPROTECT(n_protected); } cpp11::list vector() { if (Rf_xlength(data_) != n_) { data_ = Rf_xlengthgets(data_, n_); names_ = Rf_xlengthgets(names_, n_); } Rf_setAttrib(data_, R_NamesSymbol, names_); return data_; } }; SEXP obj_children_(SEXP x, std::map& seen, double max_depth, Expand expand); bool is_namespace(cpp11::environment env); bool is_altrep(SEXP x) { #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) return ALTREP(x); #else return false; #endif } SEXP obj_inspect_(SEXP x, std::map& seen, double max_depth, Expand& expand) { int id; SEXP children; bool has_seen; if (seen.count(x)) { has_seen = true; id = seen[x]; children = PROTECT(Rf_allocVector(VECSXP, 0)); } else { has_seen = false; id = seen.size() + 1; seen[x] = id; children = PROTECT(obj_children_(x, seen, max_depth, expand)); } // don't store object directly to avoid increasing refcount Rf_setAttrib(children, Rf_install("addr"), PROTECT(Rf_mkString(obj_addr_(x).c_str()))); Rf_setAttrib(children, Rf_install("has_seen"), PROTECT(Rf_ScalarLogical(has_seen))); Rf_setAttrib(children, Rf_install("id"), PROTECT(Rf_ScalarInteger(id))); Rf_setAttrib(children, Rf_install("type"), PROTECT(Rf_ScalarInteger(TYPEOF(x)))); Rf_setAttrib(children, Rf_install("length"), PROTECT(Rf_ScalarReal(sxp_length(x)))); Rf_setAttrib(children, Rf_install("altrep"), PROTECT(Rf_ScalarLogical(is_altrep(x)))); Rf_setAttrib(children, Rf_install("maybe_shared"), PROTECT(Rf_ScalarInteger(MAYBE_SHARED(x)))); Rf_setAttrib(children, Rf_install("no_references"), PROTECT(Rf_ScalarInteger(NO_REFERENCES(x)))); Rf_setAttrib(children, Rf_install("object"), PROTECT(Rf_ScalarInteger(Rf_isObject(x)))); UNPROTECT(9); const char* value = NULL; if (TYPEOF(x) == SYMSXP && PRINTNAME(x) != R_NilValue) { value = CHAR(PRINTNAME(x)); } else if (TYPEOF(x) == ENVSXP) { if (x == R_GlobalEnv) { value = "global"; } else if (x == R_EmptyEnv) { value = "empty"; } else if (x == R_BaseEnv) { value = "base"; } else { if (R_PackageEnvName(x) != R_NilValue) value = CHAR(STRING_ELT(R_PackageEnvName(x), 0)); } } if (value != NULL) { Rf_setAttrib(children, Rf_install("value"), PROTECT(Rf_mkString(value))); UNPROTECT(1); } Rf_setAttrib(children, Rf_install("class"), PROTECT(Rf_mkString("lobstr_inspector"))); UNPROTECT(1); UNPROTECT(1); return children; } inline void recurse( GrowableList* children, std::map& seen, const char* name, SEXP child, double max_depth, Expand& expand) { SEXP descendents = PROTECT(obj_inspect_(child, seen, max_depth - 1, expand)); children->push_back(name, descendents); UNPROTECT(1); } SEXP obj_children_( SEXP x, std::map& seen, double max_depth, Expand expand) { GrowableList children; bool skip = false; // Handle ALTREP objects if (expand.alrep && is_altrep(x)) { #if defined(R_VERSION) && R_VERSION >= R_Version(3, 5, 0) SEXP klass = ALTREP_CLASS(x); recurse(&children, seen, "_class", klass, max_depth, expand); recurse(&children, seen, "_data1", R_altrep_data1(x), max_depth, expand); recurse(&children, seen, "_data2", R_altrep_data2(x), max_depth, expand); #endif } else if (max_depth <= 0) { switch (TYPEOF(x)) { // Non-recursive types case NILSXP: case SPECIALSXP: case BUILTINSXP: case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case RAWSXP: case CHARSXP: case SYMSXP: skip = false; break; default: skip = true; }; } else { switch (TYPEOF(x)) { // Non-recursive types case NILSXP: case SPECIALSXP: case BUILTINSXP: case LGLSXP: case INTSXP: case REALSXP: case CPLXSXP: case RAWSXP: case CHARSXP: case SYMSXP: break; // Strings case STRSXP: if (expand.charsxp) { for (R_xlen_t i = 0; i < XLENGTH(x); i++) { recurse(&children, seen, "", STRING_ELT(x, i), max_depth, expand); } } break; // Recursive vectors case VECSXP: case EXPRSXP: case WEAKREFSXP: { SEXP names = PROTECT(Rf_getAttrib(x, R_NamesSymbol)); if (TYPEOF(names) == STRSXP) { for (R_xlen_t i = 0; i < XLENGTH(x); ++i) { recurse(&children, seen, CHAR(STRING_ELT(names, i)), VECTOR_ELT(x, i), max_depth, expand); } } else { for (R_xlen_t i = 0; i < XLENGTH(x); ++i) { recurse(&children, seen, "", VECTOR_ELT(x, i), max_depth, expand); } } UNPROTECT(1); break; } // Linked lists case LANGSXP: if (!expand.call) { skip = true; break; } case DOTSXP: case LISTSXP: { if (x == R_MissingArg) { // Needed for DOTSXP break; } SEXP cons = x; for (; is_linked_list(cons); cons = CDR(cons)) { SEXP tag = TAG(cons); if (TYPEOF(tag) == NILSXP) { recurse(&children, seen, "", CAR(cons), max_depth, expand); } else if (TYPEOF(tag) == SYMSXP) { recurse(&children, seen, CHAR(PRINTNAME(tag)), CAR(cons), max_depth, expand); } else { // TODO: add index? needs to be a list? recurse(&children, seen, "_tag", tag, max_depth, expand); recurse(&children, seen, "_car", CAR(cons), max_depth, expand); } } if (cons != R_NilValue) { recurse(&children, seen, "_cdr", cons, max_depth, expand); } break; } case BCODESXP: if (!expand.bytecode) { skip = true; break; } recurse(&children, seen, "_tag", TAG(x), max_depth, expand); recurse(&children, seen, "_car", CAR(x), max_depth, expand); recurse(&children, seen, "_cdr", CDR(x), max_depth, expand); break; // Environments case ENVSXP: if (x == R_BaseEnv || x == R_GlobalEnv || x == R_EmptyEnv || is_namespace(x)) break; if (expand.env) { // Using node-based object accessors: CAR for FRAME, and TAG for HASHTAB. // TODO: Iterate manually over the environment using environment accessors. recurse(&children, seen, "_frame", CAR(x), max_depth, expand); recurse(&children, seen, "_hashtab", TAG(x), max_depth, expand); } else { SEXP names = PROTECT(R_lsInternal3(x, /* all= */ TRUE, /* sorted= */ FALSE)); for (R_xlen_t i = 0; i < XLENGTH(names); ++i) { const char* name = CHAR(STRING_ELT(names, i)); SEXP sym = PROTECT(Rf_install(name)); if (R_BindingIsActive(sym, x)) { SEXP sym = PROTECT(Rf_install("_active_binding")); SEXP active = PROTECT(obj_inspect_(sym, seen, max_depth, expand)); children.push_back(name, active); UNPROTECT(2); } else { SEXP obj = PROTECT(Rf_findVarInFrame(x, sym)); recurse(&children, seen, name, obj, max_depth, expand); UNPROTECT(1); } UNPROTECT(1); } UNPROTECT(1); } recurse(&children, seen, "_enclos", R_ParentEnv(x), max_depth, expand); break; // Functions case CLOSXP: #if (R_VERSION >= R_Version(4, 5, 0)) recurse(&children, seen, "_formals", R_ClosureFormals(x), max_depth, expand); recurse(&children, seen, "_body", R_ClosureBody(x), max_depth, expand); recurse(&children, seen, "_env", R_ClosureEnv(x), max_depth, expand); #else recurse(&children, seen, "_formals", FORMALS(x), max_depth, expand); recurse(&children, seen, "_body", BODY(x), max_depth, expand); recurse(&children, seen, "_env", CLOENV(x), max_depth, expand); #endif break; case PROMSXP: // Using node-based object accessors: CAR for PRVALUE, CDR for PRCODE, and // TAG for PRENV. TODO: Iterate manually over the environment using // environment accessors. recurse(&children, seen, "_value", CAR(x), max_depth, expand); recurse(&children, seen, "_code", CDR(x), max_depth, expand); recurse(&children, seen, "_env", TAG(x), max_depth, expand); break; case EXTPTRSXP: recurse(&children, seen, "_prot", R_ExternalPtrProtected(x), max_depth, expand); recurse(&children, seen, "_tag", R_ExternalPtrTag(x), max_depth, expand); break; case S4SXP: recurse(&children, seen, "_tag", TAG(x), max_depth, expand); break; default: cpp11::stop("Don't know how to handle type %s", Rf_type2char(TYPEOF(x))); } } // CHARSXPs have fake attriibutes if (max_depth > 0 && TYPEOF(x) != CHARSXP && !Rf_isNull(ATTRIB(x))) { recurse(&children, seen, "_attrib", ATTRIB(x), max_depth, expand); } SEXP out = PROTECT(children.vector()); if (skip) { Rf_setAttrib(out, Rf_install("skip"), PROTECT(Rf_ScalarLogical(skip))); UNPROTECT(1); } UNPROTECT(1); return out; } [[cpp11::register]] cpp11::list obj_inspect_(SEXP x, double max_depth, bool expand_char = false, bool expand_altrep = false, bool expand_env = false, bool expand_call = false, bool expand_bytecode = false) { std::map seen; Expand expand = {expand_altrep, expand_char, expand_env, expand_call}; return obj_inspect_(x, seen, max_depth, expand); } lobstr/NAMESPACE0000644000176200001440000000116114254621577013012 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("[",lobstr_bytes) S3method(c,lobstr_bytes) S3method(format,lobstr_bytes) S3method(format,lobstr_inspector) S3method(print,lobstr_bytes) S3method(print,lobstr_inspector) S3method(print,lobstr_raw) S3method(tree_label,"NULL") S3method(tree_label,"function") S3method(tree_label,character) S3method(tree_label,default) S3method(tree_label,environment) export(ast) export(cst) export(mem_used) export(obj_addr) export(obj_addrs) export(obj_size) export(obj_sizes) export(ref) export(sxp) export(tree) export(tree_label) import(rlang) useDynLib(lobstr, .registration = TRUE) lobstr/LICENSE0000644000176200001440000000005415104665254012573 0ustar liggesusersYEAR: 2023 COPYRIGHT HOLDER: lobstr authors lobstr/NEWS.md0000644000176200001440000000313715105455377012675 0ustar liggesusers# lobstr 1.1.3 * Changes for compliance with R's public API. The main consequence is that lobstr no longer reports the `truelength` property of vectors. We also changed the `named` indicator to `refs:n`, where `n` can take the values: `0` (corresponding to `NO_REFERENCES` returning 1), `1` (corresponding to both `NO_REFERENCES` `MAYBE_SHARED` returning 0), and `2+` (`MAYBE_SHARED` returning 1). # lobstr 1.1.2 * Switched to cpp11 from Rcpp. * Relicensed as MIT (#51). * `obj_size()` and `sxp()` now support non-nil terminated pairlists. * `obj_size()` now displays large objects with KB, MB, etc (#57, #60), and no longer returns NA for objects larger than 2^31 bytes (#45). * `obj_sizes()` now computes relative sizes correctly (without meaningless floating point differences). * `ref()` lists all contents of environments even those with names beginning with `.` (@krlmlr, #53). * New, experimental `tree()` function as alternative to `str()` (#56). # lobstr 1.1.1 * Fix PROTECT error. * Remove UTF-8 characters from comments # lobstr 1.1.0 * `ref()` now handles custom classes properly (@yutannihilation, #36) * `sxp()` is a new tool for displaying the underlying C representation of an object (#38). * `obj_size()` now special cases the ALTREP "deferred string vectors" which previously crashed due to the way in which they abuse the pairlist type (#35). # lobstr 1.0.1 * `ast()` prints scalar integer and complex more accurately (#24) * `obj_addr()` no longer increments the reference count of its input (#25) * `obj_size()` now correctly computes size of ALTREP objects on R 3.5.0 (#32) lobstr/README.md0000644000176200001440000000433115105452125013037 0ustar liggesusers # lobstr lobstr website [![CRAN status](https://www.r-pkg.org/badges/version/lobstr)](https://cran.r-project.org/package=lobstr) [![R-CMD-check](https://github.com/r-lib/lobstr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/lobstr/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/r-lib/lobstr/graph/badge.svg)](https://app.codecov.io/gh/r-lib/lobstr) lobstr provides tools in the same vein as `str()`, which allow you to dig into the detail of an object. ## Installation Install the released version of lobstr from CRAN: ``` r install.packages("lobstr") ``` You can install the development version with: ``` r # install.packages("pak") pak::pak("r-lib/lobstr") ``` ## Example ### Abstract syntax trees `ast()` draws the abstract syntax tree of R expressions: ``` r ast(a + b + c) #> █─`+` #> ├─█─`+` #> │ ├─a #> │ └─b #> └─c ast(function(x = 1) { if (x > 0) print("Hi!") }) #> █─`function` #> ├─█─x = 1 #> ├─█─`{` #> │ └─█─`if` #> │ ├─█─`>` #> │ │ ├─x #> │ │ └─0 #> │ └─█─print #> │ └─"Hi!" #> └─NULL ``` ### References `ref()` shows hows objects can be shared across data structures by digging into the underlying \_\_ref\_\_erences: ``` r x <- 1:1e6 y <- list(x, x, x) ref(y) #> █ [1:0x126225d88] #> ├─[2:0x1114afb90] #> ├─[2:0x1114afb90] #> └─[2:0x1114afb90] e <- rlang::env() e$self <- e ref(e) #> █ [1:0x126563548] #> └─self = [1:0x126563548] ``` A related tool is `obj_size()`, which computes the size of an object taking these shared references into account: ``` r obj_size(x) #> 680 B obj_size(y) #> 760 B ``` ### Call stack trees `cst()` shows how frames on the call stack are connected: ``` r f <- function(x) g(x) g <- function(x) h(x) h <- function(x) x f(cst()) #> ▆ #> 1. ├─f(cst()) #> 2. │ └─g(x) #> 3. │ └─h(x) #> 4. └─lobstr::cst() ``` lobstr/man/0000755000176200001440000000000015105455414012336 5ustar liggesuserslobstr/man/lobstr-package.Rd0000644000176200001440000000167315104665254015536 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lobstr-package.R \docType{package} \name{lobstr-package} \alias{lobstr} \alias{lobstr-package} \title{lobstr: Visualize R Data Structures with Trees} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} A set of tools for inspecting and understanding R data structures inspired by str(). Includes ast() for visualizing abstract syntax trees, ref() for showing shared references, cst() for showing call stack trees, and obj_size() for computing object sizes. } \seealso{ Useful links: \itemize{ \item \url{https://lobstr.r-lib.org/} \item \url{https://github.com/r-lib/lobstr} \item Report bugs at \url{https://github.com/r-lib/lobstr/issues} } } \author{ \strong{Maintainer}: Hadley Wickham \email{hadley@posit.co} Other contributors: \itemize{ \item Posit Software, PBC [copyright holder, funder] } } \keyword{internal} lobstr/man/tree.Rd0000644000176200001440000000563414253140421013564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tree.R \name{tree} \alias{tree} \title{Pretty tree-like object printing} \usage{ tree( x, ..., index_unnamed = FALSE, max_depth = 10L, max_length = 1000L, show_environments = TRUE, hide_scalar_types = TRUE, val_printer = crayon::blue, class_printer = crayon::silver, show_attributes = FALSE, remove_newlines = TRUE, tree_chars = box_chars() ) } \arguments{ \item{x}{A tree like object (list, etc.)} \item{...}{Ignored (used to force use of names)} \item{index_unnamed}{Should children of containers without names have indices used as stand-in?} \item{max_depth}{How far down the tree structure should be printed. E.g. \code{1} means only direct children of the root element will be shown. Useful for very deep lists.} \item{max_length}{How many elements should be printed? This is useful in case you try and print an object with 100,000 items in it.} \item{show_environments}{Should environments be treated like normal lists and recursed into?} \item{hide_scalar_types}{Should atomic scalars be printed with type and length like vectors? E.g. \code{x <- "a"} would be shown as \verb{x: "a"} instead of \code{x: "a"}.} \item{val_printer}{Function that values get passed to before being drawn to screen. Can be used to color or generally style output.} \item{class_printer}{Same as \code{val_printer} but for the the class types of non-atomic tree elements.} \item{show_attributes}{Should attributes be printed as a child of the list or avoided?} \item{remove_newlines}{Should character strings with newlines in them have the newlines removed? Not doing so will mess up the vertical flow of the tree but may be desired for some use-cases if newline structure is important to understanding object state.} \item{tree_chars}{List of box characters used to construct tree. Needs elements \verb{$h} for horizontal bar, \verb{$hd} for dotted horizontal bar, \verb{$v} for vertical bar, \verb{$vd} for dotted vertical bar, \verb{$l} for l-bend, and \verb{$j} for junction (or middle child).} } \value{ console output of structure } \description{ A cleaner and easier to read replacement for \code{str} for nested list-like objects } \examples{ x <- list( list(id = "a", val = 2), list( id = "b", val = 1, children = list( list(id = "b1", val = 2.5), list( id = "b2", val = 8, children = list( list(id = "b21", val = 4) ) ) ) ), list( id = "c", val = 8, children = list( list(id = "c1"), list(id = "c2", val = 1) ) ) ) # Basic usage tree(x) # Even cleaner output can be achieved by not printing indices tree(x, index_unnamed = FALSE) # Limit depth if object is potentially very large tree(x, max_depth = 2) # You can customize how the values and classes are printed if desired tree(x, val_printer = function(x) { paste0("_", x, "_") }) } lobstr/man/ast.Rd0000644000176200001440000000160513762501764013425 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ast.R \name{ast} \alias{ast} \title{Display the abstract syntax tree} \usage{ ast(x) } \arguments{ \item{x}{An expression to display. Input is automatically quoted, use \verb{!!} to unquote if you have already captured an expression object.} } \description{ This is a useful alternative to \code{str()} for expression objects. } \examples{ # Leaves ast(1) ast(x) # Simple calls ast(f()) ast(f(x, 1, g(), h(i()))) ast(f()()) ast(f(x)(y)) ast((x + 1)) # Displaying expression already stored in object x <- quote(a + b + c) ast(x) ast(!!x) # All operations have this same structure ast(if (TRUE) 3 else 4) ast(y <- x * 10) ast(function(x = 1, y = 2) { x + y } ) # Operator precedence ast(1 * 2 + 3) ast(!1 + !1) } \seealso{ Other object inspectors: \code{\link{ref}()}, \code{\link{sxp}()} } \concept{object inspectors} lobstr/man/mem_used.Rd0000644000176200001440000000123713251236036014423 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mem.R \name{mem_used} \alias{mem_used} \title{How much memory is currently used by R?} \usage{ mem_used() } \description{ \code{mem_used()} wraps around \code{gc()} and returns the exact number of bytes currently used by R. Note that changes will not match up exactly to \code{\link[=obj_size]{obj_size()}} as session specific state (e.g. \link{.Last.value}) adds minor variations. } \examples{ prev_m <- 0; m <- mem_used(); m - prev_m x <- 1:1e6 prev_m <- m; m <- mem_used(); m - prev_m obj_size(x) rm(x) prev_m <- m; m <- mem_used(); m - prev_m prev_m <- m; m <- mem_used(); m - prev_m } lobstr/man/obj_size.Rd0000644000176200001440000000513313477777720014454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/size.R \name{obj_size} \alias{obj_size} \alias{obj_sizes} \title{Calculate the size of an object.} \usage{ obj_size(..., env = parent.frame()) obj_sizes(..., env = parent.frame()) } \arguments{ \item{...}{Set of objects to compute size.} \item{env}{Environment in which to terminate search. This defaults to the current environment so that you don't include the size of objects that are already stored elsewhere. Regardless of the value here, \code{obj_size()} never looks past the global or base environments.} } \value{ An estimate of the size of the object, in bytes. } \description{ \code{obj_size()} computes the size of an object or set of objects; \code{obj_sizes()} breaks down the individual contribution of multiple objects to the total size. } \section{Compared to \code{object.size()}}{ Compared to \code{\link[=object.size]{object.size()}}, \code{obj_size()}: \itemize{ \item Accounts for all types of shared values, not just strings in the global string pool. \item Includes the size of environments (up to \code{env}) \item Accurately measures the size of ALTREP objects. } } \section{Environments}{ \code{obj_size()} attempts to take into account the size of the environments associated with an object. This is particularly important for closures and formulas, since otherwise you may not realise that you've accidentally captured a large object. However, it's easy to over count: you don't want to include the size of every object in every environment leading back to the \code{\link[=emptyenv]{emptyenv()}}. \code{obj_size()} takes a heuristic approach: it never counts the size of the global environment, the base environment, the empty environment, or any namespace. Additionally, the \code{env} argument allows you to specify another environment at which to stop. This defaults to the environment from which \code{obj_size()} is called to prevent double-counting of objects created elsewhere. } \examples{ # obj_size correctly accounts for shared references x <- runif(1e4) obj_size(x) z <- list(a = x, b = x, c = x) obj_size(z) # this means that object size is not transitive obj_size(x) obj_size(z) obj_size(x, z) # use obj_size() to see the unique contribution of each component obj_sizes(x, z) obj_sizes(z, x) obj_sizes(!!!z) # obj_size() also includes the size of environments f <- function() { x <- 1:1e4 a ~ b } obj_size(f()) #' # In R 3.5 and greater, `:` creates a special "ALTREP" object that only # stores the first and last elements. This will make some vectors much # smaller than you'd otherwise expect obj_size(1:1e6) } lobstr/man/obj_addr.Rd0000644000176200001440000000162113406773170014375 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/address.R \name{obj_addr} \alias{obj_addr} \alias{obj_addrs} \title{Find memory location of objects and their children.} \usage{ obj_addr(x) obj_addrs(x) } \arguments{ \item{x}{An object} } \description{ \code{obj_addr()} gives the address of the value that \code{x} points to; \code{obj_addrs()} gives the address of the components the list, environment, and character vector \code{x} point to. } \details{ \code{obj_addr()} has been written in such away that it avoids taking references to an object. } \examples{ # R creates copies lazily x <- 1:10 y <- x obj_addr(x) == obj_addr(y) y[1] <- 2L obj_addr(x) == obj_addr(y) y <- runif(10) obj_addr(y) z <- list(y, y) obj_addrs(z) y[2] <- 1.0 obj_addrs(z) obj_addr(y) # The address of an object is different every time you create it: obj_addr(1:10) obj_addr(1:10) obj_addr(1:10) } lobstr/man/figures/0000755000176200001440000000000015104665254014006 5ustar liggesuserslobstr/man/figures/logo.png0000644000176200001440000006540315104665254015464 0ustar liggesusersPNG  IHDRޫh cHRMz&u0`:pQ<bKGDtIME -ejTIDATxw|$u`r̐Ü)Jle+~}a>}om9ʖ [dI( %1pHN Uu:4r>UWs2 8avI?):fjkeO#_>ԥeL䭏20[|%`oy`M^6LN:F7I&R%r.2~c~LMF#=:y6^,]_̵Dh " d+4+|^ݱcw$X巎5(035ǥnpRHlf^AQ(x#Q& O rVd|w0 p:8ɻP\*BE`d`g{kTJ[-c7D~0L@d~jV2UU]mvp筺a5L} g2:40jM1(7 e >$ HU5uMBD\o0;=aH'I`k2YoG $౽?}ʚVDBcLMpu:tWKdxiVlq]P&!OwR ˗vp4֣ bțYK F9 hڪa2(ey22'PTÉ{q`7Ncr>$k"^.zis{̓e"ed~?Y&A~yw]w:ȡwrMB_D$LZe"ey27W2IP#?}*oEBe~^Fj"#[|lq(xȓ"#d<6fN{Fl6ۆIV] jh" )Mm{%UU oJr2uQΟ@0d!m;dǟW:I^ R@UU9SSY7-mo/[W2>*U>$>,l_"oYG*dƯGW:I\A c?#UU9Avצ^rda7 ͭlypy[큳DZѪeV](H^ {bw-& `n:j܈ #Wcc폷ŬʓD ރ ,\Ce#'EaAmcw=z}[='9iN\ao]7V9{>X4]H^L.saW 9lQP5&fU{O 2ġQ{dOjյTVdVݴ#Vͦ.U.#fa-vfVvEfuuɭlVo9!CC+Zu յ*$(%u*>VFF}ry\v4rFӵmrFbx;pr%訽ClE"o筺GKXusjj Tf˫aNq{]^E)xB ^d u}5D#ed쨽D'pq;g%cf?Vr9L *+;l9\dw DHDRTx+줴an"3ނ$u*D.iރLi@**+L1;%WcO?,;l LreJ5E`J%9d~#e~`2?Eq97Dfv >LcL&8Kg#֖RIhqGJud}lfM^Xh?!GIFHx<T%ZE dY~/e&;qykh'[t_)pVɵ~E>6Kb2JǴ>ڳlĦt(k|Lck *O רmbV*kQUUezb*=ChN&"@-n8ni>YkTդ/p9U$5I0>4,.zߛ堲OǑ]T<(Y,. %ܠ@J[U 2{R(MGS\wڳ,Z{y=o@';8p}am325( Ģ o9DϲUfS]uw51|^6h$#O2> p&,zTV`ٶ݊Q5X}pyLpN>|Aoy^05: SMii"dYT37!M+~TnӅb-!s"WR֧(eKhJ#š#c>an^I& &ֽPd"H߸E+xiFGl6lMEUܐRi2;%CP$%aqyVgpǁg+m`f9f"5ȲA*}6^JwqEQ st]'Iz ʫ"+ H15:p8L%ΑEC}*NۍUe ߄,pC '{;ԯ s?z}T-A1]#dJnr֞'i `$p"/6YZ&QMvptn*s]w.D^ˉai4ArH˶(\<]HO"F~k/s@9xO ! 1;&-6B]#;{ެEpWV09:fe.T78]R47cry%[6. Dx6峷px^Bd|2Djn8ႲEy6d"Kn,*Y, gm'EslZ{ƈFCa{}ڲCE!mUUUzi]K:>V5PҿHQ:[c٬=GwSf sSa.7Nh,\8V]2'3yjٞGJ}BWzCjp㲻p]y!o!)Fz^ڦJix4Qgsc++py++h@î<nGhM1!C=c %4_k;wӲS&C8ihav2 H]OHhw!kϗYʉ,ߑuW$Ϙ *. ˇBQT n;;He9 ]u-A$]^`wکmbϑVj+@*19:í}\6C=c$bRؿ)h:N@#7̿\y+96n͑s$.cGeV--5WWD)11<"E8I<qu?r%xz͛R-rxpڝ9r6 @K8[_Z=kE>ȪlcLϥ'#}Oвak煯!̹t"3sL0=1G4CKy_c' őh(EjRqa>݅ JO mﴳa!ݍƦ̗5PUu&&sD U8B u/TP,2ys(0?ŗ:Iē9uK4T=A[kcMj*ך,2HIMˬ[vIiwvrWIdRRQUeC}G y7Ӱ&64M39:6 ݷihȌZҀn#H{~r'b2&/<|0./++=$㩂T6'l Ӌ$Ғ+6&p>W'͹'4-gJ)ŽNa@U}}w=-9$cz|nVh0=.sQkG߷"/xBO+2QKBHpvxsWRƼH-*R]mi=GZ-zC)TE  N=|*P+goP]~WZ0JjL}mIRɔU?k=N޽-9cY !à yӷƏaGKiEs;cV'S ù(awuV$WGe9ҝBZa[{5鬪 3!'̵ V8aj+4u156pR/uN97 C[ndbx냌 NLCHyͺ*ݹǒWgϙefxaH%|gQ*[5.:a) bqBU}"W黕.t$ݣj)'#6Jck MULwsqѤUG"=2Ql\D4T.n:jiQwC7H%5?/pϑt!!2;.YY1Tѣ9Eq:/k^"NFUaSp v{S]{5ots|7|2Vzkh]'N͘B@u}@#_b#CmS%:LڗItLWVVϮ=VVv bsaZj,o?`5il%hxU!Mp\7҅9. iq̓OdaQ)tޅ`G!ZNH,lI ݗ Æ.h)9w^=7̸"08RuksV_wAf&d%UQw|7ڛk7M;L}mn)S2cK6WLɡjSq{3roE=4=;oy١ '._Frfk7 Bw~ot) 9r%6fucB*k>Sx.S*}V^% &LxGWKɌ)GTU8<^*Te4+qģ |A/31,HDQMڏ6 U` $sM89| w D!a' PU_S%j7s_`o7F4e6:RYm+xq(6Clyf{KG= (BDXrD5e|hY"6v ]LhMǵo#tJ6VRYsge凎!!=PT˝g#VEzo"[!mF&ywaw6%n.0 TM l"5´Kl!@3(.2;f6[ Vp9U0WkA*"4ertɑjek^df23!n^5yM)sEU}٩Ъ+c PT"zM9~(37fמFD,oC7H&RDB1f'CL2=!{j)ûs5G.g^bg̺>HS[=5:CKQ<> jPUus %5Azo l":Eb骺Oa0k--HE˞@uF"" DMGEEhLiզ6- gOܺP]:OrTCKAmcezU5t}M߶bj,j%MV ^r9 kn%5XD,A, ?x -r9Fu`8tC`KP_H$DK4RȮ zwD!E ^^&r 31H_CȽ09ϔS{n+Tt/^'NdoThޣo P,t2ICf` ߼^G)⧈ Xp u =)m0z TсtXӭ ݣ[^7 ՏFZ VSX}#P) M 4-w4 Aӏqwm&U:ĢԴLщɩϵcA< x2yOrj.j*eyv)I90fݫ/fz%^̛"96U>؜Ӏ+47ퟤ>HmSMx*\V/3祈GNabd٩0H].[M01<ͭK}w"o4J?79]ܼKKG}N@tk-)x#7UZH' ,]T9t8\y.|)b8ZJOP w 7/Ҹm6]"\fLI5 L5Zn5[K`o”Uhn:Nw}6VHLꐧ\>+l#~若aS4ʫH&E!zd\=SSA.XrU'ń.x`@3ۊ9;YbHF4_@j?WXY }m g5 Xn"F*5NQ`zlUąY!YBo+J20 Ks+$Mĉl*w>zWŬ|8:07u}M7nӰ``R(b_ PЂ&j h(x`:z˪m&`nǨa׈kV,q.y +c2z4/R\lIVQ>%!s3uQ67]&.ȘhJ&pLnvEUbe҂;9i>kĬ9_0I9><]"E ŘtXtMgn*727Gk9]RUh(Ϋ] uE( zJ.BQ+ ŘAז&f A8689/Ӯ$)Y{j \BR8IQUiޞ QϫPool9⑥ C ze-Ț2Q&pBAK{=,?dڐ u,{Jzf#D#qfqNmEKQ 2#MD6MϑJ}% \B8p#Q^7ZE!и-XI8HIf0>4y:ݎa2" SXQirtfR.AkUZJy{ f%l&FqdstX((0>8Mj [.n9Qn=P&pAdVtɹ0g^N"\K!SP[(L"S!f z煐]E5XsѢ<\tz \b먪 :g{}p%~%|&H|Y$y"o![ȴ%O&R L-:EWy"u2Q&p A;(4)`bdt[R0[X)cLcE1_%}/ݠbX')&Ggj+9;l5W0JSEčAG&g+gb!,uG $6Dyw-j DmF&H&R8]8tj"=Ea?PϘy q((LX&(LcUuE MUv%=aT`n*uP^K 䨏^w>|ڦQ)B<Il{ =@,Ih:ݼ DBgЇ_7/1p{$'qrxnk2mo@U~`.Xz"^? \bPUwک( +RbEIBB*)!zUIOrR5ɽli)IkLDLvx-fGyg齿ZО.UU=ThWQFgegl*U`}UͤLN233%&wg3owhfj|.X镾t`=tMOuH4 b8Ñܺ܋0j?I4i `-M068EemCگ+M]<jS ۣ$5W壼l6U&dS%#<|4^*rVBnFg%KrR7/pN.Ih&ޣqV߽G[w+go131Wp5eýтcݶ$)#stWR&1^cA2*UXAו~jh?Ԝpq8kbbd~:jDEЃaGtC=RM6G&91Mx6"P]\es!<!XBƃ]'XrѤ ^؜Ϻq³ Ġ h~n~XKj\:sC mP?7*ҵ `{]Hfp *^Eb8 zN,#q-X4AQ$C* N2Wwq讽(ji4*T/^'MZ%rpѣ1vi}Mzlv`eYM`?ކ(*+hj`g{N31T&n6 Ok260o}/[ A u29:[zƸuNPdž,FLsc+BF;28C2tS\Eu}_e.C:>q@ NîfB+NFA& "˶8Ph+qv}syT\uCBG(`ő.} Yf]d*(4SV4ˎ) զX箥d8OQ]Gv9(Xtelen,42 .;60pƄQ&p LȏExk1 {_#*imdMQ%[v#lf8%)YSJ;L;E2aW;7tAJ(* sL )+ukV=J}KU|[RY3ԸygW_(Tgoq8]vN AîZZ:p{]vuHi(}u196FdJMSx+T蛳VD{sm2{Mɞ#<g?.dN& NֈmEaj|dwt-5cv0TU-t`:M0E㵤@:dYbaAy{ ialƙFKb(DPL_ EZXYQl秒tM,Ask\'U4cjl"V! V T2KF ,5Ɩ:l.Rڊ1.TT>WI 뉴~M a6 ύnd6B3f&CC&P6VÎ!pvFg#H\) z \ٟk~NcE_}buRHo3Вct:hh!vŶ/jgz|>*-Ql0?~C']gмMtbUG!US,Bv8)7+i+|^uEchIͺƖ:.%E^-=M:Gvzڷ{^~]ӽ:]ӉaG;bpkocQ} ێ6:3Mk: xn!'SZQf&Cf")JNͶ}1 =cv麱aKzv*ff>HύAt]_Ae%KfEQp7vl^C27t9eGmUrv`Һvچm޾(f"Ģ 8 "Eh!_p854쪡6-],f(ѽ~}4$i}D^MQfc6T#T$ z)tԍ MY^-3p{ /]ϞJ2&Zl< t $HTR-q6bXժ<ʪmz;LO O:K23q$I.tɂ] AUU60d(I܏j. !^77޾2K `|h- ( ňcM׻ʆ/Y`E> :Qde9]A_el d8dDh6Jj(L2>4]wZbuLHte2=1(l**入2c tЍ5mC"@7 ٟg.whSx3`hQ{aÐFf8b νTJg7( JQB/IRIʇÎҘ37eOuEbo`*Vq$I8ZJ[qi(ҞXq^l|"Gv,J\)RI ہ/CQs?΃"V9Qz(4 xlNh6B߭a2=ŪPddOvOsͣuMgv:ĵ]GZDli9@x.Fx6\ ͮw9L,,)DQ٩saꚪVxPi 2`w?vwS=Z̍?XAz~/tW.Y\XF>|`BQa9nFh:B]S5-m$DH@UTk7c"NR&0CS5U8q8q5jXR؆2o}C07O rC6w7~<ԝ8 *'/5kUYX^$V 0 _|=q@f蚬M YYZJtt9m,>ֻ>m/|u%+8vz?.j* 3O27 *~.;s3.rcT9vz?GGG]c } 2rX8d^{*pޛCd}*-E>[Q\8]"+(P&0roV!Cg47 x3]c^n6~mu 3;Yziw܃r'9<#E-qKzoy04ajl2ˣw_|/O|3]!F󱧨o|Kv23?Ȓ"4T6PDfDUm0poH\)(B*u/gPpusc8\K]CU=*+p( .vw4$F&N?rl[]3p8֭jh^`\QG2? ~*}a|/rǗGMU6L3C++'_Ya DI'9UVo]-mRPaF&m;;)žTL!R/\Hu_x+m-b CXOYU]|)|AoC-Mp|<kG:w/-$ejQXY$<ŦnOcsGure&8xx"^ZV)ǕtHf]S ͭE²)WQepDZ?ˢAz>Ko(!w`tVvu4fDdȆnp+uMUKL/~_E,XjYdL%5"8lPh ,1ECs&^1EaYqEPHͦn*FHb 4!4xGy@3`^:S8q!h h[2!d}E~<َd"Ui)8L*? UEN;U>C'ѿhQ=~Na{=brIj??o2CboyCO<>~ӅM->D)R ENĒP)^>+9͹ Wh'Bu]:EQblxE( uMUܼh|™‡Qiۼ)||PS||qn/}sko,tc;gPT{;νH&Rєh^ VPŘ 8R ԰ޱ%!dBB۾ ȦӶk/\R3Nx{o Yf1!c2]ӹ-t=s#Ǩ\dGG۾&$7L?U%BֱF&X0+V#n:k<ԝhvc|?uU2407FEq}L4J!.~-oY8ub"gۀ"nN{}Gwc5dx+•siw޻h"ak4rN|to;`g-5<އX0~|H8*ģI.|\yZj+o,*VN0Th{gN-=NO~Hk&~?}OOT" 7ZhզOXanx‘S{Ɔg\]ƻ~I}씘|Tt*k|מ`fs01<7-aI{hfSsV|#NQ".tJ-^GXpGv3o\<'_kk}GSK:ރxǞbfl6]״Vԋ6N7Z+ȉvr?iCc g6k`9GOpc8?\8s=0dEMcU8\n P+b7Bex.J"qWi]br|"aU>>eϡE!??@L9Ĺ_4}kFU"(X2I=n,]{G;LG_Cqj|^zn ĩdߑTgX5M[<3dWEQrR*F5>;#XV| M4U>[jr C7HgQ^ٍٛ++hn󀪺M8EH+13ԷV[+S >N)xv[ +@)<ǬxbyJ.+nCKiܾ6]uA}?櫀|l(bS&W8p-TPU\1n^kD<`9]3|G [b|.{sYrj|[W{~ty qc8]tI!vocw/?fvu4Q7cl`p8(JxE ]M_L.'[h?t]_~1=STI}VZ`]dwd25okYIqayT,ypd;'8n+;OϵAP@ O1}vz E\}kx#M9x4YO[2@( ]ËV&ɾ.Ƈ~icK/pks=qNzg#\z&_,.!'$R b:Y8zY* NgRsDN?F$cjt]zݳ;;W?}~s.+n5\c8/w_/Ǟ.P.X~~w_9yO ?!2#HEvf=L4'GgTj+&&392jSeI^*~|#kx}<7^x4,.񽯼[\<ۙyLJX C/>Ϸc\VjaoXcrl alv^ -5 ZY`n:̕sB)FP]ӹ|&rdl_8p8`)`(=D1v.k GDBQeڛ cmKNtM/ݸ@VD0x暢d"Yc3KV@>j%CLm EZK!8x**) P^+d: `l`PfXq7/l%,UartLOx X~=NN[8r羢9M7> q ,0ҵJ/c=`z/s]`!s *L2=0MEUUțLq{TRn\264)t[]#?+ܼ;}rGӂƖx4ELJ1tڦ*Tݮ⯬`od̗>a{O<~tYDk( s3a.E4GU"v?{VKŁ%O{`1 5]d6KޮPǽm'8뤺>ȱ{sW,*Mo ǭ A:~]<=x*|?KW$ hh#̂jS|֢^mUU  hD6R/fsJ7)FRj഻4q[6r#++5/^{apOs[=|qy*^c]ӹuijׄ/१soshI px%%K8է ]gCt?wsr"hzX* BQ UQq]m[0{CMa<  h'X_h1?[~K^RXţ (=Y#SUuG*ߒ?"HbV MHb$Aq9Y x*FJOrqݙd`΃|JAk?f/Ÿ+CRfC՛ȜCC7hi#̒q"ؿlnABH =,v` X:;< VnKFIjعM톥 Sd]ѣ+D/p7A!d;A M?cCSEIK JPRKOt->-*4i`v'"HeelK,\4ѥ ]$OH8?t^.ZX*BS!"j; !;kȕx7PtJJvJn褴$6Ն2(Dq^*o|Y>7ʊVt_)^4 X*F,E32]5h Q{zva9#gY5RzL2l23]% *n_RK'7l&2s\|ED[sKHfġg yg"? sYnpjకe, 3eN}M:3]d|xjK8$Uo{0w_\G@,"+]~X 8N Í}y,c*F;ِHx*FRK.+[k25YDvo~xe쏳/ d:p[fuKTJ?&RqZܪ/sցO0&< ]pvW:d(c 2A2  > #0a\@qK_|eƏ!oNt2b `,7̓IJ>-*p?Ҭ~Y8 ;2Jns%nˤ=Ċ>5^d"od<T[:-U-Q2(M`"iEstX-&V̎<w/{W2^,[, ARKUc7gJ <"F:>T/wlR&,;N_ b\)qM3lG~ x p-w٢CƏ˲26/%+$nrc '5_ڲ2!d٘?.X{/7? qM 瀏#˄Hl,[,c]ɰH_ =yal"'_;V؉D.cUB,P}n2R)tt YDvO OcYr-e<7X>W~~]WٞEJW2Vflptʲ2D>W$R #\)OHO31 &03;VYXr2Sm6mO-V,wlŰ2(߫, (lR'[|+2-!ʲ2Vuby5Q3:Ϭ> pp%]v'JY'ēk"$#7n6yDl";VlSN0?W&s$ YD-U]v'lqbe~F/F$ l"ddi :tP}U6 %?kF2=+/?vqYe222a`)M2 䧀UNXc 2 O'-7cd"꧐iŌGҁIjNL"?L\SFaKм8@FxJƛ?vi%uGyaDw-.w,PN,-HU)7nE3'{XlѬi+7 r} mլ̓->->jd A~~~H m7 V*2c+o1bѵzd5]%#2n'6}yD~d,yY(wX_b"c 6n730)[ DXN\ A |Mm=Mdك- BflewEbe~/!-JDQQ3lH⁕7DYX& ol"_>$P&QX7IFw6-OGvClCFLl_Ez٢S6S2kg6 eyDރ-4@2122.`Ck<ȴw厵ٲE@5k {x"( ȓ- ?~5-nu>[H"(xgV!Nlضlllє%RHEF7f,wQ&:"$0%$[\22qeod"ocղEY d/X]X(|i.Y&L D}ddwuAFU2 G< Y)g0ʲXYk(EoP&&!+;R5_B. ȓ->FFXXd R22$(DE ɕ?""re_ILBǑ/[L@vE__yLA%<)lݬ@BAz2F%-oLZAYQ&Z0 =eߖD[ dfn~DYeQ&EoR\Ex&;vC[dF*x $Y2m2 t[%$Ƒ2Oûm7 '[|OH2m$;ZvTtEXtSoftwareAdobe ImageReadyqe<IENDB`lobstr/man/tree_label.Rd0000644000176200001440000000112014253140421014705 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tree.R \name{tree_label} \alias{tree_label} \title{Build element or node label in tree} \usage{ tree_label(x, opts) } \arguments{ \item{x}{A tree like object (list, etc.)} \item{opts}{A list of options that directly mirrors the named arguments of \link{tree}. E.g. \code{list(val_printer = crayon::red)} is equivalent to \code{tree(..., val_printer = crayon::red)}.} } \description{ These methods control how the value of a given node is printed. New methods can be added if support is needed for a novel class } lobstr/man/ref.Rd0000644000176200001440000000173313762501764013414 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ref.R \name{ref} \alias{ref} \title{Display tree of references} \usage{ ref(..., character = FALSE) } \arguments{ \item{...}{One or more objects} \item{character}{If \code{TRUE}, show references from character vector in to global string pool} } \description{ This tree display focusses on the distinction between names and values. For each reference-type object (lists, environments, and optional character vectors), it displays the location of each component. The display shows the connection between shared references using a locally unique id. } \examples{ x <- 1:100 ref(x) y <- list(x, x, x) ref(y) ref(x, y) e <- new.env() e$e <- e e$x <- x e$y <- list(x, e) ref(e) # Can also show references to global string pool if requested ref(c("x", "x", "y")) ref(c("x", "x", "y"), character = TRUE) } \seealso{ Other object inspectors: \code{\link{ast}()}, \code{\link{sxp}()} } \concept{object inspectors} lobstr/man/cst.Rd0000644000176200001440000000212713304255332013414 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cst.R \name{cst} \alias{cst} \title{Call stack tree} \usage{ cst() } \description{ Shows the relationship between calls on the stack. This function combines the results of \code{\link[=sys.calls]{sys.calls()}} and \code{\link[=sys.parents]{sys.parents()}} yielding a display that shows how frames on the call stack are related. } \examples{ # If all evaluation is eager, you get a single tree f <- function() g() g <- function() h() h <- function() cst() f() # You get multiple trees with delayed evaluation try(f()) # Pay attention to the first element of each subtree: each # evaluates the outermost call f <- function(x) g(x) g <- function(x) h(x) h <- function(x) x try(f(cst())) # With a little ingenuity you can use it to see how NSE # functions work in base R with(mtcars, {cst(); invisible()}) invisible(subset(mtcars, {cst(); cyl == 0})) # You can also get unusual trees by evaluating in frames # higher up the call stack f <- function() g() g <- function() h() h <- function() eval(quote(cst()), parent.frame(2)) f() } lobstr/man/sxp.Rd0000644000176200001440000000375713762501764013462 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sxp.R \name{sxp} \alias{sxp} \title{Inspect an object} \usage{ sxp(x, expand = character(), max_depth = 5L) } \arguments{ \item{x}{Object to inspect} \item{expand}{Optionally, expand components of the true that are usually suppressed. Use: \itemize{ \item "character" to show underlying entries in the global string pool. \item "environment" to show the underlying hashtables. \item "altrep" to show the underlying data. \item "call" to show the full AST (but \code{\link[=ast]{ast()}} is usually superior) \item "bytecode" to show generated bytecode. }} \item{max_depth}{Maximum depth to recurse. Use \code{max_depth = Inf} (with care!) to recurse as deeply as possible. Skipped elements will be shown as \code{...}.`} } \description{ \code{sxp(x)} is similar to \code{.Internal(inspect(x))}, recursing into the C data structures underlying any R object. The main difference is the output is a little more compact, it recurses fully, and avoids getting stuck in infinite loops by using a depth-first search. It also returns a list that you can compute with, and carefully uses colour to highlight the most important details. } \details{ The name \code{sxp} comes from \code{SEXP}, the name of the C data structure that underlies all R objects. } \examples{ x <- list( TRUE, 1L, runif(100), "3" ) sxp(x) # Expand "character" to see underlying CHARSXP entries in the global # string pool x <- c("banana", "banana", "apple", "banana") sxp(x) sxp(x, expand = "character") # Expand altrep to see underlying data x <- 1:10 sxp(x) sxp(x, expand = "altrep") # Expand environmnets to see the underlying implementation details e1 <- new.env(hash = FALSE, parent = emptyenv(), size = 3L) e2 <- new.env(hash = TRUE, parent = emptyenv(), size = 3L) e1$x <- e2$x <- 1:10 sxp(e1) sxp(e1, expand = "environment") sxp(e2, expand = "environment") } \seealso{ Other object inspectors: \code{\link{ast}()}, \code{\link{ref}()} } \concept{object inspectors} lobstr/DESCRIPTION0000644000176200001440000000226315105623727013300 0ustar liggesusersPackage: lobstr Title: Visualize R Data Structures with Trees Version: 1.1.3 Authors@R: c( person("Hadley", "Wickham", , "hadley@posit.co", role = c("aut", "cre")), person("Posit Software, PBC", role = c("cph", "fnd")) ) Description: A set of tools for inspecting and understanding R data structures inspired by str(). Includes ast() for visualizing abstract syntax trees, ref() for showing shared references, cst() for showing call stack trees, and obj_size() for computing object sizes. License: MIT + file LICENSE URL: https://lobstr.r-lib.org/, https://github.com/r-lib/lobstr BugReports: https://github.com/r-lib/lobstr/issues Depends: R (>= 3.6.0) Imports: crayon, methods, prettyunits, rlang (>= 1.0.0) Suggests: covr, pillar, pkgdown, testthat (>= 3.0.0) LinkingTo: cpp11 (>= 0.4.2) Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Encoding: UTF-8 RoxygenNote: 7.3.3 Config/build/compilation-database: true NeedsCompilation: yes Packaged: 2025-11-13 22:26:21 UTC; hadleywickham Author: Hadley Wickham [aut, cre], Posit Software, PBC [cph, fnd] Maintainer: Hadley Wickham Repository: CRAN Date/Publication: 2025-11-14 13:00:07 UTC