将某些数组元素固定在R

时间:2019-07-08 02:25:09

标签: arrays r

我确定这是一个非常简单的问题,但是我不确定如何执行此操作。我给出了一个尺寸为(4,4,5)的示例数组,如下所示:

     [,1] [,2] [,3] [,4]
[1,]    1    0    5    0
[2,]    0   NA    0    6
[3,]    0    0    0    0
[4,]    0    0    0    0

     [,1] [,2] [,3] [,4]
[1,]    1    0    10   0
[2,]    0   NA    0    12
[3,]    0    0    0    0
[4,]    0    0    0    0

     [,1] [,2] [,3] [,4]
[1,]    1    0    15   0
[2,]    0   NA    0    18
[3,]    0    0    0    0
[4,]    0    0    0    0

     [,1] [,2] [,3] [,4]
[1,]    1    0    20   0
[2,]    0   NA    0    24
[3,]    0    0    0    0
[4,]    0    0    0    0

     [,1] [,2] [,3] [,4]
[1,]    1    0    25   0
[2,]    0   NA    0    30
[3,]    0    0    0    0
[4,]    0    0    0    0

基本上,对于此示例数组,我希望[1,3]和[2,4]的元素沿第3维变化,但我不确定如何在R中编写此代码。尝试使用代码array(c(1,0,0,0,0,NA,0,0,5,0,0,0,0,6,0,0), dim=c(4,4,3))的变体,然后尝试在线检查,但似乎找不到任何可以解决此问题的方法,因此,请多谢我能提供的任何帮助。

3 个答案:

答案 0 :(得分:2)

我不太确定您的预期输出,但是也许使用for循环来进行类似的事情?

arr <- array(c(1,0,0,0,0,NA,0,0,5,0,0,0,0,6,0,0), dim=c(4,4,3))

for (i in seq_len(dim(arr)[3])) {
    arr[1, 3, i] <- 100;       # Change entry (1, 3) of every 2d matrix 
    arr[2, 4, i] <- 100;       # Change entry (2, 4) of every 2d matrix
}
arr
#, , 1
#
#     [,1] [,2] [,3] [,4]
#[1,]    1    0  100    0
#[2,]    0   NA    0  100
#[3,]    0    0    0    0
#[4,]    0    0    0    0
#
#, , 2
#
#     [,1] [,2] [,3] [,4]
#[1,]    1    0  100    0
#[2,]    0   NA    0  100
#[3,]    0    0    0    0
#[4,]    0    0    0    0
#
#, , 3
#
#     [,1] [,2] [,3] [,4]
#[1,]    1    0  100    0
#[2,]    0   NA    0  100
#[3,]    0    0    0    0
#[4,]    0    0    0    0

@Cole指出,在这种(简单)情况下,无需进行for循环

arr[1, 3, ] <- 100
arr[2, 4, ] <- 100

比.p快得多。

答案 1 :(得分:2)

您也可以使用矩阵索引进行一次分配:

arr[cbind(c(1,2),c(3,4),rep(seq_len(dim(arr)[[3]]), each=2))] <- c(80,100)
arr
#, , 1
# 
#     [,1] [,2] [,3] [,4]
#[1,]    1    0   80    0
#[2,]    0   NA    0  100
#[3,]    0    0    0    0
#[4,]    0    0    0    0
# 
#, , 2
#
#    [,1] [,2] [,3] [,4]
#[1,]    1    0   80    0
#[2,]    0   NA    0  100
#[3,]    0    0    0    0
#[4,]    0    0    0    0
# 
#, , 3
#
#     [,1] [,2] [,3] [,4]
#[1,]    1    0   80    0
#[2,]    0   NA    0  100
#[3,]    0    0    0    0
#[4,]    0    0    0    0

[]中的部分为每个要替换的值提供索引row/col/strata

cbind(c(1,2),c(3,4),rep(seq_len(dim(arr)[[3]]), each=2))
#     row  col  strata
#     [,1] [,2] [,3]
#[1,]    1    3    1
#[2,]    2    4    1
#[3,]    1    3    2
#[4,]    2    4    2
#[5,]    1    3    3
#[6,]    2    4    3

答案 2 :(得分:1)

如果要基于值进行更新,请应用条件:

