按id变量计算滚动总和，包括缺失的时间点

Question

我想学习R语言，但有一些在SAS中做了十多年的事情，我还无法找到在R中最佳实践。例如这个数据集：

 id  class           t  count  desired
 --  -----  ----------  -----  -------
  1      A  2010-01-15      1        1
  1      A  2010-02-15      2        3
  1      B  2010-04-15      3        3
  1      B  2010-09-15      4        4
  2      A  2010-01-15      5        5
  2      B  2010-06-15      6        6
  2      B  2010-08-15      7       13
  2      B  2010-09-15      8       21

我希望能够按照id和class进行滚动求和，并在4个月的滚动窗口内进行。请注意，并非每个id和class组合都有所有月份。

在SAS中，我通常会采用以下两种方式之一： 1.使用RETAIN和by id & class。 2.使用PROC SQL，将df作为df1左连接到df2上，连接条件为id、class和适当窗口内的df1.d-df2.d。

针对这种类型的问题，最好的R方法是什么？

t <- as.Date(c("2010-01-15","2010-02-15","2010-04-15","2010-09-15",
               "2010-01-15","2010-06-15","2010-08-15","2010-09-15"))
class <- c("A","A","B","B","A","B","B","B")
id <- c(1,1,1,1,2,2,2,2)
count <- seq(1,8,length.out=8)
desired <- c(1,3,3,4,5,6,13,21)
df <- data.frame(id,class,t,count,desired)

- ADJ

---

d是什么？你的设置代码中没有包含它的定义。 - Matthew Plourde

@Aaron，我一时也不确定。通常情况下，当我有稀疏日期时，我会同时使用zoo和data.table来实现“分割-应用-合并”策略。 - Justin

我已经在使用sqldf包。有一件事，我还没有完全弄清楚如何在sqldf查询中使用R函数，就像我可以在PROC SQL中使用许多SAS函数之一一样。在这种情况下，我的首选解决方案将涉及使用R版本的SAS'INTCK函数以更复杂的方式执行日期算术运算，而不是在我的原始示例中所述的方式。但由于我从零开始学习R，我更愿意学习如何按照R的方式做事（请参见Joe的评论）。 - ADJ

嗨@ADJ，我很高兴我的解决方案对你有用，但我真的很想看看是否有更好的想法。我将更改标题并添加赏金;如果您对我的新标题有异议，请随时将其更改回来。 - Aaron left Stack Overflow

老实说，对于这种东西，我还是会继续使用SAS。 :) - Hong Ooi

Answer 1

以下是几种解决方案：

1) 使用 zoo。对于每个组，使用 ave 创建一个月度系列 m，将原始系列 z 与网格 g 合并。然后计算滚动总和并仅保留原始时间点：

library(zoo)
f <- function(i) { 
    z <- with(df[i, ], zoo(count, t))
    g <- zoo(, seq(start(z), end(z), by = "month"))
    m <- merge(z, g)
    window(rollapplyr(m, 4, sum, na.rm = TRUE, partial = TRUE), time(z))
}
df$desired <- ave(1:nrow(df), df$id, df$class, FUN = f)

这将会得到：

> df
  id class          t count desired
1  1     A 2010-01-15     1       1
2  1     A 2010-02-15     2       3
3  1     B 2010-04-15     3       3
4  1     B 2010-09-15     4       4
5  2     A 2010-01-15     5       5
6  2     B 2010-06-15     6       6
7  2     B 2010-08-15     7      13
8  2     B 2010-09-15     8      21

注意：我们假设每个组内的时间已经排序（如问题描述）如果不是这样，请先对df进行排序。

2) sqldf

