Soru Her grupta bir gecikme değişkeni nasıl oluşturulur?


Bir data.table'ım var:

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

"Değer" sütununun gecikmeli bir sürümünü hesaplamak istiyorum içinde her "grup" seviyesi.

Sonuç gibi görünmeli

#   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

Kullanmaya çalıştım lag direkt olarak:

data$lag.value <- lag(data$value) 

... açıkça işe yaramayacaktı.

Ben de denedim:

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 

Neredeyse istediğim bu. Ancak üretilen vektör, problemli olan data.table'daki siparişten farklı şekilde sipariş edilir.

Bunu temel R, plyr, dplyr ve data.table içinde yapmanın en etkili yolu nedir?


44
2017-10-10 04:33


Menşei


üzgünüm, birleştirmek group_by - Alex
unlist(by(data, data$groups, function(x) c(NA, head(x$value, -1)))) temel bir yol olurdu - rawr
@xiaodai Yapacak tek bir sütun varsa lag ve veri kümesi o kadar büyük değil, verimlilik arasında çok fazla fark olmayacaktır. base R, plyr, data.table yöntemleri. - akrun
@akrun Anlayın. Ancak aslında bunu basitleştirdim. Aslında pek çok sütun için ihtiyacım var ve diğer kullanımların faydası için genel çözümler tercih ediliyor. - xiaodai
@ xiaodai Birden çok sütun için güncelledim. Neden ile ilgili lag yavaştır, lag. Kontrol edebilirsin getAnywhere('lag.default')[1] - akrun


Cevaplar:


Bunu içinde yapabilirsin 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

Birden çok sütun için:

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

Güncelleştirme

itibaren data.table sürümler> = v1.9.5, kullanabiliriz shift ile type gibi lag veya lead. Varsayılan olarak, 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

Tersine ihtiyacınız varsa type=lead

nm3 <- paste("lead", nm1, sep=".")

Orijinal veri kümesini kullanma

  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

veri

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

67
2017-10-10 04:40



Aynı sonucu veren veri [, lag.value: = gecikme (değer)], = = gruplarının çözümünüzden neden daha yavaş olduğunu merak ediyorum? - xiaodai
Bunu nasıl yapardım ama tersine? Diğer bir deyişle, bir önceki satırda (bir önceki sırayı alarak) gecikme yapmak yerine, bir öncekiyle (aşağıdaki satır değerini alarak) önde olacak mıdır? Harika giriş için teşekkürler! - verybadatthis
@verybadatthis Güncellemenin yardımcı olup olmadığını kontrol edin - akrun
Birden fazla değerle gecikmek de mümkün mü? (örn. data[, lag.value.1:=c(NA, lag.value[-.N]), by=groups] hesaplamaksızın lag.value?) - greyBag
Bence bu sadece göstermek için güncellenebilir / güncellenmelidir shift yolu, ya da en azından en üste koymak için, şimdi develi değil. Bu soru ve cevapları bir dupe hedefi olarak kullanıyoruz. - Frank


Paketi kullanma dplyr:

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

verir

> 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 tarafından belirtildiği gibi, bu, değerin zaten grup tarafından sıralanmış olduğunu varsayar. Değilse, ya gruba göre sıralayın ya da order_by argüman lag. Ayrıca bir mevcut sorun Dplyr'ın bazı sürümleri ile güvenlik, argümanlar ve ad alanı için açıkça belirtilmelidir.


46
2017-10-10 04:38



Bunu bir gecikme yaratmak için gereken tüm değişkenler üzerinde döngü yaparken nasıl kullanırsınız? - derp92
gecikme işlemini yapmak istediğiniz birden fazla sütununuz var mı demek istiyorsun? Çıkış yapmak mutate_each, mutate_all, mutate_at vb komutları - Alex
Bu çözüm, kaynak veri kümesinin uygun şekilde önceden sıralandığını varsayar mı? - Brian D
@BrianD evet öyle, ama bu OP'nin istediği yorumu örtük value grup tarafından gecikti. - Alex
@BrianD Ben herhangi bir karışıklık olduğunu düşünmüyorum lag aklımda önceki değerleri almak ve bunları n pozisyonları, ancak gecikme için bir sipariş argümanını geçebileceğinizi not etmek yararlıdır. - Alex


Baz R'de, bu iş yapacak:

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

İlk satır, gecikmeli (+1) gözlemler dizisi ekler. İkinci dizi, gecikmeli gözlem önceki gruptan olduğu için her grubun ilk girişini düzeltir.

Bunu not et data formatı data.frame kullanmamak data.table.


4
2018-04-14 13:32





Verileri sipariş etmekle ilgili herhangi bir sorundan kaçındığınızdan emin olmak isterseniz, bunu aşağıdaki gibi kullanarak el ile dplyr kullanarak yapabilirsiniz:

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)

Ya da alternatif olarak, seçilen bir gruplama değişken (ler) i, bir sıralama sütununa (Tarih veya başka bir şekilde) ve seçilen gecikme sayısına sahip bir işleve yerleştirme fikrini beğeniyorum. Bu aynı zamanda dplyr yanı sıra tembel gerektirir.

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)

2
2018-01-24 10:25





Bu soruna, önemli davada yaklaştığım iki yolu anlatarak, önceki cevapları tamamlamayı istedim. Her bir grubun her zaman periyodu için verilerinin olması garanti edilmediğinde. Yani, hala düzenli aralıklı bir zaman diziniz var, ancak burada ve burada eksikler olabilir. Geliştirmek için iki yol üzerinde odaklanacağım dplyr çözüm.

Kullandığınız verilerle başlıyoruz ...

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

... ama şimdi birkaç satır siliyoruz

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

Basit dplyr çözüm artık çalışmıyor

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

Bunu görüyorsunuz, ancak dava için değerimiz yok. (group = 'a', time = '3')Yukarıdaki, hala durumunda gecikme için bir değer gösterir (group = 'a', time = '4'), aslında değer time = 2.

Doğru dplyr çözüm

Fikir, eksik (grup, zaman) kombinasyonlarını eklediğimizdir. Bu ÇOK Mümkün olan çok sayıda (grup, zaman) kombinasyonunuz olduğunda bellek yetersizliği, ancak değerler nadiren yakalanır.

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

Şu anda bir NA'ya sahip olduğumuza dikkat edin (group = 'a', time = '4')beklenen davranış olmalıdır. İle aynı (group = 'b', time = '3').

Sınıfı kullanarak zor ama aynı zamanda doğru çözüm zoo::zooreg

Bu çözüm, dava miktarı çok büyük olduğunda bellek açısından daha iyi çalışmalıdır, çünkü eksik olan vakaları NA'larla doldurmak yerine, indeks kullanır.

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

Son olarak, her iki doğru çözümün aslında eşit olduğunu kontrol etmeliyiz:

all.equal(dplyr_correct_df, zooreg_correct_df)
#> [1] TRUE

1
2018-06-27 15:54