R语言 如何平均每个元素列表中的列表与可变数据长度?

xzv2uavs  于 2023-09-27  发布在  其他
关注(0)|答案(2)|浏览(111)

我试图创建一个多个列表的平均列表
1.可能不都包含相同的变量和
1.包含不同长度和大小的变量。
对于任何给定的变量名,该变量的大小和维度在所有列表中都是相同的。
我目前使用的是一个嵌套的for循环,它为每个变量创建一个 Dataframe ,每个单独的列表形成一列,然后用rowMeans()在列之间求平均值。这是可行的,但它是 * 真的 * 慢。每个列表都来自不同的数据试验,有超过1200个变量,大约1.5MB。
下面是三个列表的总体思路的示例。有一个元素长的变量,5个元素长的变量和一个3x3矩阵。在这个简单的例子中,第三个列表(L3)缺少变量C1和C5。我们的想法是创建一个新的列表meanL = mean(L)。期望的输出用meanL变量再现。
目前,为了处理矩阵变量,我将枢轴旋转得更长,在各列试验中取平均值,枢轴旋转得更宽。由于它们很少,我很乐意只为向量变量提供一个解决方案,如果这样更简单的话。如果我首先将列表限制为相同长度的变量,那么aggregate()似乎可以做到这一点?我还没有尝试过。

# Reprex of list data
L1 <- list(
  A1 = tibble(X1 = as.double(1)), 
  B1 = tibble(X1 = as.double(2)), 
  C1 = tibble(X1 = as.double(3)),
  A5 = tibble(X1 = as.double(1:5)), 
  B5 = tibble(X1 = as.double(6:10)), 
  C5 = tibble(X1 = as.double(11:15)),
  M1 = data.frame(X1 = as.double(1:3), 
                  X2 = as.double(4:6),
                  X3 = as.double(7:9))
  )

L2 <- list(
  A1 = tibble(X1 = as.double(4)), 
  B1 = tibble(X1 = as.double(5)), 
  C1 = tibble(X1 = as.double(6)),
  A5 = tibble(X1 = as.double(5:1)), 
  B5 = tibble(X1 = as.double(10:6)), 
  C5 = tibble(X1 = as.double(15:11)),
  M1 = data.frame(X1 = as.double(9:7), 
                  X2 = as.double(6:4),
                  X3 = as.double(3:1))
)

L3 <- list(
  A1 = tibble(X1 = as.double(7)), 
  B1 = tibble(X1 = as.double(8)), 
  A5 = tibble(X1 = as.double(11:15)), 
  B5 = tibble(X1 = as.double(16:20))
)

L <- list(L1, L2, L3)
L

# To reproduce desired output ...
L1M1 <- pivot_longer(L1$M1, cols = X1:X3)
L2M1 <- pivot_longer(L2$M1, cols = X1:X3)
M1 <- data.frame(T1 = L1M1$value, T2 = L2M1$value)

meanL <- list(A1 = tibble(X1 = mean(c(L1$A1$X1, L2$A1$X1, L3$A1$X1))), 
              B1 = tibble(X1 = mean(c(L1$B1$X1, L2$B1$X1, L3$B1$X1))), 
              C1 = tibble(X1 = mean(c(L1$C1$X1, L2$C1$X1))),
              A5 = tibble(X1 = rowMeans(cbind(L1$A5$X1, L2$A5$X1, L3$A5$X1))), 
              B5 = tibble(X1 = rowMeans(cbind(L1$B5$X1, L2$B5$X1, L3$B5$X1))),
              C5 = tibble(X1 = rowMeans(cbind(L1$C5$X1, L2$C5$X1))),
              M1 = rowMeans(M1)
              )

meanL$M1 <- data.frame(X1 = meanL$M1[1:3],
                       X2 = meanL$M1[4:6],
                       X3 = meanL$M1[7:9])

下图显示了第一个列表的前几个变量和相关的数据类型。数据可以是1行x 1列长、51行x 1列长或51行x 3列或6列长。

请注意,此问题已更新为新的reprex数据,以前的解决方案适用于以前的数据。

gpnt7bae

gpnt7bae1#

如果你可以将表格转换为矩阵,一个简单的递归函数与relist结合:

library(data.table)

tomat <- function(x) {
  if (length(dim(x)) > 1) {
    if (!is.array(x)) x <- as.matrix(x)
  } else if (is.list(x)) {
    x <- lapply(x, tomat)
  }
  
  x
}

L <- tomat(list(L1, L2, L3))
LL <- unlist(L, 0)
LL <- LL[!duplicated(names(LL))]

relist(
  colMeans(
    m <- rbindlist( # save for additional calculations
      lapply(c(list(LL), L), \(x) as.data.table(t(unlist(x)))),
      fill = TRUE
    )[-1],
    na.rm = TRUE
  ),
  LL
)
#> $A1
#>      X1
#> [1,]  4
#> 
#> $B1
#>      X1
#> [1,]  5
#> 
#> $C1
#>       X1
#> [1,] 4.5
#> 
#> $A5
#>            X1
#> [1,] 5.666667
#> [2,] 6.000000
#> [3,] 6.333333
#> [4,] 6.666667
#> [5,] 7.000000
#> 
#> $B5
#>            X1
#> [1,] 10.66667
#> [2,] 11.00000
#> [3,] 11.33333
#> [4,] 11.66667
#> [5,] 12.00000
#> 
#> $C5
#>      X1
#> [1,] 13
#> [2,] 13
#> [3,] 13
#> [4,] 13
#> [5,] 13
#> 
#> $M1
#>      X1 X2 X3
#> [1,]  5  5  5
#> [2,]  5  5  5
#> [3,]  5  5  5

例如,我们可以使用m来获得标准差:

relist(Rfast::colVars(as.matrix(m), TRUE, TRUE), LL)
#> $A1
#>      X1
#> [1,]  3
#> 
#> $B1
#>      X1
#> [1,]  3
#> 
#> $C1
#>           X1
#> [1,] 2.12132
#> 
#> $A5
#>            X1
#> [1,] 5.033223
#> [2,] 5.291503
#> [3,] 5.773503
#> [4,] 6.429101
#> [5,] 7.211103
#> 
#> $B5
#>            X1
#> [1,] 5.033223
#> [2,] 5.291503
#> [3,] 5.773503
#> [4,] 6.429101
#> [5,] 7.211103
#> 
#> $C5
#>            X1
#> [1,] 2.828427
#> [2,] 1.414214
#> [3,] 0.000000
#> [4,] 1.414214
#> [5,] 2.828427
#> 
#> $M1
#>            X1       X2       X3
#> [1,] 5.656854 1.414214 2.828427
#> [2,] 4.242641 0.000000 4.242641
#> [3,] 2.828427 1.414214 5.656854

如果里面有隐藏的人物:

L1 <- list(
  A1 = tibble(X1 = as.double(1)), 
  B1 = tibble(X1 = as.double(2)), 
  C1 = tibble(X1 = as.double(3)),
  A5 = tibble(X1 = as.double(1:5)), 
  B5 = tibble(X1 = as.double(6:10)), 
  C5 = tibble(X1 = as.double(11:15)),
  M1 = data.frame(X1 = as.double(1:3), 
                  X2 = as.double(4:6),
                  X3 = as.double(7:9)),
  T1 = tibble(x1 = "C")
)

L2 <- list(
  A1 = tibble(X1 = as.double(4)), 
  B1 = tibble(X1 = as.double(5)), 
  C1 = tibble(X1 = as.double(6)),
  A5 = tibble(X1 = as.double(5:1)), 
  B5 = tibble(X1 = as.double(10:6)), 
  C5 = tibble(X1 = as.double(15:11)),
  M1 = data.frame(X1 = as.double(9:7), 
                  X2 = as.double(6:4),
                  X3 = as.double(3:1)),
  T1 = tibble(x1 = "B")
)