library(sqldf)
sqldf("select id, class, a.t, a.'count', sum(b.'count') desired 
   from df a join df b 
   using(id, class) 
   where a.t - b.t between 0 and 100
   group by id, class, a.t")

这将会得到：

  id class          t count desired
1  1     A 2010-01-15     1       1
2  1     A 2010-02-15     2       3
3  1     B 2010-04-15     3       3
4  1     B 2010-09-15     4       4
5  2     A 2010-01-15     5       5
6  2     B 2010-06-15     6       6
7  2     B 2010-08-15     7      13
8  2     B 2010-09-15     8      21

< p > 注意： 如果合并的内容太大而无法放入内存中，则使用 sqldf（“ ...”，dbname = tempfile（）），使中间结果存储在其动态创建的数据库中，并在之后自动销毁。

3）基本R语言 sqldf方案激发了这个基本的R语言方案，它将SQL翻译成了R：

m <- merge(df, df, by = 1:2)
s <- subset(m, t.x - t.y >= 0 & t.x - t.y <= 100)
ag <- aggregate(count.y ~ t.x + class + id, s, sum)
names(ag) <- c("t", "class", "id", "count", "desired")

结果如下：

> ag
           t class id count desired
1 2010-01-15     A  1     1       1
2 2010-02-15     A  1     2       3
3 2010-04-15     B  1     3       3
4 2010-09-15     B  1     4       4
5 2010-01-15     A  2     5       5
6 2010-06-15     B  2     6       6
7 2010-08-15     B  2     7      13
8 2010-09-15     B  2     8      21

注意: 这会在内存中进行合并，如果数据集非常大可能会出现问题。

更新: 对第一种解决方案进行了小幅简化，并添加了第二种解决方案。

更新2: 添加了第三种解决方案。

- G. Grothendieck

---

不错！很好地使用了 ave，我可能没有像你这样经常使用它，还有一些我之前不知道的使用 zoo 的方法。谢谢！ - Aaron left Stack Overflow

感谢你在 zoo 包上的工作 —— 我们非常感激！ - Aaron left Stack Overflow

悬赏已经颁发给了一个非常值得的答案。谢谢！ - Aaron left Stack Overflow

Answer 2

我几乎感到有些尴尬发布这个问题。我通常对这些很擅长，但肯定有更好的方法。

首先使用zoo的as.yearmon将日期转换为仅包含月份和年份的形式，然后重新整理以获取每个id/class组合的一列，然后在缺失的月份之前、之后和之间填充零，再使用zoo获取滚动和，然后仅提取所需的月份并与原始数据帧合并。

library(reshape2)
library(zoo)
df$yearmon <- as.yearmon(df$t)
dfa <- dcast(id + class ~ yearmon, data=df, value.var="count")
ida <- dfa[,1:2]
dfa <- t(as.matrix(dfa[,-c(1:2)]))
months <- with(df, seq(min(yearmon)-3/12, max(yearmon)+3/12, by=1/12))
dfb <- array(dim=c(length(months), ncol(dfa)), 
             dimnames=list(paste(months), colnames(dfa)))
dfb[rownames(dfa),] <- dfa
dfb[is.na(dfb)] <- 0
dfb <- rollsumr(dfb,4, fill=0)
rownames(dfb) <- paste(months)
dfb <- dfb[rownames(dfa),]
dfc <- cbind(ida, t(dfb))
dfc <- melt(dfc, id.vars=c("class", "id"))
names(dfc)[3:4] <- c("yearmon", "desired2")
dfc$yearmon <- as.yearmon(dfc$yearmon)
out <- merge(df,dfc)

> out
  id class  yearmon          t count desired desired2
1  1     A Feb 2010 2010-02-15     2       3        3
2  1     A Jan 2010 2010-01-15     1       1        1
3  1     B Apr 2010 2010-04-15     3       3        3
4  1     B Sep 2010 2010-09-15     4       4        4
5  2     A Jan 2010 2010-01-15     5       5        5
6  2     B Aug 2010 2010-08-15     7      13       13
7  2     B Jun 2010 2010-06-15     6       6        6
8  2     B Sep 2010 2010-09-15     8      21       21

- Aaron left Stack Overflow

Answer 3

使用data.table库可以相对高效地解决这个问题。

##Utilize the data.table package
library("data.table")
data <- data.table(t,class,id,count,desired)[order(id,class)]

##Assign each customer an ID
data[,Cust_No:=.GRP,by=c("id","class")]

##Create "list" of comparison dates and values
Ref <- data[,list(Compare_Value=list(I(count)),Compare_Date=list(I(t))), by=c("id","class")]

##Compare two lists and see of the compare date is within N days
data$Roll.Val <- mapply(FUN = function(RD, NUM) {
  d <- as.numeric(Ref$Compare_Date[[NUM]] - RD)
  sum((d <= 0 & d >= -124)*Ref$Compare_Value[[NUM]])
}, RD = data$t,NUM=data$Cust_No)

##Print out data
data <- data[,list(id,class,t,count,desired,Roll.Val)][order(id,class)]
data

id class          t count desired Roll.Val
1:  1     A 2010-01-15     1       1        1
2:  1     A 2010-02-15     2       3        3
3:  1     B 2010-04-15     3       3        3
4:  1     B 2010-09-15     4       4        4
5:  2     A 2010-01-15     5       5        5
6:  2     B 2010-06-15     6       6        6
7:  2     B 2010-08-15     7      13       13
8:  2     B 2010-09-15     8      21       21

- Mike.Gahan

---

这是一个持续124天的滚动时间段。显然这不完全等于4个月，但代码可以轻松修改。 - Mike.Gahan

Answer 4

使用runner包，可以在滚动窗口上计算所有内容。以下是使用sum_run的示例：

library(runner)
df %>%
  group_by(id) %>%
  mutate(
    output = sum_run(count, k = 30*4, idx = t)   
  )

# <dbl> <fct> <date>     <dbl>   <dbl>  <dbl>
#     1 A     2010-01-15     1       1      1
#     1 A     2010-02-15     2       3      3
#     1 B     2010-04-15     3       3      6
#     1 B     2010-09-15     4       4      4
#     2 A     2010-01-15     5       5      5
#     2 B     2010-06-15     6       6      6
#     2 B     2010-08-15     7      13     13
#     2 B     2010-09-15     8      21     21

- GoGonzo