¿Cómo crear una variable de retraso dentro de cada grupo?
data.table plyr (5)
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?
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
.
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))
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
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)
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.