Nested sliding sum in vector
I am trying to create an efficient code to compute the result of a vector r
from an input vector v
using this function.
r(i) = \sum_{j=i}^{i-N} [o(i)-o(j)] * exp(o(i)-o(j))
where i
loops (N to M) over the vector v
. The size v
is M>>N
.
Of course it is possible with two nested loops, but it is too slow for computational purposes, perhaps out of fashion and outdated style ...
A MWE:
for (i in c(N+1):length(v)){
csum <- 0
for (j in i:c(i-N)) {
csum <- csum + (v[i]-v[j])*exp(v[i]-v[j])
}
r[i] <- csum
}
There are indeed multiple vectors in my real application M > 10^5
and vector v
.
I am trying to use nested lapply and rollapply apps with no success. Any suggestion is greatly appreciated.
Thank!
source to share
I don't know if it is more efficient, but you can try:
r[N:M] <- sapply(N:M, function(i) tail(cumsum((v[i]-v[1:N])*exp(v[i]-v[1:N])), 1))
checking that both calculations give the same results, I got r
my way and r2
with mine, initializing r2
to rep(NA, M)
and evaluating the similarity:
all((r-r2)<1e-12, na.rm=TRUE)
# [1] TRUE
NOTE: as in @ lmo's answer tail(cumsum(...), 1)
can be effectively replaced with a simple use sum(...)
:
r[N:M] <- sapply(N:M, function(i) sum((v[i]-v[1:N])*exp(v[i]-v[1:N])))
source to share
Here is a one-loop method for
.
# create new blank vector
rr <- rep(NA,M)
for(i in N:length(v)) {
rr[i] <- sum((v[i] - v[seq_len(N)]) * exp(v[i] - v[seq_len(N)]))
}
check equality
all.equal(r, rr)
[1] TRUE
You can reduce the number of transactions by 1 if you keep the difference. This should speed up a bit.
for(i in N:length(v)) {
x <- v[i] - v[seq_len(N)]
rr[i] <- sum(x * exp(x))
}
source to share