r中的2d矩阵到3d堆叠阵列

T_s*_*s_3 3 arrays r matrix

我有一个数据帧data在R为暗淡的120000行乘5列.

每300行是以不同时间间隔(即400帧)测量的帧

行动

我试过用 array(data, c(300, 5, 400))

预期

通过分割data每300行并将这400个矩阵堆叠在一起,使这个数据帧成为一个3d数组.

实际

沿着第一列向下读取值data,并将它们放入数组的第一部分.

A5C*_*2T1 6

这是一种使用dim<-和的方法aperm:

样本数据:

set.seed(1)
mat <- matrix(sample(100, 12 * 5, TRUE), ncol = 5)
mat
#       [,1] [,2] [,3] [,4] [,5]
#  [1,]   27   69   27   80   74
#  [2,]   38   39   39   11   70
#  [3,]   58   77    2   73   48
#  [4,]   91   50   39   42   87
#  [5,]   21   72   87   83   44
#  [6,]   90  100   35   65   25
#  [7,]   95   39   49   79    8
#  [8,]   67   78   60   56   10
#  [9,]   63   94   50   53   32
# [10,]    7   22   19   79   52
# [11,]   21   66   83    3   67
# [12,]   18   13   67   48   41
Run Code Online (Sandbox Code Playgroud)

切片和切块:

Sliced <- aperm(`dim<-`(t(mat), list(5, 3, 4)), c(2, 1, 3))

Sliced
# , , 1
# 
#      [,1] [,2] [,3] [,4] [,5]
# [1,]   27   69   27   80   74
# [2,]   38   39   39   11   70
# [3,]   58   77    2   73   48
# 
# , , 2
# 
#      [,1] [,2] [,3] [,4] [,5]
# [1,]   91   50   39   42   87
# [2,]   21   72   87   83   44
# [3,]   90  100   35   65   25
# 
# , , 3
# 
#      [,1] [,2] [,3] [,4] [,5]
# [1,]   95   39   49   79    8
# [2,]   67   78   60   56   10
# [3,]   63   94   50   53   32
# 
# , , 4
# 
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    7   22   19   79   52
# [2,]   21   66   83    3   67
# [3,]   18   13   67   48   41
Run Code Online (Sandbox Code Playgroud)

调整数字以匹配您的数据.


把事情分开,我们得到:

  • t(mat):转置你的矩阵(所以我们现在有5 x 12).
  • dim<-(..., list(...)):将其转换为数组,在本例中为5(行)x 3(col)x 4(第三维).
  • aperm:最后一步的结果是按行,所以我们需要将它转换为列,所以这就像a t,但涉及多个维度.

这些也是非常有效的操作.以下是这种方法与@ akrun的比较:

m1 <- matrix(1:(300*400*5), nrow=300*400, ncol=5)

am <- function() {
  aperm(`dim<-`(t(m1), list(5, 300, 400)), c(2, 1, 3))
}

ak <- function() {
  lst <- lapply(split(seq_len(nrow(m1)),(seq_len(nrow(m1))-1) %/%300 +1),
                function(i) m1[i,])

  arr1 <- array(0, dim=c(300,5,400))
  for(i in 1:400){
    arr1[,,i] <- lst[[i]]
  }
  arr1
}

library(microbenchmark)
microbenchmark(am(), ak(), times = 20)
# Unit: milliseconds
#  expr       min        lq    median        uq      max neval
#  am()  19.09133  27.63269  31.18292  67.12434 146.2673    20
#  ak() 496.11494 518.71223 550.02215 591.27266 699.9834    20
Run Code Online (Sandbox Code Playgroud)


akr*_*run 5

另一种选择是:

 m1 <- matrix(1:(300*400*5), nrow=300*400, ncol=5)
 lst <- lapply(split(seq_len(nrow(m1)),(seq_len(nrow(m1))-1) %/%300 +1),
                         function(i) m1[i,])

 arr1 <- array(0, dim=c(300,5,400))
 for(i in 1:400){
 arr1[,,i] <- lst[[i]]
 }

m1[297:300,]
#     [,1]   [,2]   [,3]   [,4]   [,5]
#[1,]  297 120297 240297 360297 480297
#[2,]  298 120298 240298 360298 480298
#[3,]  299 120299 240299 360299 480299
#[4,]  300 120300 240300 360300 480300

 tail(arr1[,,1],4)
 #      [,1]   [,2]   [,3]   [,4]   [,5]
 #[297,]  297 120297 240297 360297 480297
 #[298,]  298 120298 240298 360298 480298
 #[299,]  299 120299 240299 360299 480299
 #[300,]  300 120300 240300 360300 480300
Run Code Online (Sandbox Code Playgroud)

或者按照@Ananda Mahto 的建议

library(abind)
arr2 <-  abind(lapply(split(seq_len(nrow(m1)), 
           (seq_len(nrow(m1))-1) %/% 300 + 1), function(x) m1[x, ]), along = 3)
Run Code Online (Sandbox Code Playgroud)

  • 稍微慢一点,但手动工作更少,将是`abind(lapply(split(seq_len(nrow(m1)), (seq_len(nrow(m1))-1) %/% 300 + 1), function(x) m1[ x, ]),沿 = 3)`(其中 `abind` 来自“abind”包)。+1。 (3认同)