Динамический Cumsum с условием

Question

У меня есть следующая проблема, которую я пытаюсь решить. Вот некоторые примеры данных:

library(tidyverse)
library(lubridate)

date <- data.frame(date=seq(ymd('2018-01-01'),ymd('2018-02-28'), by = '1 day'))
group <- data.frame(group=c("A","B"))
subgroup <- data.frame(subgroup=c("C","D"))

DF <- merge(merge(date,group,by=NULL),subgroup,by=NULL)
DF$group_value <- apply(DF, 1, function(x) sample(8:12,1))
DF$subgroup_value <- apply(DF, 1, function(x) sample(1:5,1))

DF <- DF %>%
  arrange(date,group,subgroup)

Теперь я хочу вычислить следующее:

для каждого заданного дня t, группы и подгруппы рассчитывают количество дней, пока (обратное) значение subgroup_value не станет равным или больше, чем групповое значение дня t.

Я знаю, как это сделать, используя некоторые для циклов и некоторые функции dplyr, но это просто ужасно медленно:

for(i in seq(1,nrow(date),1)) {
  for(j in seq(1,nrow(group),1)) {
    for(k in seq(1,nrow(subgroup),1)) {
      tmp <- DF %>%
        filter(date<=date[i] & group == group[j] & subgroup == subgroup[k]) %>%
        arrange(desc(date))

      tmp$helper <- 1

      tmp <- tmp %>%
        mutate(
          cs_helper = cumsum(helper),
          cs_subgroup_value = cumsum(subgroup_value),
          nr_days = case_when (
            cs_subgroup_value >= group_value ~ cs_helper,
            TRUE ~ NA_real_)
        )

      #this is the final result for date[i], group[j], subgroup[k]
      value <- min(tmp[,"nr_days"], na.rm=T)
    }
  }
}

Пример

head(DF,10)
         date group subgroup group_value subgroup_value result
1  2018-01-01     A        C          12              2     NA
2  2018-01-02     A        C          11              4     NA
3  2018-01-03     A        C          11              4     NA
4  2018-01-04     A        C           9              5      2
5  2018-01-05     A        C          12              5      3
6  2018-01-06     A        C          10              3      3
7  2018-01-07     A        C          12              5      3
8  2018-01-08     A        C           8              1      3
9  2018-01-09     A        C          12              4      4
10 2018-01-10     A        C           9              1      4

Так что для строки 10 мне нужно сложить последние 4 значения подгруппы, чтобы они были больше или равны 9.

Я уверен, что этот код можно оптимизировать с помощью некоторой векторизованной версии, но я изо всех сил пытаюсь найти для этого хорошую отправную точку (как вы можете видеть из приведенного выше кода, я новичок в R)

Мой вопрос: как бы вы подошли к этой проблеме, чтобы векторизовать ее для оптимизации скорости?

Спасибо! Stephan

Answer 1

Вот попытка: взять копию каждого фрейма данных группы / подгруппы и перекрестное соединение с данными. Затем он фильтруется, чтобы найти только дни раньше. Это позволяет нам на каждый день рассчитывать все накопленные суммы

DF %>%
  group_by(group, subgroup) %>%
  mutate(day = row_number(), J = TRUE) %>%
  nest() %>%
  arrange(group, subgroup) %>%
  mutate(data = map(data, function(d) {
    inner_join(d, transmute(d, x = day, v = subgroup_value, J), by = "J") %>%
      filter(day >= x) %>%
      mutate(x = day - x + 1) %>%
      arrange(day, x) %>%
      group_by(date, group_value, date, subgroup_value) %>%
      mutate(vv = cumsum(v),
             vv = ifelse(vv >= group_value, vv, NA),
             xx = ifelse(!is.na(vv), x, NA)) %>%
      group_by(date, group_value, day, subgroup_value) %>%
      summarise(x = min(xx, na.rm = TRUE), v = min(vv, na.rm = TRUE))
  })) %>%
  unnest()