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 />
#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比您的解决方案要慢吗?
–小袋
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
评论
抱歉,与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]