Jak utworzyć zmienną opóźnienia w każdej grupie?


Mam dane. Tabela:
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

Chcę obliczyć opóźnioną wersję kolumny „wartość”

wewnątrz

„grupy” na każdym poziomie.
Wynik powinien wyglądać tak
# 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

Próbowałem bezpośrednio użyć
lag
:
data$lag.value <- lag(data$value)
..... co oczywiście nie zadziała.
Ja też tego próbowałem:
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

I to jest prawie to, czego chcę. Jednak wygenerowany wektor jest uporządkowany inaczej niż uporządkowanie w data.table, co jest problematyczne.
Jaki jest najbardziej efektywny sposób zrobienia tego w base R, plyr, dplyr i data.table?
Zaproszony:
Anonimowy użytkownik

Anonimowy użytkownik

Potwierdzenie od:

Możesz to zrobić w
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

W przypadku wielu kolumn:
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


Aktualizacja
>
Z
data.table
version & > =
v1.9.5
możemy użyć
shift
z
type
jako
lag
lub
lead
. Wartość domyślna to
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

Jeśli potrzebujesz czegoś odwrotnego, użyj
type = lead
nm3 <- paste("lead", nm1, sep=".")

Korzystanie z oryginalnego zbioru danych
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


dane
>
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))
Anonimowy użytkownik

Anonimowy użytkownik

Potwierdzenie od:

Korzystanie z pakietu
dplyr
:
library(dplyr)
data <-
data %>%
group_by(groups) %>%
mutate(lag.value = dplyr::lag(value, n = 1, default = NA))

daje
> 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

Jak zauważył @BrianD, zakłada to niejawnie, że wartość jest już posortowana według grupy. Jeśli nie, posortuj je według grupy lub użyj argumentu
order_by
w
lag
. Zwróć również uwagę, że z powodu

istniejący problem
https://coderoad.ru/28235074/
w przypadku niektórych wersji dplyr, ze względów bezpieczeństwa Argumenty i przestrzeń nazw muszą być jawnie określone.
Anonimowy użytkownik

Anonimowy użytkownik

Potwierdzenie od:

W bazie R to wystarczy:
data$lag.value <- c(NA, data$value[-nrow(data)])
data$lag.value[which(!duplicated(data$groups))] <- NA

Pierwsza linia dodaje linię opóźnionych (+1) obserwacji. Drugi wiersz koryguje pierwszy wpis w każdej grupie, ponieważ opóźniona obserwacja należy do poprzedniej grupy.
Zwróć uwagę, że
data
jest sformatowany jako
data.frame
, więc
data.table
nie jest używany.
Anonimowy użytkownik

Anonimowy użytkownik

Potwierdzenie od:

Jeśli chcesz mieć pewność, że unikniesz wszelkich problemów z porządkowaniem danych, możesz to zrobić ręcznie za pomocą narzędzia dplyr za pomocą czegoś takiego:
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)

Lub alternatywnie, podoba mi się pomysł umieszczenia go w funkcji z wybraną zmienną grupującą (AMI), kolumną rankingową (taką jak data lub inaczej) i wybraną liczbą opóźnień. Wymaga to również lazyeval i 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)
Anonimowy użytkownik

Anonimowy użytkownik

Potwierdzenie od:

Chciałbym uzupełnić poprzednie odpowiedzi, wymieniając dwa sposoby, na jakie podchodzę do tego problemu w ważnej sprawie,

gdy nie gwarantujesz, że każda grupa ma dane dla każdego okresu
... Oznacza to, że nadal masz regularnie rozmieszczone serie czasowe, ale może ich brakować tu i tam. Skoncentruję się na dwóch sposobach ulepszenia rozwiązania
dplyr
.
Zaczniemy od tych samych danych co Ty ...
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
... ale teraz usuniemy kilka wierszy
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


Proste rozwiązanie
dplyr
już nie działa
>
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

Możesz zobaczyć, że chociaż nie mamy wartości dla przypadku
(group = 'a', time = '3')
, powyższe nadal pokazuje wartość opóźnienia w
case (group = 'a', time = '4')
, czyli w rzeczywistości wartość w punkcie
time = 2
.

Prawidłowe rozwiązanie
dplyr
>
Chodzi o to, że dodajemy brakujące (grupowe, tymczasowe) kombinacje. to

nieskuteczny

dla BARDZO pamięci, gdy masz wiele możliwych kombinacji (grup, czasów), ale wartości są rzadko przechwytywane.
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

Zauważ, że mamy teraz NA w
(group = 'a', time = '4')
, co powinno być oczekiwanym zachowaniem. To samo z
(group = 'b', time = '3')
.

Żmudne, ale poprawne rozwiązanie przy użyciu klasy
zoo :: zooreg
>
To rozwiązanie powinno działać lepiej z punktu widzenia pamięci, gdy liczba przypadków jest bardzo duża, ponieważ zamiast wypełniać brakujące obserwacje NA, wykorzystuje indeksy.
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

Na koniec sprawdźmy, czy oba poprawne rozwiązania są rzeczywiście równe:
all.equal(dplyr_correct_df, zooreg_correct_df)
#> [1] TRUE

Aby odpowiedzieć na pytania, Zaloguj się lub Zarejestruj się