Question

我正在从Excel转换一些代码，我们根据之前的元素计算矩阵中的值。这在Excel中简单易行。但是在R中，我定义了矩阵的第一行，并且每个后续行都是基于前面的行计算的，并在嵌套的for循环中使用以下等式。

If ( (spacesArray[0] &&
      spacesArray[1] &&
      spacesArray[2] == (userDraw || compDraw))){
  }

我的矩阵非常大，数千行和列，所以我的猜测是这不是一种非常有效的方法来进行这些计算。我调查了sapply和vapply，但是不明白如何执行基于前一行计算每一行的顺序步骤。

Answer 1

除非另有说明，否则R使用逐元素操作（即％*％而不是*）。

所以你可以使用它来删除列循环并只迭代行：

for (i in 2:nrow(tau)) {
  tau[i,] <- tau[i-1,] + step1 * 1.0025 ^ (i-2)
}

行迭代似乎难以矢量化，因为当前结果取决于之前的结果，但也许其他人知道如何？

编辑如果你想获得有趣 ctional，你可以使用基地R中的瑞士军刀Reduce：

calc_next_row <- function(tau, row_idx) {
  tau + step1 * 1.0025 ^ row_idx
}
tau <- do.call(rbind, Reduce(calc_next_row, 
                             init = A, 
                             x = 0:(n - 1), 
                             accumulate = TRUE))

但这不如简单的行循环有效。每个解决方案的基准，包括F.Privé的Rcpp解决方案：

# OP:
f1 <- function(step1, A, n) {
  m <- length(step1)
  tau <- matrix(0,nrow=n+1,ncol=m)
  tau[1,] <- A
  for(j in 1:m){
    for(i in 2:nrow(tau)){
      tau[i,j] <- tau[i-1,j] + step1[j]*1.0025^(i-2)
    }
  }
  tau
}

# reduce:
f2 <- function(step1, A, n) {
  calc_next_row <- function(tau, row_idx) {
    tau + step1 * 1.0025 ^ row_idx
  }
  do.call(rbind, Reduce(calc_next_row, 
                        init = A, 
                        x = 0:(n - 1), 
                        accumulate = TRUE))
}
# row loop:
f3 <- function(step1, A, n) {
  m <- length(step1)
  tau <- matrix(0, nrow = n + 1, ncol = m)
  tau[1,] <- A
  for (i in 2:nrow(tau)) {
    tau[i,] <- tau[i-1,] + step1 * 1.0025 ^ (i-2)
  }
  tau
}
# Rcpp:
f4 <- Rcpp::cppFunction(
  'NumericMatrix to_col_cumsum(const NumericVector& step1,
                               const NumericVector& A,
                               int n) {
    int m = step1.length();
    NumericMatrix tau(n + 1, m);
    int i, j;

    // precomputing this is important
    NumericVector pows(n + 1);
    for (i = 1; i < (n + 1); i++) pows[i] = pow(1.0025, i - 1);

    for (j = 0; j < m; j++) {
      tau(0, j) = A[j];
      for (i = 1; i < (n + 1); i++) {
        tau(i, j) = tau(i - 1, j) + step1[j] * pows[i];
      }
    }

    return tau;
  }'
)

# Benchmark:
step1 <- runif(1000)
A <- rnorm(1000)
n <- 2000
microbenchmark::microbenchmark(
  op = f1(step1, A, n), 
  row_loop = f2(step1, A, n), 
  reducer = f3(step1, A, n), 
  cpp_func = f4(step1, A, n), 
  times = 100
)

Unit: milliseconds
     expr          min           lq        mean      median          uq         max neval cld
       op 22881.150072 23712.608311 24446.22800 24212.72722 24810.87869 30865.60716   100   b
 row_loop    18.811252    22.576583    60.21691    86.10406    92.87068   121.79630   100  a 
  reducer    37.818059    52.499337    92.11537   111.91877   117.38741   175.65307   100  a 
 cpp_func     8.065577     9.773429    21.46255    11.52513    13.50676    85.68727   100  a

Answer 2

在Rcpp中实现您的代码：

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
NumericMatrix to_col_cumsum(const NumericVector& step1,
                            const NumericVector& A,
                            int n) {

  int m = step1.length();
  NumericMatrix tau(n + 1, m);
  int i, j;

  // precomputing this is important
  NumericVector pows(n + 1);
  for (i = 1; i < (n + 1); i++) pows[i] = pow(1.0025, i - 1);

  for (j = 0; j < m; j++) {
    tau(0, j) = A[j];
    for (i = 1; i < (n + 1); i++) {
      tau(i, j) = tau(i - 1, j) + step1[j] * pows[i];
    }
  }

  return tau;
}

验证

step1 <- c(0.0013807009, 0.0005997510, 0.0011314072, 0.0016246001, 0.0014240778)
A <- c( 34.648458,  1.705335,  0.000010, 11.312707,  9.167534)
n <- 10

# OP
f1 <- function(step1, A, n) {
  m <- length(step1)
  tau <- matrix(0,nrow=n+1,ncol=m)
  tau[1,] <- A
  for(j in 1:m){
    for(i in 2:nrow(tau)){
      tau[i,j] <- tau[i-1,j] + step1[j]*1.0025^(i-2)
    }
  }
  tau
}

# Hayden
f2 <- function(step1, A, n) {
  calc_next_row <- function(tau, row_idx) {
    tau + step1 * 1.0025 ^ row_idx
  }
  do.call(rbind, Reduce(calc_next_row, 
                        init = A, 
                        x = 0:(n - 1), 
                        accumulate = TRUE))
}
all.equal(f2(step1, A, n), f1(step1, A, n))
all.equal(to_col_cumsum(step1, A, n), f1(step1, A, n))

基准：

step1 <- runif(1000)
A <- rnorm(1000)
n <- 2000
microbenchmark::microbenchmark(
  HR = f2(step1, A, n), 
  FP = to_col_cumsum(step1, A, n), 
  times = 100
)

结果：

Unit: milliseconds
 expr       min        lq      mean    median        uq       max neval cld
   HR 10.907345 13.127121 18.337656 14.680584 16.419786 131.97709   100   b
   FP  6.516132  7.308756  9.140994  9.139504  9.841078  17.28872   100  a

Hayden Rabel的R代码相当快！

使用排序计算矩阵，无需嵌套for循环，以便更快地进行计算

2 个答案: