¿Cómo crear una variable de retraso dentro de cada grupo?

data.table plyr

Question

Tengo un data.table:

set.seed(1)
data <- data.table(time = c(1:3, 1:4),
groups = c(rep(c("b", "a"), c(3, 4))),
value = rnorm(7))
data
# groups time value
# 1: b 1 -0.6264538
# 2: b 2 0.1836433
# 3: b 3 -0.8356286
# 4: a 1 1.5952808
# 5: a 2 0.3295078
# 6: a 3 -0.8204684
# 7: a 4 0.4874291

Quiero calcular una versión retrasada de la columna "valor", dentro de cada nivel de "grupos".

El resultado debería verse como

# groups time value lag.value
# 1 a 1 1.5952808 NA
# 2 a 2 0.3295078 1.5952808
# 3 a 3 -0.8204684 0.3295078
# 4 a 4 0.4874291 -0.8204684
# 5 b 1 -0.6264538 NA
# 6 b 2 0.1836433 -0.6264538
# 7 b 3 -0.8356286 0.1836433

He intentado usar el lag directamente:

data$lag.value <- lag(data$value) 

... que claramente no funcionaría.

También he intentado:

unlist(tapply(data$value, data$groups, lag))
a1 a2 a3 a4 b1 b2 b3
NA -0.1162932 0.4420753 2.1505440 NA 0.5894583 -0.2890288 

Que es casi lo que quiero. Sin embargo, el vector generado se ordena de manera diferente al ordenamiento en la tabla de datos, lo cual es problemático.

¿Cuál es la forma más eficiente de hacer esto en base R, plyr, dplyr y data.table?

Answer 1

En la base R, esto hará el trabajo:

data$lag.value <- c(NA, data$value[-nrow(data)])
data$lag.value[which(!duplicated(data$groups))] <- NA

La primera línea agrega una cadena de observaciones rezagadas (+1). La segunda cadena corrige la primera entrada de cada grupo, ya que la observación retrasada es del grupo anterior.

Tenga en cuenta que los data tienen el formato data.frame para no usar data.table .

Answer 2

Puede hacer esto dentro de data.table

 library(data.table)
data[, lag.value:=c(NA, value[-.N]), by=groups]
data
# time groups value lag.value
#1: 1 a 0.02779005 NA
#2: 2 a 0.88029938 0.02779005
#3: 3 a -1.69514201 0.88029938
#4: 1 b -1.27560288 NA
#5: 2 b -0.65976434 -1.27560288
#6: 3 b -1.37804943 -0.65976434
#7: 4 b 0.12041778 -1.37804943

Para múltiples columnas:

nm1 <- grep("^value", colnames(data), value=TRUE)
nm2 <- paste("lag", nm1, sep=".")
data[, (nm2):=lapply(.SD, function(x) c(NA, x[-.N])), by=groups, .SDcols=nm1]
data
# time groups value value1 value2 lag.value lag.value1
#1: 1 b -0.6264538 0.7383247 1.12493092 NA NA
#2: 2 b 0.1836433 0.5757814 -0.04493361 -0.6264538 0.7383247
#3: 3 b -0.8356286 -0.3053884 -0.01619026 0.1836433 0.5757814
#4: 1 a 1.5952808 1.5117812 0.94383621 NA NA
#5: 2 a 0.3295078 0.3898432 0.82122120 1.5952808 1.5117812
#6: 3 a -0.8204684 -0.6212406 0.59390132 0.3295078 0.3898432
#7: 4 a 0.4874291 -2.2146999 0.91897737 -0.8204684 -0.6212406
# lag.value2
#1: NA
#2: 1.12493092
#3: -0.04493361
#4: NA
#5: 0.94383621
#6: 0.82122120
#7: 0.59390132

Actualizar

Desde data.table versiones de data.table > = v1.9.5 , podemos usar shift con type como lag o lead . Por defecto, el tipo es de lag .

data[, (nm2) := shift(.SD), by=groups, .SDcols=nm1]
# time groups value value1 value2 lag.value lag.value1
#1: 1 b -0.6264538 0.7383247 1.12493092 NA NA
#2: 2 b 0.1836433 0.5757814 -0.04493361 -0.6264538 0.7383247
#3: 3 b -0.8356286 -0.3053884 -0.01619026 0.1836433 0.5757814
#4: 1 a 1.5952808 1.5117812 0.94383621 NA NA
#5: 2 a 0.3295078 0.3898432 0.82122120 1.5952808 1.5117812
#6: 3 a -0.8204684 -0.6212406 0.59390132 0.3295078 0.3898432
#7: 4 a 0.4874291 -2.2146999 0.91897737 -0.8204684 -0.6212406
# lag.value2
#1: NA
#2: 1.12493092
#3: -0.04493361
#4: NA
#5: 0.94383621
#6: 0.82122120
#7: 0.59390132

Si necesita lo contrario, use type=lead

nm3 <- paste("lead", nm1, sep=".")

Usando el conjunto de datos original

 data[, (nm3) := shift(.SD, type=''lead''), by = groups, .SDcols=nm1]
# time groups value value1 value2 lead.value lead.value1
#1: 1 b -0.6264538 0.7383247 1.12493092 0.1836433 0.5757814
#2: 2 b 0.1836433 0.5757814 -0.04493361 -0.8356286 -0.3053884
#3: 3 b -0.8356286 -0.3053884 -0.01619026 NA NA
#4: 1 a 1.5952808 1.5117812 0.94383621 0.3295078 0.3898432
#5: 2 a 0.3295078 0.3898432 0.82122120 -0.8204684 -0.6212406
#6: 3 a -0.8204684 -0.6212406 0.59390132 0.4874291 -2.2146999
#7: 4 a 0.4874291 -2.2146999 0.91897737 NA NA
# lead.value2
#1: -0.04493361
#2: -0.01619026
#3: NA
#4: 0.82122120
#5: 0.59390132
#6: 0.91897737
#7: NA

datos

 set.seed(1)
data <- data.table(time =c(1:3,1:4),groups = c(rep(c("b","a"),c(3,4))),
value = rnorm(7), value1=rnorm(7), value2=rnorm(7))

Answer 3

Quería complementar las respuestas anteriores mencionando dos formas en que abordo este problema en el caso importante cuando no se garantiza que cada grupo tenga datos para cada período de tiempo . Es decir, todavía tiene una serie temporal regularmente espaciada, pero puede haber faltas aquí y allá. Me centraré en dos formas de mejorar la solución dplyr .

Comenzamos con los mismos datos que utilizó ...

library(dplyr)
library(tidyr)
set.seed(1)
data_df = data.frame(time = c(1:3, 1:4),
groups = c(rep(c("b", "a"), c(3, 4))),
value = rnorm(7))
data_df
#> time groups value
#> 1 1 b -0.6264538
#> 2 2 b 0.1836433
#> 3 3 b -0.8356286
#> 4 1 a 1.5952808
#> 5 2 a 0.3295078
#> 6 3 a -0.8204684
#> 7 4 a 0.4874291

... pero ahora eliminamos un par de filas

data_df = data_df[-c(2, 6), ]
data_df
#> time groups value
#> 1 1 b -0.6264538
#> 3 3 b -0.8356286
#> 4 1 a 1.5952808
#> 5 2 a 0.3295078
#> 7 4 a 0.4874291

La solución dplyr simple ya no funciona

data_df %>%
arrange(groups, time) %>%
group_by(groups) %>%
mutate(lag.value = lag(value)) %>%
ungroup()
#> # A tibble: 5 x 4
#> time groups value lag.value
#> <int> <fct> <dbl> <dbl>
#> 1 1 a 1.60 NA
#> 2 2 a 0.330 1.60
#> 3 4 a 0.487 0.330
#> 4 1 b -0.626 NA
#> 5 3 b -0.836 -0.626

Verá que, aunque no tenemos el valor para el caso (group = ''a'', time = ''3'') , lo anterior aún muestra un valor para el retraso en el caso de (group = ''a'', time = ''4'') , que en realidad es el valor en el time = 2 .

Solución dplyr correcta

La idea es que agreguemos las combinaciones que faltan (grupo, tiempo). Esto es MUY ineficiente en la memoria cuando tiene muchas combinaciones posibles (grupos, tiempo), pero los valores se capturan escasamente.

dplyr_correct_df = expand.grid(
groups = sort(unique(data_df$groups)),
time = seq(from = min(data_df$time), to = max(data_df$time))
) %>%
left_join(data_df, by = c("groups", "time")) %>%
arrange(groups, time) %>%
group_by(groups) %>%
mutate(lag.value = lag(value)) %>%
ungroup()
dplyr_correct_df
#> # A tibble: 8 x 4
#> groups time value lag.value
#> <fct> <int> <dbl> <dbl>
#> 1 a 1 1.60 NA
#> 2 a 2 0.330 1.60
#> 3 a 3 NA 0.330
#> 4 a 4 0.487 NA
#> 5 b 1 -0.626 NA
#> 6 b 2 NA -0.626
#> 7 b 3 -0.836 NA
#> 8 b 4 NA -0.836

