重组(交换层)列表列表

Question

这是我的真实数据列表的示例列表:

df <- c(1, 2, 3)
x <- list(df, df, df)
y <- list(df, df, df)
z <- list(df, df, df)
lista <- list(x, y, z)
listb <- list(x, y, z)
lols <- list(a = lista, b =listb)

lols 的结构如下:

        lols
         |
      ________
     |        |
     a        b
     |        |
   _____    _____
  |  |  |  |  |  |
  x  y  z  x  y  z

我想将 lols 重组为以下形状:

          lols
           |
      ___________
     |     |     |  
     x     y     z  
     |     |     |
    ___   ___   ___
   |   | |   | |   |
   a   b a   b a   b
  

我设法使用 for 循环来做到这一点，但我不确定它是否正确，以及它是否可以有效地处理非常大的真实数据:

newl <- rep(list(list()), length(lols[[1]]))

for (i in seq_along(lols)) {
  for(j in seq_along(lols[[i]])) {
    newl[[j]][[i]] <- lols[[i]][[j]]
  }
}

有没有更快的方法，因为 R 中的 for 循环被认为非常慢？

在我的代码中，列表名称被删除了，我怎样才能保留这些名称？

编辑:基于我的微基准测试和接受的答案以及评论建议的 purrr::transpose()

fun1 <- function(ls) {
  newl <- rep(list(list()), length(ls[[1]]))
  for (i in seq_along(ls)) {
    for (j in seq_along(ls[[i]])) {
      newl[[j]][[i]] <- ls[[i]][[j]]
    }
  }
  
  return(newl)
}

fun2 <- function(ls) {
  nm <- el(lapply(ls, names))
  newl <- lapply(nm, \(i) lapply(ls, '[[', i)) |> setNames(nm)
}

fun3 <- function(ls) {
  purrr::transpose(ls)
}

microbenchmark::microbenchmark(fun1(loaded), fun2(loaded), fun3(loaded), times = 1000)

#> Unit: microseconds
#>          expr    min      lq      mean  median      uq     max neval
#>  fun1(loaded) 7631.3 8029.35 8877.8146 8296.65 8946.65 37443.3  1000
#>  fun2(loaded)   66.6   81.60  118.0540  113.75  135.00   923.9  1000
#>  fun3(loaded)    2.9    3.90   16.0451   15.60   27.80    70.7  1000

Answer 1

更好地命名您的列表元素，然后您可以遍历列表的第一层 names。

nm <- el(lapply(lols, names))
newl <- lapply(nm, \(i) lapply(lols, '[[', i)) |> setNames(nm)

给予

str(newl)
# List of 3
# $ x:List of 2
# ..$ a:List of 3
# .. ..$ k: num [1:3] 1 2 3
# .. ..$ l: num [1:3] 1 2 3
# .. ..$ m: num [1:3] 1 2 3
# ..$ b:List of 3
# .. ..$ k: num [1:3] 1 2 3
# .. ..$ l: num [1:3] 1 2 3
# .. ..$ m: num [1:3] 1 2 3
# $ y:List of 2
# ..$ a:List of 3
# .. ..$ k: num [1:3] 1 2 3
# .. ..$ l: num [1:3] 1 2 3
# .. ..$ m: num [1:3] 1 2 3
# ..$ b:List of 3
# .. ..$ k: num [1:3] 1 2 3
# .. ..$ l: num [1:3] 1 2 3
# .. ..$ m: num [1:3] 1 2 3
# $ z:List of 2
# ..$ a:List of 3
# .. ..$ k: num [1:3] 1 2 3
# .. ..$ l: num [1:3] 1 2 3
# .. ..$ m: num [1:3] 1 2 3
# ..$ b:List of 3
# .. ..$ k: num [1:3] 1 2 3
# .. ..$ l: num [1:3] 1 2 3
# .. ..$ m: num [1:3] 1 2 3

或者也不重命名，试试

lapply(1:3, \(i) lapply(lols, '[[', i)) |> setNames(c('x', 'y', 'z'))

---

数据:

lols <- list(a = list(x = list(k = c(1, 2, 3), l = c(1, 2, 3), m = c(1, 
2, 3)), y = list(k = c(1, 2, 3), l = c(1, 2, 3), m = c(1, 2, 
3)), z = list(k = c(1, 2, 3), l = c(1, 2, 3), m = c(1, 2, 3))), 
    b = list(x = list(k = c(1, 2, 3), l = c(1, 2, 3), m = c(1, 
    2, 3)), y = list(k = c(1, 2, 3), l = c(1, 2, 3), m = c(1, 
    2, 3)), z = list(k = c(1, 2, 3), l = c(1, 2, 3), m = c(1, 
    2, 3))))