Rcpp中的滚动和函数

Question

目前，我正在处理一个大型数据文件，必须为多个变量创建多个长度的滚动和。我有一个通过data.table运行的工作方法，但是运行单个变量需要相当长的时间(每个变量大约50分钟)。

我花了一些时间来改进这个脚本，以加快它的速度，但是我的想法已经用完了。我没有C++方面的经验，但我认为Rcpp包可能是一种选择。我已经亲自调查过了，但还没有想出任何有用的东西。

这是我的一个变量的data.table脚本

df_td <- setDT(df_1, key=c("Match","Name"))[,by=.(Match, Name), paste0("Period_", 1:10) 
                                        := mclapply((1:10)*600, function(x) rollsumr(Dist, x, fill = NA))][]

我使用过parallel::mclapply，它帮助了我，但它仍然需要相当长的时间才能工作。

> dput(head(df_1, 20))
structure(list(Match = c("Bath_A", "Bath_A", "Bath_A", "Bath_A", 
"Bath_A", "Bath_A", "Bath_A", "Bath_A", "Bath_A", "Bath_A", "Bath_A", 
"Bath_A", "Bath_A", "Bath_A", "Bath_A", "Bath_A", "Bath_A", "Bath_A", 
"Bath_A", "Bath_A"), Name = c("Jono Lance", "Jono Lance", "Jono     Lance", 
"Jono Lance", "Jono Lance", "Jono Lance", "Jono Lance", "Jono Lance", 
"Jono Lance", "Jono Lance", "Jono Lance", "Jono Lance", "Jono Lance", 
"Jono Lance", "Jono Lance", "Jono Lance", "Jono Lance", "Jono Lance", 
"Jono Lance", "Jono Lance"), Dist = c(0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Dist_HS = c(0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), Dist_SD = c(0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), row.names =    c(NA, 
-20L), class = c("tbl_df", "tbl", "data.frame"))

> str(df_1)
Classes ‘tbl_df’, ‘tbl’ and 'data.frame':   26533771 obs. of  5     variables:
$ Match  : chr  "Bath_A" "Bath_A" "Bath_A" "Bath_A" ...
$ Name   : chr  "Jono Lance" "Jono Lance" "Jono Lance" "Jono Lance"   ...
$ Dist   : num  0 0 0 0 0 0 0 0 0 0 ...
$ Dist_HS: num  0 0 0 0 0 0 0 0 0 0 ...
$ Dist_SD: num  0 0 0 0 0 0 0 0 0 0 ...

如有任何关于如何加快这一进程的建议，将不胜感激。

Answer 1

我可能已经找到了解决问题的方法，这里。通过从Rcpp中添加以下函数

cppFunction('
NumericVector run_sum_v2(NumericVector x, int n) {

        int sz = x.size();

        NumericVector res(sz);

        // sum the values from the beginning of the vector to n 
        res[n-1] = std::accumulate(x.begin(), x.end()-sz+n, 0.0);

        // loop through the rest of the vector
        for(int i = n; i < sz; i++) {
        res[i] = res[i-1] + x[i] - x[i-n];
        }

        // pad the first n-1 elements with NA
        std::fill(res.begin(), res.end()-sz+n-1, NA_REAL);

        return res;
        }
        ')

run_sum_v2适合于我的data.table行，而不是zoo:rollsumr，而且速度似乎要快得多(<1分钟)。需要对最终数据进行一些检查，但到目前为止看起来很有希望。

已经花了两个多小时的脚本到<20秒，所以我对这种方法很满意，除非它有任何问题？

Answer 2

由于存在重叠和，所以可以重用以前迭代中的和。下面是一种使用shift的可能方法

library(RcppRoll)
DT[, Period_1 := roll_sumr(Dist, 600L, fill=NA), by=.(ID)]
for (n in 2L:10L) {
    DT[, paste0("Period_", n) := {
            x <- get(paste0("Period_", n-1L))
            shift(x, 600L) + Period_1
        },
        by=.(ID)]
}

使用Reduce替换循环：

library(RcppRoll)
DT[, Period_1 := roll_sumr(Dist, 600L, fill=NA), by=.(ID)]
DT[, paste0("Period_", 1L:10L) :=
    Reduce(function(x, y) x + y, shift(Period_1, (1L:9L)*600L), Period_1, accum=TRUE),
    by=.(ID)]

数据：

library(data.table)
set.seed(0L)
nsampl <- 6003
nIDs <- 1
DT <- data.table(ID=rep(1:nIDs, each=nsampl), 
    Dist=rnorm(nIDs*nsampl, 1000, 100))