我的递归版本 1 开始出现比我最初想象的更多的错误,所以我采取了一种简单的方法,基本上是 grepping 捕获的utils:::print.ls_str 的输出(我认为)。
到目前为止,这至少有两个缺点:捕获的输出和 eval-parse-texting,但它似乎适用于非常嵌套的列表,例如 ggplot2::ggplotGrob。
这些只是一些辅助函数
unname2 <- function(l) {
## unname all lists
## str(unname2(lm(mpg ~ wt, mtcars)))
l <- unname(l)
if (inherits(l, 'list'))
for (ii in seq_along(l))
l[[ii]] <- Recall(l[[ii]])
l
}
lnames <- function(l) {
## extract all list names
## lnames(lm(mpg ~ wt, mtcars))
nn <- lpath(l, TRUE)
gsub('\\[.*', '', sapply(strsplit(nn, '\\$'), tail, 1))
}
lpath <- function(l, use.names = TRUE) {
## return all list elements with path as character string
## l <- lm(mpg ~ wt, mtcars); lpath(l); lpath(l, FALSE)
ln <- deparse(substitute(l))
# class(l) <- NULL
l <- rapply(l, unclass, how = 'list')
L <- capture.output(if (use.names) l else unname2(l))
L <- L[grep('^\\$|^[[]{2,}', L)]
paste0(ln, L)
}
而这个正在返回有用的信息
lextract <- function(l, what, path.only = FALSE) {
# stopifnot(what %in% lnames(l))
ln1 <- eval(substitute(lpath(.l, TRUE), list(.l = substitute(l))))
ln2 <- eval(substitute(lpath(.l, FALSE), list(.l = substitute(l))))
cat(ln1[idx <- grep(what, ln1)], sep = '\n')
cat('\n')
cat(ln2[idx], sep = '\n')
cat('\n')
if (!path.only)
setNames(lapply(idx, function(x) eval(parse(text = ln1[x]))), ln1[idx])
else invisible()
}
fit <- lm(mpg ~ wt, mtcars)
lextract(fit, 'qraux')
# fit$qr$qraux
#
# fit[[7]][[2]]
#
# [1] 1.176777 1.046354
所以我可以直接使用该返回值,或者现在我有了索引。
fit[[7]][[2]]
# [1] 1.176777 1.046354
## etc
lextract(fit, 'qr', TRUE)
# fit$qr
# fit$qr$qr
# fit$qr$qraux
# fit$qr$pivot
# fit$qr$tol
# fit$qr$rank
#
# fit[[7]]
# fit[[7]][[1]]
# fit[[7]][[2]]
# fit[[7]][[3]]
# fit[[7]][[4]]
# fit[[7]][[5]]
不过,我更喜欢内置或单线。