R 嵌套列表结构信息的高效检索 实际问题
是否有任何方法可以使用或建立在R 嵌套列表结构信息的高效检索 实际问题,r,list,recursion,data-structures,nested-lists,R,List,Recursion,Data Structures,Nested Lists,是否有任何方法可以使用或建立在rappy（）的基础上，为任意结构的列表导出通过以下函数获得的相同类型的结构信息 定义： getRawStructure_2 <- function(input) { .getRawStructure <- function(x, level = 0) { level <- level + 1 out <- lapply(seq(along = x), function(el) { name <- nam
rappy（）getRawStructure_2 <- function(input) {
.getRawStructure <- function(x, level = 0) {
level <- level + 1
out <- lapply(seq(along = x), function(el) {
name <- names(x[el])
value <- x[[el]]
cls <- class(value)
.dim <- if (any(cls %in% c("data.frame", "matrix"))) {
paste(dim(value), collapse = " ")
} else {
length(value)
}
out <- data.frame(
level = level,
name = if (is.null(name) || name == "") NA else name,
class = cls,
dim = .dim,
stringsAsFactors = FALSE
)
if (any(cls == "list")) {
deep <- .getRawStructure(x = value, level = level)
c(list(out), unlist(deep, recursive = FALSE))
} else {
list(out)
}
})
}
tmp <- do.call("rbind", unlist(.getRawStructure(x = input), recursive = FALSE))
subs <- tmp$level
subs_2 <- lapply(1:subs[which.max(subs)], function(ii) {
out <- subs == ii
out[out] <- 1
out
})
names(subs_2) <- 1:length(subs_2)
data.frame(subs_2, tmp, stringsAsFactors = FALSE)
}
rappy（）frappy（）require("stringr")
getRawStructure_1 <- function(input) {
struc <- capture.output(str(input, list.len = length(input)))
struc <- unlist(strsplit(struc, split = "\n"))
tops <- str_count(struc, "\\s\\$\\s")
subs <- str_count(struc, "((\\.\\.)(\\s|\\$))")
## Clean //
idx_out <- which(tops == 0 & subs == 0)
if (length(idx_out)) {
tops <- tops[-idx_out]
subs <- subs[-idx_out]
struc <- struc[-idx_out]
}
## Types //
types <- gsub(".*\\$(\\s*:|\\s*\\w+:)", "", struc)
types <- gsub("(?<=\\w)\\s.*|\\:.*", "", types, perl = TRUE)
types <- tolower(gsub("\\s|<|'", "", types))
## Names //
idx_names <- str_detect(struc, "\\$\\s\\w+.*:\\s")
nms <- if (length(idx_names)) {
gsub("\\$\\s", "", str_extract(struc, "\\$\\s\\w+"))
} else {
NA
}
## Levels //
subs_2 <- lapply(0:subs[which.max(subs)], function(ii) {
out <- subs == ii
out[out] <- 1
out
})
names(subs_2) <- 1:length(subs_2)
data.frame(
subs_2,
name = nms,
class = types,
str = struc,
stringsAsFactors = FALSE
)
}
getRawStructure_3 <- function(input) {
.getRawStructure <- function(x) {
list(level = length(x), class = class(x))
}
rapply(input, .getRawStructure, how = "list")
}
getRawStructure_1(input)
getRawStructure_2(input)
getRawStructure_3(input)
require（“stringr”）
getRawStructure_1
input <- list(
x1 = list(x11 = list(x111 = 1, x112 = 1), x12 = list(x121 = 1, x122 = 1)),
x2 = list(x21 = "x21"),
x3 = list("x31"),
x4 = "x4",
x5 = list(1:3),
list(list(1, 2), list(3, 4)),
list(1:3),
"char 1",
"char 2",
letters[1:3],
c(1,3,5),
TRUE,
new.env(),
data.frame(x = 1:3, y = 1:3)
)
> listr::getStructure(input)
X1 X2 X3 type index oindex path ppath level name class dim
1 1 NA NA 1 [[1]] [1] x1 1 1 x1 list 2
2 1 1 NA 2 [[1]][[1]] [[1]][1] x1/x11 1/1 2 x11 list 2
3 1 1 1 2 [[1]][[1]][[1]] [[1]][[1]][1] x1/x11/x111 1/1/1 3 x111 numeric 1
4 1 1 2 2 [[1]][[1]][[2]] [[1]][[1]][2] x1/x11/x112 1/1/2 3 x112 numeric 1
5 1 2 NA 2 [[1]][[2]] [[1]][2] x1/x12 1/2 2 x12 list 2
6 1 2 1 2 [[1]][[2]][[1]] [[1]][[2]][1] x1/x12/x111 1/2/1 3 x121 numeric 1
7 1 2 2 2 [[1]][[2]][[2]] [[1]][[2]][2] x1/x12/x112 1/2/2 3 x122 numeric 1
8 2 NA NA 1 [[2]] [2] x2 2 1 x2 list 1
9 2 1 NA 2 [[2]][[1]] [[2]][1] x2/x21 2/1 2 x21 character 1
10 3 NA NA 1 [[3]] [3] x3 3 1 x3 list 1
11 3 1 NA 2 [[3]][[1]] [[3]][1] x3/1 3/1 2 <NA> character 1
12 4 NA NA 3 [[4]] [4] x4 4 1 x4 character 1
13 5 NA NA 1 [[5]] [5] x5 5 1 x5 list 1
14 5 1 NA 2 [[5]][[1]] [[5]][1] x5/1 5/1 2 <NA> integer 3
15 6 NA NA 1 [[6]] [6] 6 6 1 <NA> list 2
16 6 1 NA 2 [[6]][[1]] [[6]][1] 6/1 6/1 2 <NA> list 2
17 6 1 1 2 [[6]][[1]][[1]] [[6]][[1]][1] 6/1/1 6/1/1 3 <NA> numeric 1
18 6 1 2 2 [[6]][[1]][[2]] [[6]][[1]][2] 6/1/2 6/1/2 3 <NA> numeric 1
19 6 2 NA 2 [[6]][[2]] [[6]][2] 6/2 6/2 2 <NA> list 2
20 6 2 1 2 [[6]][[2]][[1]] [[6]][[2]][1] 6/2/1 6/2/1 3 <NA> numeric 1
21 6 2 2 2 [[6]][[2]][[2]] [[6]][[2]][2] 6/2/2 6/2/2 3 <NA> numeric 1
22 7 NA NA 1 [[7]] [7] 7 7 1 <NA> list 1
23 7 1 NA 2 [[7]][[1]] [[7]][1] 7/1 7/1 2 <NA> integer 3
24 8 NA NA 3 [[8]] [8] 8 8 1 <NA> character 1
25 9 NA NA 3 [[9]] [9] 9 9 1 <NA> character 1
26 10 NA NA 3 [[10]] [10] 10 10 1 <NA> character 3
27 11 NA NA 3 [[11]] [11] 11 11 1 <NA> numeric 3
28 12 NA NA 3 [[12]] [12] 12 12 1 <NA> logical 1
29 13 NA NA 3 [[13]] [13] 13 13 1 <NA> environment 0
30 14 NA NA 3 [[14]] [14] 14 14 1 <NA> data.frame 3 2
require("stringr")
getRawStructure_1 <- function(input) {
struc <- capture.output(str(input, list.len = length(input)))
struc <- unlist(strsplit(struc, split = "\n"))
tops <- str_count(struc, "\\s\\$\\s")
subs <- str_count(struc, "((\\.\\.)(\\s|\\$))")
## Clean //
idx_out <- which(tops == 0 & subs == 0)
if (length(idx_out)) {
tops <- tops[-idx_out]
subs <- subs[-idx_out]
struc <- struc[-idx_out]
}
## Types //
types <- gsub(".*\\$(\\s*:|\\s*\\w+:)", "", struc)
types <- gsub("(?<=\\w)\\s.*|\\:.*", "", types, perl = TRUE)
types <- tolower(gsub("\\s|<|'", "", types))
## Names //
idx_names <- str_detect(struc, "\\$\\s\\w+.*:\\s")
nms <- if (length(idx_names)) {
gsub("\\$\\s", "", str_extract(struc, "\\$\\s\\w+"))
} else {
NA
}
## Levels //
subs_2 <- lapply(0:subs[which.max(subs)], function(ii) {
out <- subs == ii
out[out] <- 1
out
})
names(subs_2) <- 1:length(subs_2)
data.frame(
subs_2,
name = nms,
class = types,
str = struc,
stringsAsFactors = FALSE
)
}
getRawStructure_3 <- function(input) {
.getRawStructure <- function(x) {
list(level = length(x), class = class(x))
}
rapply(input, .getRawStructure, how = "list")
}
getRawStructure_1(input)
getRawStructure_2(input)
getRawStructure_3(input)
require("microbenchmark")
res <- microbenchmark(
"0.1" = str(input, list.len = length(input)),
"0.2" = capture.output(str(input, list.len = length(input))),
"1" = getRawStructure_1(input),
"2" = getRawStructure_2(input),
"3" = getRawStructure_3(input),
unit = "ms"
)
> res
Unit: milliseconds
expr min lq mean median uq max neval
0.1 22.526810 24.431485 25.3388115 25.04150 26.160263 29.466200 100
0.2 15.678034 17.549247 17.9725577 17.79237 18.328352 22.353281 100
1 17.977740 20.286033 21.1265184 20.59993 21.396797 35.075989 100
2 17.647265 19.622121 20.2261508 20.03640 20.860219 25.066969 100
3 0.076993 0.092095 0.1055568 0.09861 0.112527 0.251706 100
scope <- 1000
input <- lapply(1:scope, function(ii) {
list(name = paste(sample(letters, 4), collapse = ""), value = Sys.time())
})
head(input)
res <- microbenchmark(
"0.1" = str(input, list.len = length(input)),
"0.2" = capture.output(str(input, list.len = length(input))),
"1" = getRawStructure_1(input),
"2" = getRawStructure_2(input),
"3" = getRawStructure_3(input),
unit = "ms",
times = 3
)
> res
Unit: milliseconds
expr min lq mean median uq max neval
0.1 2449.80358 2481.302677 2494.523763 2512.801773 2516.883854 2520.965936 3
0.2 1591.30210 1662.759397 1696.973466 1734.216693 1749.809148 1765.401602 3
1 1600.41742 1647.050567 1669.736494 1693.683716 1704.396033 1715.108349 3
2 2051.56185 2052.655737 2077.485806 2053.749622 2090.447782 2127.145943 3
3 7.98708 8.559489 8.765691 9.131898 9.154996 9.178094 3