각 그룹 내에서 지연 변수를 만드는 방법은 무엇입니까?
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에서이를 수행하는 가장 효율적인 방법은 무엇입니까?
당신은 내에서 이것을 할 수 있습니다 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))
패키지 사용 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 버전의 기존 문제 로 인해 안전을 위해 인수 및 네임 스페이스를 명시 적으로 제공해야합니다.
기본 R에서는 다음 작업을 수행합니다.
data$lag.value <- c(NA, data$value[-nrow(data)])
data$lag.value[which(!duplicated(data$groups))] <- NA
첫 번째 줄은 지연된 (+1) 관측 값 문자열을 추가합니다. 두 번째 문자열은 지연된 관측 값이 이전 그룹의 것이기 때문에 각 그룹의 첫 번째 항목을 수정합니다.
주 data형식이다 data.frame사용하지 않도록 data.table.
데이터 주문 문제를 피하려면 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뿐만 아니라 lazyeval도 필요합니다.
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솔루션 을 개선하는 두 가지 방법에 초점을 맞출 것 입니다.
우리는 당신이 사용한 것과 동일한 데이터로 시작합니다.
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
You see that, although we don't have the value for the case (group = 'a', time = '3'), the above still shows a value for the lag in the case of (group = 'a', time = '4'), which is actually the value at time = 2.
Correct dplyr solution
The idea is that we add the missing (group, time) combinations. This is VERY memory-inefficient when you have lots of possible (groups, time) combinations, but the values are sparsely captured.
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
Notice that we now have a NA at (group = 'a', time = '4'), which should be the expected behaviour. Same with (group = 'b', time = '3').
Tedious but also correct solution using the class zoo::zooreg
This solution should work better in terms of memory when the amount of cases is very large, because instead of filling the missing cases with NA's, it uses indices.
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
Finally, lets check that both correct solutions are actually equal:
all.equal(dplyr_correct_df, zooreg_correct_df)
#> [1] TRUE
참고URL : https://stackoverflow.com/questions/26291988/how-to-create-a-lag-variable-within-each-group
'program tip' 카테고리의 다른 글
| JPA 엔티티에 equals () 및 hashCode () 메소드를 작성해야합니까? (0) | 2020.12.14 |
|---|---|
| f.select 양식 필드에 공백 값을 설정하는 방법 (0) | 2020.12.14 |
| ADB를 통해 연결된 기기의 Android OS 버전 가져 오기 (0) | 2020.12.14 |
| dotnet run 또는 dotnet watch with development environment from command line? (0) | 2020.12.14 |
| PHP에서 현재 함수의 이름 검색 (0) | 2020.12.14 |