Накопленная сумма, основанная на условии, но сбрасываемая после завершения условия - PullRequest
Новая
       30

Накопленная сумма, основанная на условии, но сбрасываемая после завершения условия

2 голосов
/ 26 сентября 2019

Как улучшить производительность сброса накопленной суммы при условии?

У меня есть data.frame с демонстрационным набором данных, прикрепленным под именем переменной demo.У меня есть столбец с flag, в котором говорится о сбое системы, а затем столбец continuousfailure, который подсчитывает, сколько раз подряд происходит сбой, и сбрасывается после его возвращения.Я использую пакеты tidyverse, а также базовую версию R.

Я читал некоторые сообщения StackOverflow, касающиеся этой проблемы, но я просто не могу обернуться вокруг решения, которое быстрее с использованием tidyverse и / илиbase R. Я реализовал версию этого с использованием цикла for, но вычислительное время занимает слишком много времени для больших наборов данных (9 минут для фрейма данных 107388 строк).Есть ли более эффективное решение этой проблемы?

Набор тестовых данных: 

demo <- data.frame(data = rnorm(100, mean = 0, sd = 2000), flag = c(rep(FALSE, 5), rep(TRUE, 10), rep(FALSE, 25), rep(TRUE, 23), rep(FALSE, 13), rep(TRUE, 5), rep(FALSE, 19)),
continuousfailure = c(rep(0, 5), 1:10, rep(0, 25), 1:23, rep(0, 13), 1:5, rep(0, 19)),magnitude = NA)

Код, который я сейчас использую: 

for(i in 1:length(demo$data)) {
  if(demo$flag[i]) {
    bin <- 0
    for(j in 1:demo$continuousfailure[i]) {
      bin <- bin + demo$data[i - j + 1]
    }
    demo$magnitude[i] <- bin
  }
}

Ожидаемый результат:ожидается, что это будет то же самое, но использование tidyverse или base R, которое улучшит скорость функции, будет также оценено с небольшим объяснением того, как была построена логика.

Спасибо!

Ответы [ 2 ]

2 голосов
/ 26 сентября 2019

Мы можем использовать data.table rleid для создания групп и возврата cumsum или NA на основе flag

library(dplyr)

demo %>%
  group_by(group = data.table::rleid(flag)) %>%
  mutate(new_mag = if(first(flag)) cumsum(data) else NA) %>%
  ungroup %>%
  select(-group)

#     data flag  continuousfailure magnitude new_mag
#    <dbl> <lgl>             <dbl>     <dbl>   <dbl>
# 1 -1121. FALSE                 0       NA      NA 
# 2  -460. FALSE                 0       NA      NA 
# 3  3117. FALSE                 0       NA      NA 
# 4   141. FALSE                 0       NA      NA 
# 5   259. FALSE                 0       NA      NA 
# 6  3430. TRUE                  1     3430.   3430.
# 7   922. TRUE                  2     4352.   4352.
# 8 -2530. TRUE                  3     1822.   1822.
# 9 -1374. TRUE                  4      448.    448.
#10  -891. TRUE                  5     -443.   -443.
# … with 90 more rows

, где magnitude - это столбец со значением от for loop и new_mag - это вывод из кода выше.

Существует несколько способов создания групп.Один из них, как показано выше, использует rleid, другой использует lag из dplyr и cumsum

group_by(group = cumsum(flag != lag(flag, default = first(flag)))) %>%

, а другой - base rle

group_by(group = with(rle(flag), rep(seq_along(lengths), lengths)))

Вы можете заменить строку group_by любой из вышеперечисленных.

data 

set.seed(123)
demo <- data.frame(data = rnorm(100, mean = 0, sd = 2000), 
flag = c(rep(FALSE, 5), rep(TRUE, 10), rep(FALSE, 25), rep(TRUE, 23),rep(FALSE, 13),
rep(TRUE, 5), rep(FALSE, 19)),continuousfailure = c(rep(0, 5), 1:10, rep(0, 25), 
1:23, rep(0, 13), 1:5, rep(0, 19)),magnitude = NA)
0 голосов
/ 26 сентября 2019

Мы можем использовать data.table методы 

library(data.table)
setDT(demo)[,   new := if(first(flag)) cumsum(data) else NA_real_, rleid(flag)]

данные 

set.seed(123)
demo <- data.frame(data = rnorm(100, mean = 0, sd = 2000), 
flag = c(rep(FALSE, 5), rep(TRUE, 10), rep(FALSE, 25), rep(TRUE, 23),rep(FALSE, 13),
rep(TRUE, 5), rep(FALSE, 19)),continuousfailure = c(rep(0, 5), 1:10, rep(0, 25), 
1:23, rep(0, 13), 1:5, rep(0, 19)),magnitude = NA)
...