R сделать более эффективной дисперсию качения

У меня есть таблица данных с именами функций со столбцами nightNo, HR, motion и angle. Я хочу получить скользящую дисперсию предыдущих 600 пунктов ЧСС, движения и угла за ночь. Для этого я придумал следующую функцию:

features <- data.table(nightNo=c(1,1,1,1,1,1,1,2,2,2,2,2,2,2),
                       HR=c(1,2,3,4,5,6,7,8,9,10,11,12,13,14),
                       motion=c(14,13,12,11,10,9,8,7,6,5,4,3,2,1),
                       angle=c(2,4,6,8,10,12,14,16,18,20,22,24,26,28))

# For the example I'll use a window of 6 instead of 600
window = 6
features[, c("HR_Variance", "motion_Variance", "angle_Variance") := 
       list(rollapply(HR, window, var, partial=TRUE, align = "right"), 
            rollapply(motion, window, var, partial=TRUE, align = "right"), 
            rollapply(angle, window, var, partial=TRUE, align = "right")), by=nightNo ]

#    nightNo HR motion angle HR_Variance motion_Variance angle_Variance
# 1:       1  1     14     2          NA              NA             NA
# 2:       1  2     13     4    0.500000        0.500000       2.000000
# 3:       1  3     12     6    1.000000        1.000000       4.000000
# 4:       1  4     11     8    1.666667        1.666667       6.666667
# 5:       1  5     10    10    2.500000        2.500000      10.000000
# 6:       1  6      9    12    3.500000        3.500000      14.000000
# 7:       1  7      8    14    3.500000        3.500000      14.000000
# 8:       2  8      7    16          NA              NA             NA
# 9:       2  9      6    18    0.500000        0.500000       2.000000
# 10:      2 10      5    20    1.000000        1.000000       4.000000
# 11:      2 11      4    22    1.666667        1.666667       6.666667
# 12:      2 12      3    24    2.500000        2.500000      10.000000
# 13:      2 13      2    26    3.500000        3.500000      14.000000
# 14:      2 14      1    28    3.500000        3.500000      14.000000

Результат правильный, но поскольку у меня большой набор данных, он работает вечно. Я также сделал другие похожие функции, которые используют runmeans и sapplys в том же окне 600 за ночь. Нет, и они работают в разумное время, что заставляет меня думать, что либо rollapply, либо функция дисперсии очень медленная. Есть ли способ сделать этот код более эффективным, возможно, изменив функцию var или rollapply?


r data.table variance rollapply
person Henk    schedule 28.06.2018    source источник
comment
возможно, используйте RcppRoll::roll_var, а также проверьте github.com/Rdatatable/data.table/issues/2778   -  person chinsoon12    schedule 28.06.2018
comment
ваш ожидаемый результат не соответствует заданным данным   -  person Roman    schedule 28.06.2018
comment
@ chinsoon12 Похоже, в roll_var, к сожалению, еще не реализован паритал, который мне нужен.   -  person Henk    schedule 28.06.2018
comment
@Jimbou Я пропустил угол 6, спасибо за хедз-ап.   -  person Henk    schedule 28.06.2018
comment
Вы всегда можете добавить NA впереди при вызове roll_var   -  person chinsoon12    schedule 29.06.2018
comment
@ chinsoon12 добавление NA, а затем использование rollapply для небольшого количества NA, кажется, помогает в разумные сроки, поскольку roll_var кажется более чем в 10 раз быстрее, чем rollapply. Спасибо!   -  person Henk    schedule 30.06.2018

Ответы (1)


arrow_upward
0
arrow_downward

Я понятия не имею, что делает rollaplly, но я произвожу этот вывод на заданных выборочных данных, используя параллельную tidyverse, которая может быть быстрее.

library(cumstats)
library(tidyverse)
library(furrr)

plan(multiprocess)
window <- 6

features %>% 
  nest(-nightNo) %>% 
  mutate(data=future_map(data,~mutate_at(.,vars(HR, motion,angle), 
                funs(var=cumvar(.)[c(1:window,rep(window,length(.)-length(1:window)))])))) %>% 
  unnest()
# A tibble: 14 x 7
   nightNo    HR motion angle HR_var motion_var angle_var
     <dbl> <dbl>  <dbl> <dbl>  <dbl>      <dbl>     <dbl>
 1       1     1     14     2  NA         NA        NA   
 2       1     2     13     4   0.5        0.5       2   
 3       1     3     12     6   1          1         4   
 4       1     4     11     8   1.67       1.67      6.67
 5       1     5     10    10   2.5        2.5      10   
 6       1     6      9    12   3.5        3.5      14   
 7       1     7      8    14   3.5        3.5      14   
 8       2     8      7    16  NA         NA        NA   
 9       2     9      6    18   0.5        0.5       2   
10       2    10      5    20   1          1         4   
11       2    11      4    22   1.67       1.67      6.67
12       2    12      3    24   2.5        2.5      10   
13       2    13      2    26   3.5        3.5      14   
14       2    14      1    28   3.5        3.5      14
person Roman    schedule 28.06.2018
comment
Кажется, это немного быстрее в окне 6, но в окне 600 выдает ошибку Ошибка в mutate_impl(.data, dots): Ошибка оценки: неверный аргумент 'times'. Я не знаком ни с одним из используемые библиотеки и функции, есть идеи, что может быть причиной этого? - person Henk; 28.06.2018
comment
@Henk У каждого есть nightNo 600 записей? - person Roman; 29.06.2018
comment
Нет, у большинства есть, а у пары меньше. - person Henk; 29.06.2018
comment
ХОРОШО. Если размер окна больше, чем записи, то выдается ошибка. Вы должны установить размер окна меньше, чем минимальное количество записей на nightNo, используя этот подход. Я могу это исправить, но вы должны предоставить некоторые примеры данных, иллюстрирующие эту проблему. - person Roman; 29.06.2018
comment
Я использовал roll_var и добавил NA, как предложил chinsoon12, а затем применил свой оригинальный rollapply к NA. roll_var более чем в 10 раз быстрее на образце с окном 6 и, кажется, делает все данные с окном 600 в разумных пределах, поэтому я думаю, что я соглашусь с этим. Спасибо за ответ и предложение исправить ошибку. - person Henk; 30.06.2018