Jak utworzyć zmienną lag w każdej grupie?

Użycie 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 domyślnie, że wartość jest już sortowana według grupy. Jeśli nie, posortuj go według grupy lub użyj argumentu order_by w lag. Zauważ również, że z powodu istniejącego problemu z niektórymi wersjami dplyr, dla bezpieczeństwa, argumenty i przestrzeń nazw powinny być jawnie podane.

W bazie R, to wykona zadanie:

data$lag.value <- c(NA, data$value[-nrow(data)])
data$lag.value[which(!duplicated(data$groups))] <- NA

Pierwsza linia dodaje ciąg obserwacji opóźnionych (+1). Drugi ciąg koryguje pierwszy wpis z każdej grupy, ponieważ obserwacja opóźniona pochodzi z poprzedniej grupy.

Zauważ, że data jest formatu data.frame, aby nie używać data.table.

Jeśli chcesz się upewnić, że unikniesz problemów z zamawianiem danych, możesz to zrobić, używając dplyr, ręcznie z czymś takim:

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ą(s), kolumną rankingową (jak Data lub inaczej) i wybraną liczbą LGD. Wymaga to również lazyeval, jak również 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)

Chciałem uzupełnić poprzednie odpowiedzi, wymieniając dwa sposoby podejścia do tego problemu w ważnym przypadku , gdy nie masz gwarancji, że każda grupa ma dane dla każdego okresu. Oznacza to, że nadal masz regularnie rozmieszczone szeregi czasowe, ale mogą być braki tu i tam. Skupię się na dwóch sposobach ulepszenia rozwiązania dplyr.

Zaczynamy od tych samych danych, których użyłeś...

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 usuwamy kilka wiersze

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 dplyr rozwiązanie 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

Widzisz, że chociaż nie mamy wartości dla przypadku (group = 'a', time = '3'), powyższe nadal pokazuje wartość dla opóźnienia w przypadku (group = 'a', time = '4'), która w rzeczywistości jest wartością w time = 2.

Poprawne dplyr rozwiązanie

Chodzi o to, że dodajemy brakujące kombinacje (Grupa, czas). Jest to bardzo pamięć-nieefektywna, gdy masz wiele możliwych kombinacji (grup, czasu) , ale wartości są rzadkie schwytany.

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 at (group = 'a', time = '4'), które powinno być oczekiwanym zachowaniem. To samo z (group = 'b', time = '3').

Żmudne, ale i poprawne rozwiązanie przy użyciu klasy zoo::zooreg

To rozwiązanie powinno działać lepiej pod względem pamięci, gdy ilość przypadków jest bardzo duża, ponieważ zamiast wypełniać brakujące przypadki NA, używa indeksów.

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