我想创建一个执行以下操作的函数:
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
有任何想法吗?
答案 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