如何在每个组中创建滞后变量？答案

【问题标题】：How to create a lag variable within each group?如何在每个组中创建滞后变量？
【发布时间】：2021-02-18 07:06:41
【问题描述】：

我有一个 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 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 中的顺序不同，这是有问题的。

在 base R、plyr、dplyr 和 data.table 中执行此操作的最有效方法是什么？

【问题讨论】：

对不起，结合group_by
unlist(by(data, data$groups, function(x) c(NA, head(x$value, -1)))) 将是一种基本方式
@xiaodai 如果你只做一列lag，而且数据集不大，那么base R，plyr，data.table在效率上不会有太大差异方法。
@akrun 明白。但是我实际上简化了它。我实际上在许多专栏中都需要它，并且为了其他用户的利益，首选通用解决方案
@xiaodai 我更新了多列。关于lag为什么慢，得看lag里面的代码。您可以查看getAnywhere('lag.default')[1]

标签： r data.table plyr dplyr

【解决方案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。默认情况下，类型为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))

【讨论】：

我想知道为什么给出相同结果的 data[, lag.value:=lag(value)), by=groups] 比您的解决方案慢？
我该怎么做，但是反过来呢？换句话说，不是滞后一个（取上一行），而是提前一个（取下一行的值）？感谢您的精彩参赛！
是否也可以滞后多个值？（即得到data[, lag.value.1:=c(NA, lag.value[-.N]), by=groups]而不计算lag.value？）
@greyBag 我不明白你想要什么。在帖子中，它显示了shift(.SD)，它通过指定.SDcols 中的列来计算多列的滞后。您是否打算为单个列获得两个滞后。在那种情况下data[, shift(value, 1:2), by=groups]
在我看来，这可以/应该更新为仅显示 shift 方式，或者至少将其放在顶部，因为它已经过时了。我们将此问答用作欺骗目标。

【解决方案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 所指出的，这隐含地假设值已经按组排序。如果不是，请按组对其进行排序，或使用lag 中的order_by 参数。另请注意，由于 existing issue 带有某些版本的 dplyr，为了安全起见，应明确给出参数和命名空间。

【讨论】：

在循环遍历所有需要创建滞后的变量时如何使用它？
您的意思是您有多个列要进行滞后操作吗？查看mutate_each、mutate_all、mutate_at 等命令
此解决方案是否假定源数据集已正确预排序？
@BrianD 是的，但这是隐含在 OP 的评论中，即他们希望 value 落后于组。
@BrianD 我不认为有任何混淆，因为我认为lag 意味着采用以前的值并将它们移动n 位置，但注意您可以传递排序很有用滞后的论据，谢谢。

【解决方案3】：

在基础 R 中，这将完成这项工作：

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

第一行添加了一串滞后 (+1) 观察值。第二个字符串更正每个组的第一个条目，因为滞后观察来自前一组。

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

【讨论】：

【解决方案4】：

我想通过提到我在重要情况下解决此问题的两种方法来补充前面的答案当您不能保证每个组都有每个时间段的数据。也就是说，您仍然有一个定期间隔的时间序列，但可能会在这里和那里丢失。我将重点介绍两种改进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`解决方案

我们的想法是添加缺失的（组、时间）组合。当您有很多可能的（组、时间）组合时，这非常内存效率低下，但是这些值被稀疏地捕获。

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

【讨论】：

【解决方案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)

或者，我喜欢将其放入具有选定分组变量、排名列（如日期或其他）和选定滞后数的函数中的想法。这也需要lazyeval 和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)

【讨论】：

更新

数据

简单的dplyr 解决方案不再有效

正确的dplyr解决方案

使用 zoo::zooreg 类的乏味但正确的解决方案

简单的`dplyr` 解决方案不再有效

正确的`dplyr`解决方案

使用 `zoo::zooreg` 类的乏味但正确的解决方案