r data.table plyr dplyr

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:

5 odpowiedzi

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

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

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

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

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

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

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ę

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

5 odpowiedzi

Powiązane pytanie

Stan problemu

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

Linki dotyczące treści

5 odpowiedzi

Powiązane pytanie

Stan problemu