使用 tidyr 和 RccpRoll 按组计算最近 30 天的活动

Question

我想创建一个两个标志

order.last.30.days

order.anytime.in.past

关于以下数据。

library(data.table)
library(lubridate)

my.data <- data.table(

  supplier = c("a","a","a","a","a","a","b","b","b","b","b","b"),
  date = rep(c("2017-06-01","2017-03-01","2017-02-01","2017-01-12",
                "2017-05-01","2017-04-01"), 2), 
  order = c(1,0,0,1,1,0,0,1,0,0,1,0)

)

my.data[,date := ymd(date)]
setorder(my.data, supplier, date)

my.data[, prev.date := shift(date, type = c("lag")),
        by = .(supplier)]

my.data[, days.btw.dates := time_length( interval(prev.date, date), 
                                          unit = "days")]

如何使用 data.table 包中的 shift 来做到这一点？

Answer 1

提出了两个部分的粗略解决方案。

order.anytime.in.past

#Calculate cumsum of order for supplier and set to 1 if greater then zero.
#Then remove the first cumsum as should be NA as no historic data

my.data[, order.any.time.in.past := ifelse(cumsum(order) > 0, 1,0), 
        by = .(supplier)]

my.data[, order.any.time.in.past := replace(order.any.time.in.past,
                                             seq_len(.N)==1,NA) ,
        by=supplier]

order.last.30.days

受此答案的启发 Conditional rolling mean (moving average) on irregular time series

## Solution using dplyr, tidyr, RccpRoll
## add extra row with the min(date) per group less time.window-2 days
## use tidyr::complete and tidyr::full_seq to seq along day per group
## use Rccp::roll_sum() to count up across the time window. The padding 
## of earliest date make sures counts start happening for earlier dates
## (i.e.) don't wait until hit 30 days.
## drop any of the dates that were not actual dates
## make data.table and set first values to NA as no real historic data

time.window = 30

my.data <- my.data %>% 
  group_by(supplier) %>% 
  do(add_row(.,
             supplier = unique(.$supplier), 
             date = (min(.$date) - (time.window-2)), 
             .before=0)) %>%
  tidyr::complete(date = tidyr::full_seq(date,1)) %>%
  mutate(count.orders = RcppRoll::roll_sum(order, 
                                           time.window, align = c("right"), 
                                           fill = NA, na.rm = TRUE)) %>%
  mutate(order.last.30.days = ifelse(count.orders >0, 1,0)) %>%
  select(-count.orders) %>%
  filter(!is.na(order)) %>%
  data.table()

很高兴提出好的 data.table 答案。欢迎提出建议。