在R中滞后矢量化diff函数

时间:2014-04-26 02:16:04

标签: r vector vectorization

我想创建一个执行以下操作的函数:

c <- rnorm(100)
n <- 10
sum.diff<- integer(n)

for (k in 1:n) {
   sum.diff[k] <- sum(diff(c, lag=k))
}

通过矢量化而不是循环。具体来说,我想发送一个向量(这里是'c')和一个滞后值向量(这里是'1:n'),并得出第k个条目中第k个差值的总和。输出向量(这里是'sum.lags')。

例如,带有c <- 1:100的{​​{1}}应该会产生:

n <- 10

对应于:

99 196 291 ... 900 有任何想法吗?

3 个答案:

答案 0 :(得分:2)

由于在关于性能和C / C ++的评论中提到过,所以使用.Call的方法似乎是有效的:

library(inline)

ff = cfunction(sig = c(R_x = "numeric", R_lag = "integer"), body = '
   SEXP x, lag, ans;
   PROTECT(x = coerceVector(R_x, REALSXP));
   PROTECT(lag = coerceVector(R_lag, INTSXP));
   PROTECT(ans = allocVector(REALSXP, LENGTH(lag)));

   double *px = REAL(x), *pans = REAL(ans);
   memset(pans, 0, sizeof(double)*LENGTH(ans));
   R_len_t *plag = INTEGER(lag);

   for(int l = 0; l < LENGTH(lag); l++) 
       for(int i = 0; i < LENGTH(x) - plag[l]; i++) 
           pans[l] += px[i + plag[l]] - px[i];

   UNPROTECT(3);

   return(ans);
')

ff(1:100, 1:10)
#[1]  99 196 291 384 475 564 651 736 819 900

以及一些基准测试:

OPff = function(c, n) {
   sum.diff <- integer(n)
   for (k in 1:n) sum.diff[k] <- sum(diff(c, lag = k))
   sum.diff
}

ff2 = function(c, n) unlist(lapply(1:n, function(i) sum(diff(c, lag = i))))

xx = runif(1e4)
l = 1e3

identical(OPff(xx, l), ff(xx, 1:l))
#[1] TRUE
identical(OPff(xx, l), ff2(xx, l))
#[1] TRUE
library(microbenchmark)
microbenchmark(OPff(xx, l), ff(xx, 1:l), ff2(xx, l), times = 10)
#Unit: milliseconds
#        expr       min        lq    median        uq       max neval
# OPff(xx, l) 387.49171 390.43269 407.25796 427.09764 485.97181    10
# ff(xx, 1:l)  37.73505  38.27028  39.10201  41.33271  46.84648    10
#  ff2(xx, l) 384.35098 389.70397 401.51451 423.38513 436.85008    10

答案 1 :(得分:2)

data.table实现(应该比大数据集上的代码稍快)

a <- 1:100
b <- 1:10
library(data.table)
DT <- data.table(b)[, Res := sum(diff(a, b)), by = b]
DT

# b Res
# 1:  1  99
# 2:  2 196
# 3:  3 291
# 4:  4 384
# 5:  5 475
# 6:  6 564
# 7:  7 651
# 8:  8 736
# 9:  9 819
# 10: 10 900

答案 2 :(得分:1)

尝试以下方法:

 sum.diff <- function(c, n) sapply(n, function(k) sum(diff(c, lag = k)))

现在运行测试:

 sum.diff(1:100, 1:10)
 ## [1]  99 196 291 384 475 564 651 736 819 900