在列表中跨列的行上應用 function

Question

我需要 select 列表中的一列， cbind列，並對此類組合數據集的行執行 function。 因此，我需要對所有列執行此操作。 受此處答案的啟發，我為一個專欄提出了一個可能的解決方案：

x <- apply(Reduce("cbind", lapply(L, FUN = function(x) x[, 1])), 1, FUN = sd)

它很笨重，當擴展到包括所有列時會變得更糟。 讓我們有一個矩陣列表：

set.seed(2385737)
L = list(matrix(rnorm(30), ncol = 3), matrix(rnorm(30), ncol = 3), matrix(rnorm(30), ncol = 3))

X <- matrix(c(apply(Reduce("cbind", lapply(L, FUN = function(x) x[, 1])), 1, FUN = sd),
    apply(Reduce("cbind", lapply(L, FUN = function(x) x[, 2])), 1, FUN = sd),
    apply(Reduce("cbind", lapply(L, FUN = function(x) x[, 3])), 1, FUN = sd)),
    ncol = 3
)

我可以將上面的代碼概括為：

X <- sapply(1:ncol(L[[1]]), 
    FUN = function(i) apply(Reduce("cbind", 
        lapply(L, FUN = function(x) x[, i])), 1, FUN = sd))

是否有一種簡潔的方法如何對列表中的所有列進行相應的計算？

Answer 1

一種選擇是將矩陣列表堆疊到單個 3D 數組中，然后使用apply直接對該數組執行計算。 盡管很少使用，但可以為apply中的MARGIN參數提供一個邊緣索引向量，該向量允許在數組的任何維度上進行計算，因此使用MARGIN = c(1, 2)將對第三個向量上的向量執行FUN尺寸。

如果您使用 abind abind中的abind abind 從您的列表中創建數組，則這允許整個事情作為一行完成。

apply(do.call(abind::abind, c(L, along = 3)), c(1, 2), FUN = sd)
#>            [,1]      [,2]      [,3]
#>  [1,] 0.5040136 0.1593154 0.9371359
#>  [2,] 1.2781308 0.5380104 1.1967232
#>  [3,] 1.3355753 0.5445188 0.8851976
#>  [4,] 1.5333570 0.9800276 0.5928828
#>  [5,] 1.4844418 2.1511425 1.6904784
#>  [6,] 1.5158726 2.0156800 1.3566559
#>  [7,] 0.8452233 0.3058013 1.0896865
#>  [8,] 0.5742021 0.8816770 1.4622064
#>  [9,] 1.7673249 0.9863849 1.1386831
#> [10,] 0.9001773 1.0793596 0.5754467

這與上面示例中的X的結果相同。

如果你更喜歡在沒有額外包的情況下使用 base R，你可以直接創建你的數組：

apply(array(unlist(L), c(nrow(L[[1]]), ncol(L[[1]]), length(L))), c(1, 2), sd)

這給出了相同的結果。

Answer 2

基准測試：

set.seed(1); L = lapply(1:100, function(i) matrix(rnorm(1000000), ncol = 1000))
microbenchmark::microbenchmark(
  zx = {
    sapply(
      #transpose
      lapply(seq(ncol(L[[1]])), function(i)
        sapply(seq_along(L), function(j)
          L[[ j ]][, i ]
        )),
      #apply function
      function(i) apply(i, 1, sd))
  },
  sotos = {
    i1 <- seq(1, ncol(L[[1]]) * length(L), (ncol(L[[1]]) * length(L))/length(L))
    sapply(seq(0, (length(L)-1)), \(i)apply(do.call(cbind, L)[,i1+i], 1, sd))
    
  },
  allanAbind = {
    apply(do.call(abind::abind, c(L, along = 3)), c(1, 2), FUN = sd)
  },
  allanBase = {
    apply(array(unlist(L), c(nrow(L[[1]]), ncol(L[[1]]), length(L))), c(1, 2), sd)
  },
  times = 10
)
#Unit: seconds
#       expr      min       lq     mean   median       uq      max neval
#         zx 19.66990 21.16743 24.33954 23.99107 27.29293 30.42287    10
#      sotos 43.45282 45.93170 48.76219 48.05993 51.02062 55.16740    10
# allanAbind 19.81033 21.69177 25.47289 23.96392 29.19223 35.03646    10
#  allanBase 21.69405 22.26512 26.29049 23.90017 28.06595 39.60385    10

Answer 3

“轉置”列表，以便我們有 3 個（矩陣中的列數）列表，其中每個列表包含原始列表L中的第 n 列，即：第一個將包含所有矩陣的所有第一列。

然后遍歷該列表，每行應用function：

sapply(
  #transpose
  lapply(seq(ncol(L[[1]])), function(i)
    sapply(seq_along(L), function(j)
      L[[ j ]][, i ]
    )),
  #apply function
  function(i) apply(i, 1, sd))

#            [,1]      [,2]      [,3]
#  [1,] 0.5040136 0.1593154 0.9371359
#  [2,] 1.2781308 0.5380104 1.1967232
#  [3,] 1.3355753 0.5445188 0.8851976
#  [4,] 1.5333570 0.9800276 0.5928828
#  [5,] 1.4844418 2.1511425 1.6904784
#  [6,] 1.5158726 2.0156800 1.3566559
#  [7,] 0.8452233 0.3058013 1.0896865
#  [8,] 0.5742021 0.8816770 1.4622064
#  [9,] 1.7673249 0.9863849 1.1386831
# [10,] 0.9001773 1.0793596 0.5754467

Answer 4

go 的另一種方法是創建一個序列，其中包含要綁定的列（即在您的情況下為 1、4、7 - 2、5、8 - 3、6、9）並將sd function 逐行應用於每個列組合，即

i1 <- seq(1, ncol(L[[1]])* length(L), (ncol(L[[1]])*length(L))/length(L))
sapply(seq(0, (length(L)-1)), \(i)apply(do.call(cbind, L)[,i1+i], 1, sd))

           [,1]      [,2]      [,3]
 [1,] 0.5040136 0.1593154 0.9371359
 [2,] 1.2781308 0.5380104 1.1967232
 [3,] 1.3355753 0.5445188 0.8851976
 [4,] 1.5333570 0.9800276 0.5928828
 [5,] 1.4844418 2.1511425 1.6904784
 [6,] 1.5158726 2.0156800 1.3566559
 [7,] 0.8452233 0.3058013 1.0896865
 [8,] 0.5742021 0.8816770 1.4622064
 [9,] 1.7673249 0.9863849 1.1386831
[10,] 0.9001773 1.0793596 0.5754467