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

69

我有一个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中的排序方式不同。

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

r  data.table  plyr  dplyr 
— 小带
source
抱歉，与group_by
— Alex一起
2
unlist(by(data, data$groups, function(x) c(NA, head(x$value, -1))))将是一种基本方式
— 原始时间2014年
@xiaodai如果你只有一列做lag与数据集并不大，也不会有之间的效率差异很大base R，plyr，data.table方法。
— akrun 2014年
@akrun了解。但是我实际上简化了它。我实际上在许多专栏文章中都需要使用它，因此一般通用的解决方案对于其他useR来说是更可取的-xiaodai 2014
— 53
@xiaodai我更新了多列。关于为什么lag慢，它必须取决于中的代码lag。您可以检查getAnywhere('lag.default')[1]
— akrun 2014年

Answers:

96

你可以在里面做 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))
— 阿克伦
source
2
想知道为什么给出相同结果的data [，lag.value：= lag（value）），by = groups比您的解决方案要慢？
— xiaodai 2014年
我将如何做，但相反呢？换句话说，不是滞后一个（取上一行），而是领先一个（取下一行值）？谢谢您的好评！
— verybadatthis 2015年
是否还可以滞后多个值？（即得到data[, lag.value.1:=c(NA, lag.value[-.N]), by=groups]不计算lag.value？）
— greyBag 2015年
@greyBag我不明白你想要什么。在帖子中，它显示shift(.SD)了通过在中指定列来计算多于一个列的滞后 .SDcols。我的意思是单列会出现两个滞后。在那种情况下data[, shift(value, 1:2), by=groups]
— akrun
5
在我看来shift，既然已经不合时宜，则可以/应该对其进行更新，以仅显示方式，或者至少将其放在顶部。我们将此问答作为欺骗对象。
— 弗兰克
77

使用包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所指出的那样，这隐式假定值已经按组排序。如果不是，请按组对其进行排序，或者使用中的order_by参数lag。还要注意，由于某些版本的dplyr存在问题，为了安全起见，应明确给出参数和名称空间。

— 亚历克斯
source
1
在遍历创建滞后所需的所有变量时如何使用它？
— derp92
您是说您想对滞后操作进行多列处理吗？退房mutate_each，mutate_all，mutate_at等命令
— 亚历
此解决方案是否假定源数据集已适当地预先排序？
— 布赖恩D
@BrianD是的，但是在OP的注释中隐含了他们希望value按组滞后。
— Alex
1
@BrianD我不认为会有任何混淆，因为lag在我的脑海中意味着取先前的值并按n位置进行移动，但请注意，您可以将排序参数传递给滞后，谢谢。
— Alex
5

在基数R中，这将完成以下工作：

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

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

请注意，该data格式data.frame不可使用data.table。

— 柯
source
3

如果要确保避免在订购数据时遇到任何问题，可以使用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)

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

您会看到，尽管我们没有case的值(group = 'a', time = '3')，但是上面仍然显示了case的滞后值(group = 'a', time = '4')，它实际上是at的值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

注意，我们现在有一个NA (group = 'a', time = '4')，它应该是预期的行为。与相同(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
— 蓝宝
source
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.