L3 <- list(
  A1 = tibble(X1 = as.double(7)), 
  B1 = tibble(X1 = as.double(8)), 
  A5 = tibble(X1 = as.double(11:15)), 
  B5 = tibble(X1 = as.double(16:20)),
  T1 = tibble(x1 = "A")
)

L <- tomat(list(L1, L2, L3))
LL <- unlist(L, 0)
LL <- LL[!duplicated(names(LL))]

relist(
  type.convert(
    rbindlist(
      lapply(
        c(list(LL), L),
        \(x) as.data.table(t(unlist(x)))
      ),
      fill = TRUE
    ), "NA", 1
  )[-1, lapply(.SD, \(x) if(is.numeric(x)) mean(x, na.rm = TRUE) else x[1])], # or `else x[0]` (for NULL) or `else x[.N + 1L]` (for NA)
  LL
)
#> $A1
#>      X1
#> [1,] 4 
#> 
#> $B1
#>      X1
#> [1,] 5 
#> 
#> $C1
#>      X1 
#> [1,] 4.5
#> 
#> $A5
#>      X1      
#> [1,] 5.666667
#> [2,] 6       
#> [3,] 6.333333
#> [4,] 6.666667
#> [5,] 7       
#> 
#> $B5
#>      X1      
#> [1,] 10.66667
#> [2,] 11      
#> [3,] 11.33333
#> [4,] 11.66667
#> [5,] 12      
#> 
#> $C5
#>      X1
#> [1,] 13
#> [2,] 13
#> [3,] 13
#> [4,] 13
#> [5,] 13
#> 
#> $M1
#>      X1 X2 X3
#> [1,] 5  5  5 
#> [2,] 5  5  5 
#> [3,] 5  5  5 
#> 
#> $T1
#> $T1[[1]]
#>     
#> 1: C
l3zydbqr

l3zydbqr2#

下面是另一种方法,首先使用rrapply()(在rrapply包中)将列表解嵌套到宽 Dataframe 中,然后使用Reduce()计算(列表)列的平均值:

library(rrapply)

rrapply(L, how = "bind") |>
  lapply(FUN = \(x) Reduce(`+`, x[!is.na(x)]) / sum(!is.na(x)))

#> $A1
#> [1] 4
#> 
#> $B1
#> [1] 5
#> 
#> $C1
#> [1] 4.5
#> 
#> $A5
#> [1] 5.666667 6.000000 6.333333 6.666667 7.000000
#> 
#> $B5
#> [1] 10.66667 11.00000 11.33333 11.66667 12.00000
#> 
#> $C5
#> [1] 13 13 13 13 13
#> 
#> $M1
#>      [,1] [,2] [,3]
#> [1,]    5    5    5
#> [2,]    5    5    5
#> [3,]    5    5    5

**编辑:**由于问题更改,这里是更新的答案。输出是一个列的平面列表,但如果需要,可以通过按父名称嵌套再次将其转换为data.frames列表。

rrapply(L, how = "bind", options = list(coldepth = 2)) |>
  lapply(FUN = \(x) Reduce(`+`, x[!is.na(x)]) / sum(!is.na(x))) 

#> $A1.X1
#> [1] 4
#> 
#> $B1.X1
#> [1] 5
#> 
#> $C1.X1
#> [1] 4.5
#> 
#> $A5.X1
#> [1] 5.666667 6.000000 6.333333 6.666667 7.000000
#> 
#> $B5.X1
#> [1] 10.66667 11.00000 11.33333 11.66667 12.00000
#> 
#> $C5.X1
#> [1] 13 13 13 13 13
#> 
#> $M1.X1
#> [1] 5 5 5
#> 
#> $M1.X2
#> [1] 5 5 5
#> 
#> $M1.X3
#> [1] 5 5 5

相关问题