R：根据代数符号移动数组中的每个值（矢量化解决方案）

Question

我想根据代数符号移动数组中的每个值。如果符号为正，则该值应移至 "right"，如果为负，则移至 "left"。我们可以将其形象化为每个值都是 "transported"。如果两个班次针对相同的索引，我想得到差异 - 这就是 b[i+dim(a)[1]] + a[i] 在以下代码中的作用。

我提出了以下解决方案，它基于循环，因此非常慢。 Microbenchmark 表示，具有 1,000,000 个值的二维数组需要 603 毫秒。

dims <- c(5,6)
a <- array(15:-(prod(dims-10)), dim = dims) # create some data
a <- cbind(rep(0,dims[1]),a,rep(0,dims[1])) # pad with 0
b <- array(0, dim = dim(a)) # construct empty array

shift_by_sign_x = function(a){

  #shift by sign, > 0 = forward; < 0 = backward
  for(i in 1:prod(dim(a))){ 
    if(a[i] > 0) b[i+dim(a)[1]] <- b[i+dim(a)[1]] + a[i]  # sum values up
    else if(a[i] < 0) b[i-dim(a)[1]] <- b[i-dim(a)[1]] + a[i]
  }
  return(b)
}

shift_by_sign_x(a)
#microbenchmark::microbenchmark(shift_by_sign_x(a))

有人对此有很好的矢量化解决方案吗？如果速度快，我也很欣赏非矢量化解决方案。我将处理 > 1k 个数组，每个数组有 > 1,000,000 个值。

最后，我想对 3 个维度执行此操作（示例处理 x 方向），y 将根据三维中的符号和 z 上下移动。我很感激如何在不为每个维度单独编码的情况下执行此操作的好主意。但是，我同样感谢能够解决所描述问题的解决方案。

编辑：

我使用 Grada Gukovic 的解决方案为 3D 阵列实现了这一点。以下代码块中的 shift_by_sign 函数取自 Grada 的回答。我永远不会在第一列中有负值，因为我将包括一个步骤，在添加它们之前计算每个值的 abs()。

dims <- c(100,10,40)
a <- array((prod(dims)*0.4):(-prod(dims)*0.6), dim = dims) # create some data
a[1,,] <- 0; a[,1,] <- 0; a[,,1] <- 0
a[dims[1],,] <- 0; a[,dims[2],] <- 0; a[,,dims[3]] <- 0

shift_by_sign_3d <- function(a, dimensions){
  b <- apply(a, 3, shift_by_sign)
  dim(b) <- dimensions
  return(b)
}

Answer 1

这是您要找的吗？下面的代码完全基于矩阵运算，比你的快得多。

shift_by_sign <- function(a) {
    #create a matrix of zeros 
    b <- matrix(0L, nrow = nrow(a), ncol = ncol(a) + 2)

    ar <- cbind(0L, a[,-ncol(a)]) # shift a one column to the right
    # this is ment to produce the action necessary for negative numbers
    #non-negative entries will be disregarded

    al <- cbind(a[,-1], 0L) # shift a one column to the left
    # this is ment to produce the action necessary for positive numbers
    #non-positive entries will be disregarded

    both <- ar > 0 & al < 0 # find indices in the shifted matrices, 
                            # where both shifts are necessary and you have to add the entries


    b[cbind(row(a)[a>0], col(a)[a > 0] + 1)] <-  a[cbind(row(a)[a>0], col(a)[a > 0])]
    b[cbind(row(a)[a<0], col(a)[a < 0] -1)] <- a[cbind(row(a)[a<0], col(a)[a < 0])]
    b[cbind(row(ar)[both], col(ar)[both])] <- (ar[cbind(row(ar)[both], col(ar)[both])]  
                 + al[cbind(row(al)[both], col(al)[both])])
    return(b)
}

> a
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]   15   10    5    0   -5  -10
[2,]   14    9    4   -1   -6  -11
[3,]   13    8    3   -2   -7  -12
[4,]   12    7    2   -3   -8  -13
[5,]   11    6    1   -4   -9  -14
> shift_by_sign(a)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    0   15   10    0  -10    0    0    0
[2,]    0   14    8   -2  -11    0    0    0
[3,]    0   13    6   -4  -12    0    0    0
[4,]    0   12    4   -6  -13    0    0    0
[5,]    0   11    2   -8  -14    0    0    0

结构b[cbind(row(a)[a>0], col(a)[a > 0] + shift)]的作用如下。 row(a) 和 col(a) return 维度与 a 相同的矩阵，其中每个条目分别是该元素的行或列索引：

A = matrix(-17:18,6)
> col(A)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    2    3    4    5    6
[2,]    1    2    3    4    5    6
[3,]    1    2    3    4    5    6
[4,]    1    2    3    4    5    6
[5,]    1    2    3    4    5    6
[6,]    1    2    3    4    5    6

因此 col(a)[a>0] return 是一个向量，其中大于零的所有元素的列索引按列堆叠 col(a)[a>0] 对行索引执行相同的操作。 cbind 创建一个有两列的矩阵，用于相应地修改大矩阵：

>  A[cbind(row(A)[A>0], col(A)[A > 0])] <- 0L
> A
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]  -17  -11   -5    0    0    0
[2,]  -16  -10   -4    0    0    0
[3,]  -15   -9   -3    0    0    0
[4,]  -14   -8   -2    0    0    0
[5,]  -13   -7   -1    0    0    0
[6,]  -12   -6    0    0    0    0

R：根据代数符号移动数组中的每个值（矢量化解决方案）

R: shift each value in array based on algebraic sign (vectorized solution)

r

vectorization

multidimensional-array