如何在每个组内创建滞后变量？

Question

我有一个 data.table：

require(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

我想在"groups"的每个级别内计算"value"列的滞后版本。

结果应该如下所示：

#   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

我尝试直接使用lag：

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

...这显然行不通。

我还尝试了：

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 

这几乎是我想要的。然而，生成的向量与data.table中的排序方式不同，这是有问题的。

在基础R、plyr、dplyr和data.table中，最有效的方法是什么？

- xiaodai

---

抱歉，请与 group_by 结合使用。 - Alex

unlist(by(data, data$groups, function(x) c(NA, head(x$value, -1)))) 是一种基本的方法。 - rawr

@xiaodai 如果你只需要对一个列进行lag操作，而且数据集不是很大，那么在base R、plyr和data.table方法之间的效率差别不会太大。 - akrun

@akrun 理解。但是我实际上简化了它。我需要它适用于许多列，并且更倾向于通用解决方案，以造福其他用户。 - xiaodai

@xiaodai，我更新了多列。关于为什么lag很慢，这必须取决于lag中的代码。您可以检查getAnywhere('lag.default')[1]。 - akrun

Answer 1

你可以在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

对于多列：

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

更新

从 data.table 版本 >= v1.9.5 开始，我们可以使用 shift 并将 type 参数设置为 lag 或 lead。默认情况下，参数 type 为 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

如果你需要反向，使用type=lead。

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

使用原始数据集

  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

数据

 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))

- akrun

---

我想知道为什么data[, lag.value:=lag(value)), by=groups]这个方法得到相同的结果却比你的解决方案慢？ - xiaodai

我该如何做到相反的效果呢？换句话说，不是向后滞后一个（取前一行），而是向前提前一个（取下一行的值）？感谢您出色的参与！ - verybadatthis

是否也可以延迟超过一个值？（即，获取 data[, lag.value.1:=c(NA, lag.value[-.N]), by=groups] 而不计算 lag.value？） - greyBag

根据您的回复，我认为我正在寻找的解决方案是 data[, shift(value, 2), by=groups]（但我还无法使开发版本正常工作）。但是，为了澄清，我的问题是如何将单个列的滞后值延迟2个值而不是1个值。我需要输出的前3行是：data.table(time = c(1,2,3), groups = c(a,a,a), value = c(0.02779005, 0.88029938, -1.69514201), lag.value = c(NA, NA, 0.02779005))。 - greyBag

数据不同，因为我正在对数据类型为POSIXct的时间戳列执行操作。我猜在这种情况下应该采用不同的方法。我会尝试将其作为单独的问题发布。谢谢你的跟进和关注 :) - thentangler

Answer 2

使用 dplyr 包：

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

给予

> 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

如 @BrianD 所指出的，这个假设暗示着 value 已经按照 group 排序。如果没有排序，要么按照 group 排序，要么在 lag 函数中使用 order_by 参数。还要注意，由于 dplyr 的一些版本存在问题，为了安全起见，应该显式给出参数和命名空间。

- Alex

---

你如何在循环遍历所有需要创建延迟的变量时使用while语句？ - derp92

你的意思是你希望对多列进行滞后操作吗？可以查看mutate_each、mutate_all、mutate_at等命令。 - Alex

这个解决方案是否假定源数据集已经适当地预先排序了？ - Brian D

@Alex 我在想，如果time变量没有提前排序（这可能是其他用户数据集中的情况），那么这段代码中就没有明确的排序。最好还是明确指定排序顺序，例如：lag(value, 1, order_by=time)。 - Brian D

@BrianD 我认为没有任何混淆，因为在我的理解中，“lag”意味着获取先前的值并将它们向后移动n个位置，但是需要注意的是，您可以向lag传递一个排序参数，谢谢。 - Alex

Answer 3

我想通过提及两种方法来补充之前的答案，以解决重要情况下的这个问题，即当不能保证每个组在每个时间段都有数据时。也就是说，您仍然拥有一个定期间隔的时间序列，但可能会有遗漏。我将重点介绍两种改进dplyr解决方案的方法。

我们从您使用的相同数据开始...

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

...但是现在我们删除了几行

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

简单的dplyr解决方案不再起作用

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

尽管我们没有 (group = 'a'，time ='3') 的值，但上面仍显示了在 (group = 'a'，time ='4') 情况下滞后的值，这实际上是在 time = 2 的值。

dplyr 的正确解决方案

思路是添加缺失的（group，time）组合。 当您有大量可能的（group，time）组合，但捕获的值稀疏时，这非常占用内存效率。非常 不占用内存效率。

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

请注意，现在我们在(group = 'a', time = '4')处有一个NA，这应该是预期的行为。与(group = 'b', time = '3')相同。

使用类zoo::zooreg的繁琐但正确的解决方案

当案例数量非常大时，这种解决方案在内存方面应该更好，因为它不是用NA填充缺失的案例，而是使用索引。

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

最后，让我们检查两个正确解是否相等：

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

- mbiron

---

dplyr 发生了什么事吗？在我的情况下，使用这两种解决方案都不会导致任何延迟。它只是将原始值复制到不同的列中。 - Bob

截至目前，dplyr版本仍然对我有效，除了一个小修改，我需要指示seq“by”参数，可以通过?seq.Date进行探索。我注意到这个操作非常常见。 - RegressForward

目前这个例子对我来说仍然有效。如果您使用的是日期数据而不是整数（如此示例），则需要使用@RegressForward所使用的修复方法。构建日期序列时没有默认增量。 - mbiron

Answer 4

在基础R中，这将完成任务：

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

第一行代码添加了一个滞后（+1）观测值的字符串。第二行代码修正了每组的第一个条目，因为滞后的观测值来自前一组。

请注意，data 的格式为 data.frame ，以不使用 data.table。

- A.Koe

Answer 5

如果您希望确保避免数据排序方面的任何问题，可以使用dplyr手动执行以下操作：

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)

或者，我喜欢把它放在一个函数中，其中包括选择的分组变量、排名列（如日期或其他）和选择的滞后数量。这也需要懒惰求值以及 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)

- hoofay