arr[arr > 4 ] <- 100

正在发生的是内部arr > 4正在生成一个数组:

, , 1

      [,1]  [,2]  [,3]  [,4]
[1,] FALSE FALSE  TRUE FALSE
[2,] FALSE    NA FALSE  TRUE
[3,] FALSE FALSE FALSE FALSE
[4,] FALSE FALSE FALSE FALSE

, , 2

      [,1]  [,2]  [,3]  [,4]
[1,] FALSE FALSE  TRUE FALSE
[2,] FALSE    NA FALSE  TRUE
[3,] FALSE FALSE FALSE FALSE
[4,] FALSE FALSE FALSE FALSE

, , 3

      [,1]  [,2]  [,3]  [,4]
[1,] FALSE FALSE  TRUE FALSE
[2,] FALSE    NA FALSE  TRUE
[3,] FALSE FALSE FALSE FALSE
[4,] FALSE FALSE FALSE FALSE

然后我们只是说给真值分配一个值。我们也可以使用which(arr > 4, arr.ind = T)来返回类似于@thelatemail的解决方案的矩阵,而无需键入。这使我们能够获得您原始的帖子答案:

which_cond <- which(arr>4, arr.ind = T) 
arr[which_cond] <- arr[which_cond] * which_cond[, 3]
arr
, , 1

     [,1] [,2] [,3] [,4]
[1,]    1    0    5    0
[2,]    0   NA    0    6
[3,]    0    0    0    0
[4,]    0    0    0    0

, , 2

     [,1] [,2] [,3] [,4]
[1,]    1    0   10    0
[2,]    0   NA    0   12
[3,]    0    0    0    0
[4,]    0    0    0    0

, , 3

     [,1] [,2] [,3] [,4]
[1,]    1    0   15    0
[2,]    0   NA    0   18
[3,]    0    0    0    0
[4,]    0    0    0    0

which_cond
     dim1 dim2 dim3
[1,]    1    3    1
[2,]    2    4    1
[3,]    1    3    2
[4,]    2    4    2
[5,]    1    3    3
[6,]    2    4    3

性能:

#4x4x3 array
Unit: microseconds
                 expr    min      lq    mean  median      uq    max neval
        maur_improved    2.4    3.55    5.42    4.90    5.95   24.4   100
 latemail_all_at_once    6.4    8.70   14.00   15.20   18.40   25.3   100
        maur_for_loop 3280.0 3510.00 3810.00 3630.00 3770.00 6430.0   100
      cole_subset_mat    2.0    3.05    4.71    4.05    6.50   10.2   100
           cole_which   27.9   34.50   47.70   45.40   54.80  228.0   100

#4x4x3E6 array
Unit: milliseconds
                 expr   min    lq  mean median    uq  max neval
        maur_improved  82.9  84.8  89.7   85.8  87.4  165   100
 latemail_all_at_once 347.0 361.0 391.0  378.0 417.0  564   100
        maur_for_loop 422.0 432.0 462.0  451.0 486.0  721   100
      cole_subset_mat 304.0 330.0 369.0  354.0 395.0  527   100
           cole_which 783.0 842.0 899.0  878.0 928.0 1370   100

和代码:

arr <- array(c(1,0,0,0,0,NA,0,0,5,0,0,0,0,6,0,0), dim=c(4,4,3))

library(microbenchmark)

x = microbenchmark(
  maur_improved = {
    arr[1,3, ] <- 100
    arr[2, 4, ] <- 100
  },
  latemail_all_at_once = {
    arr[cbind(c(1,2),c(3,4),rep(seq_len(dim(arr)[[3]]), each=2))] <- c(80,100)
  },
  maur_for_loop = {
    for (i in seq_len(dim(arr)[3])) {
      arr[1, 3, i] <- 100;       # Change entry (1, 3) of every 2d matrix 
      arr[2, 4, i] <- 100;       # Change entry (2, 4) of every 2d matrix
    }
  },
  cole_subset_mat = {
    arr[arr > 4] <- 100
  }
  , cole_which = {
    which_cond <- which(arr>4, arr.ind = T) 
    arr[which_cond] <- arr[which_cond] * which_cond[, 3]
  }
)
print(x, signif = 3)