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

Tengo una 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 rezagada 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) 

… lo 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 forma diferente al orden en la tabla de datos que es problemático.

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

Puedes 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 columnas múltiples:

 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 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 el reverso, 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)) 

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ñala @BrianD, esto supone implícitamente que el valor ya está ordenado por grupo. De lo contrario, order_by por grupo o use el argumento order_by en 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 deben ser explícitamente dados.

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 rezagada es del grupo anterior.

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

Si quería asegurarse de evitar cualquier problema al ordenar los datos, puede hacerlo utilizando 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 variable de agrupación elegida, una columna de clasificación (como Fecha u otra) y el número de retardos elegidos. Esto también requiere lazyeval así como 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) 

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, aún tiene series de tiempo espaciadas regularmente, pero puede haber errores aquí y allá. Me enfocaré en dos formas de mejorar la solución dplyr .

Comenzamos con la misma información que usaste …

 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 borramos 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 #>     #> 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 

Usted ve que, aunque no tenemos el valor para el caso (group = 'a', time = '3') , lo anterior todavía muestra un valor para el retraso en el caso de (group = 'a', time = '4') , que en realidad es el valor en el time = 2 .

Correcta solución dplyr

La idea es que agreguemos las combinaciones faltantes (grupo, tiempo). Esto es MUY ineficaz con 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 #>     #> 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 una 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 el zoo::zooreg 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, usa í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 #>     #> 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, veamos que ambas soluciones correctas son realmente iguales:

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