Observe que ahora tenemos un NA en (group = ''a'', time = ''4'') , que debería ser el comportamiento esperado. Lo mismo con (group = ''b'', time = ''3'') .

Solución zoo::zooreg pero también correcta usando la clase zoo::zooreg

Esta solución debería funcionar mejor en términos de memoria cuando la cantidad de casos es muy grande, porque en lugar de llenar los casos faltantes con NA, utiliza índices.

library(zoo)
zooreg_correct_df = data_df %>%
as_tibble() %>%
# nest the data for each group
# should work for multiple groups variables
nest(-groups, .key = "zoo_ob") %>%
mutate(zoo_ob = lapply(zoo_ob, function(d) {
# create zooreg objects from the individual data.frames created by nest
z = zoo::zooreg(
data = select(d,-time),
order.by = d$time,
frequency = 1
) %>%
# calculate lags
# we also ask for the 0''th order lag so that we keep the original value
zoo:::lag.zooreg(k = (-1):0) # note the sign convention is different
# recover df''s from zooreg objects
cbind(
time = as.integer(zoo::index(z)),
zoo:::as.data.frame.zoo(z)
)
})) %>%
unnest() %>%
# format values
select(groups, time, value = value.lag0, lag.value = `value.lag-1`) %>%
arrange(groups, time) %>%
# eliminate additional periods created by lag
filter(time <= max(data_df$time))
zooreg_correct_df
#> # A tibble: 8 x 4
#> groups time value lag.value
#> <fct> <int> <dbl> <dbl>
#> 1 a 1 1.60 NA
#> 2 a 2 0.330 1.60
#> 3 a 3 NA 0.330
#> 4 a 4 0.487 NA
#> 5 b 1 -0.626 NA
#> 6 b 2 NA -0.626
#> 7 b 3 -0.836 NA
#> 8 b 4 NA -0.836

Finalmente, verifiquemos que ambas soluciones correctas sean realmente iguales:

all.equal(dplyr_correct_df, zooreg_correct_df)
#> [1] TRUE

Answer 4

Si desea asegurarse de que evitó cualquier problema al ordenar los datos, puede hacerlo, usando dplyr, manualmente con algo como:

df <- data.frame(Names = c(rep(''Dan'',50),rep(''Dave'',100)),
Dates = c(seq(1,100,by=2),seq(1,100,by=1)),
Values = rnorm(150,0,1))
df <- df %>% group_by(Names) %>% mutate(Rank=rank(Dates),
RankDown=Rank-1)
df <- df %>% left_join(select(df,Rank,ValueDown=Values,Names),by=c(''RankDown''=''Rank'',''Names'')
) %>% select(-Rank,-RankDown)
head(df)

O, alternativamente, me gusta la idea de ponerlo en una función con una (s) variable (s) de agrupación elegida (s), columna de clasificación (como Fecha o no) y el número elegido de retrasos. Esto también requiere lazyeval y dplyr.

groupLag <- function(mydf,grouping,ranking,lag){
df <- mydf
groupL <- lapply(grouping,as.symbol)
names <- c(''Rank'',''RankDown'')
foos <- list(interp(~rank(var),var=as.name(ranking)),~Rank-lag)
df <- df %>% group_by_(.dots=groupL) %>% mutate_(.dots=setNames(foos,names))
selectedNames <- c(''Rank'',''Values'',grouping)
df2 <- df %>% select_(.dots=selectedNames)
colnames(df2) <- c(''Rank'',''ValueDown'',grouping)
df <- df %>% left_join(df2,by=c(''RankDown''=''Rank'',grouping)) %>% select(-Rank,-RankDown)
return(df)
}
groupLag(df,c(''Names''),c(''Dates''),1)

Answer 5

Usando el paquete dplyr :

library(dplyr)
data <-
data %>%
group_by(groups) %>%
mutate(lag.value = dplyr::lag(value, n = 1, default = NA))

da

> data
Source: local data table [7 x 4]
Groups: groups
time groups value lag.value
1 1 a 0.07614866 NA
2 2 a -0.02784712 0.07614866
3 3 a 1.88612245 -0.02784712
4 1 b 0.26526825 NA
5 2 b 1.23820506 0.26526825
6 3 b 0.09276648 1.23820506
7 4 b -0.09253594 0.09276648

Como señaló @BrianD, esto supone implícitamente que el valor ya está ordenado por grupo. Si no, order_by por grupo o use el argumento order_by en el lag . También tenga en cuenta que debido a un problema existente con algunas versiones de dplyr, por razones de seguridad, los argumentos y el espacio de nombres se deben dar explícitamente.