Функция скользящей суммы в Rcpp - PullRequest
Новая
       46

Функция скользящей суммы в Rcpp

0 голосов
/ 03 декабря 2018

В данный момент я работаю с большим фреймом данных и должен создать скользящую сумму нескольких длин для ряда переменных.У меня есть рабочий метод через 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 ...

Будем весьма благодарны за любые предложения, как это можно ускорить

Ответы [ 2 ]

0 голосов
/ 03 декабря 2018

Так как суммы перекрываются, вы можете повторно использовать суммы предыдущих итераций.Вот возможный подход с использованием 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)]

data: 

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))
0 голосов
/ 03 декабря 2018

Возможно, я нашел решение моей проблемы здесь .Добавив следующую функцию из 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 мин).Нужно проверить некоторые конечные данные, но пока выглядит многообещающе. </p>

Сценарий продолжительностью 2 с лишним часа сократился до <20 секунд, поэтому я доволен этим подходом, если с ним нет проблем?</p>

...