Calcule suma acumulada por variables de id, con puntos de tiempo faltantes

sas plyr

Question

Intento aprender R y hay algunas cosas que he hecho por más de 10 años en SAS que no puedo descifrar cuál es la mejor manera de hacerlo en R. Toma esta información:

 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

Quiero calcular la columna deseada como una suma móvil por id, clase y dentro de un período de 4 meses. Tenga en cuenta que no todos los meses están presentes para cada combinación de identificación y clase.

En SAS normalmente haría esto en una de 2 formas:

1. RETAIN más a por id y clase.
2. PROC SQL con una combinación izquierda de df como df1 a df como df2 en id, clase y df1.d-df2.d dentro de la ventana apropiada

¿Cuál es el mejor enfoque de R para este tipo de problema?

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)

Answer 1

Estoy casi avergonzado de publicar esto. Normalmente soy bastante bueno como estos, pero tiene que haber una mejor manera.

Primero utiliza as.yearmon para obtener las fechas en términos de solo mes y año, luego lo reformatea para obtener una columna por cada combinación de id / class , luego completa con ceros antes, después y por meses perdidos, luego usa zoo para obtener la suma móvil, luego saca solo los meses deseados y se fusiona con el marco de datos original.

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

Answer 2

Aquí hay algunas soluciones:

1) zoo Usando ave , para cada grupo crea una serie mensual, m , combinando la serie original, z , con una grilla, g . Luego calcule la suma móvil y conserve solo los puntos temporales originales:

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)

lo que da:

> 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

Nota Suponemos que los tiempos se ordenan dentro de cada grupo (como en la pregunta). Si no es así, ordena primero 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")

lo que da:

 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

Nota: Si la combinación debe ser demasiado grande para caber en la memoria, utilice sqldf("...", dbname = tempfile()) para hacer que los resultados intermedios se almacenen en una base de datos que crea sobre la marcha y se destruye automáticamente después .

3) Base R La solución sqldf motiva esta solución base R que simplemente traduce el SQL en 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")

El resultado es:

> 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

Nota: Esto hace una fusión en la memoria que puede ser un problema si el conjunto de datos es muy grande.

ACTUALIZACIÓN: simplificaciones menores de la primera solución y también una segunda solución añadida.

ACTUALIZACIÓN 2: Se agregó la tercera solución.

Answer 3

Se puede encontrar una respuesta bastante eficiente a este problema utilizando la biblioteca 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