Вычислить текущую сумму по переменным id, с отсутствующими временными точками

Ответ 1

Я почти смущен, чтобы опубликовать это. Я обычно довольно хорош, как это, но должен быть лучший способ.

Вначале используется 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

Ответ 2

Вот несколько решений:

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

Примечание. Если слияние должно быть слишком большим для размещения в памяти, используйте 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

Примечание. Это делает слияние в памяти, что может быть проблемой, если набор данных очень велик.

UPDATE: незначительные упрощения первого решения, а также добавлено второе решение.

ОБНОВЛЕНИЕ 2: добавлено третье решение.

Ответ 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