我有一个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中执行此操作的最有效方法是什么? br />

评论

抱歉,与group_by
组合
unlist(by(data(data,data $ groups,function(x)c(NA,head(x $ value,-1)))))是一种基本方式

@xiaodai如果您只有一列要做滞后并且数据集不是那么大,则基R,plyr,data.table方法之间的效率不会有太大差异。

@akrun了解。但是我实际上简化了它。实际上,我在许多专栏文章中都需要使用它,而一般解决方案则是首选,以利于其他useRs

@xiaodai我更新了多列。关于滞后为什么缓慢,它必须取决于滞后的代码。您可以检查getAnywhere('lag.default')[1]

#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开始,我们可以将shifttype用作laglead。默认情况下,类型为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比您的解决方案要慢吗?

–小袋
2014年10月10日下午4:51

我将如何做,但相反呢?换句话说,不是滞后一个(取上一行),而是领先一个(取下一行值)?谢谢您的好评!

–verybadatthis
15年5月9日在21:19

是否还可以滞后多个值? (即获取数据[,lag.value.1:= c(NA,lag.value [-。N]),by = groups]而不计算lag.value?)

– GreyBag
15年7月30日在8:47

@greyBag我不明白你想要什么。在帖子中,它显示了shift(.SD),它通过在.SDcols中指定列来计算多个列的滞后。我的意思是单列会出现两个滞后。在这种情况下,data [,shift(value,1:2),by = groups]

–akrun
15年7月30日在9:14

在我看来,既然已经偏离了发展方向,则可以/应该对其进行更新以仅显示转换方式,或者至少将其置于顶部。我们将此问答作为欺骗对象。

–坦白
16年8月30日在20:33

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

评论


在遍历创建滞后所需的所有变量时如何使用它?

– derp92
17 Mar 23 '17 at 22:26

您是说您想对滞后操作进行多列处理吗?签出mutate_each,mutate_all,mutate_at等命令

– Alex
17 Mar 23 '17 at 22:34

此解决方案是否假定源数据集已适当地预先排序?

– Brian D
17年7月7日在17:24

@BrianD是的,但是在OP的注释中隐含了他们希望按组滞后值。

– Alex
17年7月10日在4:30

@BrianD我不认为会有任何混淆,因为我的想法是:滞后意味着采用先前的值并将它们移位n个位置,但是请注意,您可以将排序参数传递给滞后,谢谢。

– Alex
17年7月10日在23:37

#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手动执行以下操作:

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或其他)和选定滞后次数的函数中的想法。这也需要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)


#5 楼

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


请注意,我们现在有了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