拆分和操作嵌套列表

Question

我试图通过组变量拆分嵌套列表.请考虑以下结构:

> str(L1)
List of 2
 $ names:List of 2
  ..$ first: chr [1:5] "john" "lisa" "anna" "mike" ...
  ..$ last : chr [1:5] "johnsson" "larsson" "johnsson" "catell" ...
 $ stats:List of 2
  ..$ physical:List of 2
  .. ..$ age   : num [1:5] 14 22 53 23 31
  .. ..$ height: num [1:5] 165 176 179 182 191
  ..$ mental  :List of 1
  .. ..$ iq: num [1:5] 102 104 99 87 121

现在我需要生成两个列表,这两个列表L1$names$last用于拼接,导致L2和L3,如下所示:

L2:按结果分组的结果 L1$names$last

> str(L2) 
List of 3
 $ johnsson:List of 2
  ..$ names:List of 1
  .. ..$ first: chr [1:2] "john" "anna"
  ..$ stats:List of 2
  .. ..$ physical:List of 2
  .. .. ..$ age   : num [1:2] 14 53
  .. .. ..$ height: num [1:2] 165 179
  .. ..$ mental  :List of 1
  .. .. ..$ iq: num [1:2] 102 99
 $ larsson :List of 2
  ..$ names:List of 1
  .. ..$ first: chr [1:2] "lisa" "steven"
  ..$ stats:List of 2
  .. ..$ physical:List of 2
  .. .. ..$ age   : num [1:2] 22 31
  .. .. ..$ height: num [1:2] 176 191
  .. ..$ mental  :List of 1
  .. .. ..$ iq: num [1:2] 104 121
 $ catell  :List of 2
  ..$ names:List of 1
  .. ..$ first: chr "mike"
  ..$ stats:List of 2
  .. ..$ physical:List of 2
  .. .. ..$ age   : num 23
  .. .. ..$ height: num 182
  .. ..$ mental  :List of 1
  .. .. ..$ iq: num 87

L3:每组只允许一次出现 L1$names$last

List of 2
 $ 1:List of 2
  ..$ names:List of 2
  .. ..$ first: chr [1:3] "john" "lisa" "mike"
  .. ..$ last : chr [1:3] "johnsson" "larsson" "catell"
  ..$ stats:List of 2
  .. ..$ physical:List of 2
  .. .. ..$ age   : num [1:3] 14 22 23
  .. .. ..$ height: num [1:3] 165 176 182
  .. ..$ mental  :List of 1
  .. .. ..$ iq: num [1:3] 102 104 87
 $ 2:List of 2
  ..$ names:List of 2
  .. ..$ first: chr [1:2] "anna" "steven"
  .. ..$ last : chr [1:2] "johnsson" "larsson"
  ..$ stats:List of 2
  .. ..$ physical:List of 2
  .. .. ..$ age   : num [1:2] 53 31
  .. .. ..$ height: num [1:2] 179 191
  .. ..$ mental  :List of 1
  .. .. ..$ iq: num [1:2] 99 121

我试图应用此解决方案,但似乎这对嵌套列表不起作用.

可重现的代码:

L1 <- list("names" = list("first" = c("john","lisa","anna","mike","steven"),"last" = c("johnsson","larsson","johnsson","catell","larsson")),"stats" = list("physical" = list("age" = c(14,22,53,23,31), "height" = c(165,176,179,182,191)), "mental" = list("iq" = c(102,104,99,87,121))))

L2 <- list("johnsson" = list("names" = list("first" = c("john","anna")),"stats" = list("physical" = list("age" = c(14,53), "height" = c(165,179)), "mental" = list("iq" = c(102,99)))), "larsson" = list("names" = list("first" = c("lisa","steven")),"stats" = list("physical" = list("age" = c(22,31), "height" = c(176,191)), "mental" = list("iq" = c(104,121)))), "catell" = list("names" = list("first" = "mike"),"stats" = list("physical" = list("age" = 23, "height" = 182), "mental" = list("iq" = 87))))

L3 <- list("1" = list("names" = list("first" = c("john","lisa","mike"),"last" = c("johnsson","larsson","catell")),"stats" = list("physical" = list("age" = c(14,22,23), "height" = c(165,176,182)), "mental" = list("iq" = c(102,104,87)))), "2" = list("names" = list("first" = c("anna","steven"),"last" = c("johnsson","larsson")),"stats" = list("physical" = list("age" = c(53,31), "height" = c(179,191)), "mental" = list("iq" = c(99,121)))))

编辑:请注意,实际数据集非常大,嵌套比提供的示例更深.

Answer 1

通常,对于修改列表,您将需要使用递归.例如,考虑这个功能:

foo <- function(x, idx) {

    if (is.list(x)) {
        return(lapply(x, foo, idx = idx))
    }
    return(x[idx])
}

它需要一些列表x和一些索引idx.它将检查是否x是一个列表,如果是这种情况,它将自己为列表的所有子元素提供服务.一旦x不再是列表,我们采用给出的元素idx.在整个过程中,原始列表的结构将保持不变.

这是一个完整的例子.请注意,此代码假定列表中的所有向量都有5个元素.

L1 <- list("names" = list("first" = c("john","lisa","anna","mike","steven"),"last" = c("johnsson","larsson","johnsson","catell","larsson")),"stats" = list("physical" = list("age" = c(14,22,53,23,31), "height" = c(165,176,179,182,191)), "mental" = list("iq" = c(102,104,99,87,121))))

L2 <- list("johnsson" = list("names" = list("first" = c("john","anna")),"stats" = list("physical" = list("age" = c(14,53), "height" = c(165,179)), "mental" = list("iq" = c(102,99)))), "larsson" = list("names" = list("first" = c("lisa","steven")),"stats" = list("physical" = list("age" = c(22,31), "height" = c(176,191)), "mental" = list("iq" = c(104,121)))), "catell" = list("names" = list("first" = "mike"),"stats" = list("physical" = list("age" = 23, "height" = 182), "mental" = list("iq" = 87))))

L3 <- list("1" = list("names" = list("first" = c("john","lisa","mike"),"last" = c("johnsson","larsson","catell")),"stats" = list("physical" = list("age" = c(14,22,23), "height" = c(165,176,182)), "mental" = list("iq" = c(102,104,87)))), "2" = list("names" = list("first" = c("anna","steven"),"last" = c("johnsson","larsson")),"stats" = list("physical" = list("age" = c(53,31), "height" = c(179,191)), "mental" = list("iq" = c(99,121)))))

# make L2
foo <- function(x, idx) {

    if (is.list(x)) {
        return(lapply(x, foo, idx = idx))
    }
    return(x[idx])
}

levels <- unique(L1$names$last)
L2_2 <- vector("list", length(levels))
names(L2_2) <- levels
for (i in seq_along(L2_2)) {

    idx <- L1$names$last == names(L2_2[i])
    L2_2[[i]] <- list(names = foo(L1$names[-2], idx),
                      stats = foo(L1$stats, idx))

}
identical(L2, L2_2)

str(L2)
str(L2_2)

# make L3

dups <- duplicated(L1$names$last)
L3_2 <- vector("list", 2)
names(L3_2) <- 1:2
for (i in 1:2) {

    if (i == 1)
        idx <- !dups
    else
        idx <- dups

    L3_2[[i]] <- foo(L1, idx)

}
identical(L3, L3_2)
str(L3)
str(L3_2)