Szybkie sposoby w R, aby uzyskać pierwszy wiersz ramki danych pogrupowany według identyfikatora [zamknięty]

14

Czasami muszę uzyskać tylko pierwszy wiersz zestawu danych pogrupowany według identyfikatora, tak jak przy pobieraniu wieku i płci, gdy na osobę przypada wiele obserwacji. Jaki jest szybki (lub najszybszy) sposób, aby to zrobić w R? Użyłem agregacji () poniżej i podejrzewam, że są lepsze sposoby. Przed opublikowaniem tego pytania przeszukałem trochę w google, znalazłem i wypróbowałem ddply i zdziwiłem się, że jest on bardzo wolny i dał mi błędy pamięci w moim zestawie danych (400 000 wierszy x 16 kols, 7 000 unikalnych identyfikatorów), podczas gdy wersja agregująca () był dość szybki.

(dx <- data.frame(ID = factor(c(1,1,2,2,3,3)), AGE = c(30,30,40,40,35,35), FEM = factor(c(1,1,0,0,1,1))))
# ID AGE FEM
#  1  30   1
#  1  30   1
#  2  40   0
#  2  40   0
#  3  35   1
#  3  35   1
ag <- data.frame(ID=levels(dx$ID))
ag <- merge(ag, aggregate(AGE ~ ID, data=dx, function(x) x[1]), "ID")
ag <- merge(ag, aggregate(FEM ~ ID, data=dx, function(x) x[1]), "ID")
ag
# ID AGE FEM
#  1  30   1
#  2  40   0
#  3  35   1
#same result:
library(plyr)
ddply(.data = dx, .var = c("ID"), .fun = function(x) x[1,])

AKTUALIZACJA: Zobacz odpowiedź Chase'a i komentarz Matta Parkera, co uważam za najbardziej eleganckie podejście. Zobacz odpowiedź @Matthew Dowle na najszybsze rozwiązanie korzystające z data.tablepakietu.

zablokowane
źródło
Dziękuję za wszystkie odpowiedzi. Rozwiązanie @Steve dla data.table było najszybsze o ~ 5 razy w moim zbiorze danych w porównaniu z rozwiązaniem @Gavin (które z kolei było szybsze niż mój kod agregujący ()) oraz o współczynnik ~ 7,5 nad rozwiązaniem by () rozwiązania @Matt. Nie zmieniłem czasu na pomysł przekształcenia, ponieważ nie mogłem go szybko uruchomić. Domyślam się, że rozwiązanie, które dał @Chase, będzie najszybsze i tak naprawdę szukałem tego, ale kiedy zacząłem pisać ten komentarz, kod nie działał (teraz widzę, że został naprawiony!).
zablokowane
W rzeczywistości @Chase był szybszy o ~ 9 razy w porównaniu do data.table, więc zmieniłem swoją akceptowaną odpowiedź. Jeszcze raz dziękuję wszystkim - nauczyłem się wielu nowych narzędzi.
zablokowane
przepraszam, naprawiłem swój kod. Jedynym zastrzeżeniem lub sztuczką jest tutaj konkatenacja wartości, która nie jest jednym z twoich identyfikatorów diff(), abyś mógł odebrać pierwszy identyfikator w dx.
Chase

Odpowiedzi:

11

Czy twoja kolumna identyfikacyjna jest naprawdę czynnikiem? Jeśli w rzeczywistości jest liczbowy, myślę, że możesz użyć tej difffunkcji na swoją korzyść. Możesz również zmusić go do numerowania as.numeric().

dx <- data.frame(
    ID = sort(sample(1:7000, 400000, TRUE))
    , AGE = sample(18:65, 400000, TRUE)
    , FEM = sample(0:1, 400000, TRUE)
)

dx[ diff(c(0,dx$ID)) != 0, ]
Gonić
źródło
1
Sprytny! Możesz także zrobić dx[c(TRUE, dx$ID[-1] != dx$ID[-length(dx$ID)], ]dla danych nienumerycznych - dostaję 0,03 za znak, 0,05 za czynniki. PS: )w twojej pierwszej system.time()funkcji jest dodatkowa , po drugim zero.
Matt Parker,
@Matt - dobry telefon i niezły chwyt. Wydaje mi się, że nie mogę dziś skopiować / wkleić kodu wartego przerzucenia.
Chase
Pracuję nad londyńskim programem wypożyczania rowerów i potrzebowałem znaleźć sposób na znalezienie pierwszej i ostatniej instancji użytkowników wypożyczalni rowerów. Z 1 milionem użytkowników, 10 milionami podróży rocznie i kilkuletnimi danymi, moja pętla „for” wykonywała 1 użytkownika na sekundę. Wypróbowałem rozwiązanie „przez”, ale nie udało się go ukończyć po godzinie. Na początku nie mogłem pojąć, co robi „alternatywa Matta Parkera dla rozwiązania Chase'a”, ale w końcu grosz spadł i wykonuje się w kilka sekund. Z mojego doświadczenia wynika zatem, że poprawa staje się większa w przypadku większych zbiorów danych.
George Simpson
@GeorgeSimpson - cieszę się, że wciąż jest o tym mowa! Poniższe data.tablerozwiązanie powinno okazać się najszybsze, więc sprawdziłbym to, gdybym był tobą (prawdopodobnie powinna to być tutaj akceptowana odpowiedź).
Chase
17

Po odpowiedzi Steve'a istnieje dużo szybszy sposób w data.table:

> # Preamble
> dx <- data.frame(
+     ID = sort(sample(1:7000, 400000, TRUE))
+     , AGE = sample(18:65, 400000, TRUE)
+     , FEM = sample(0:1, 400000, TRUE)
+ )
> dxt <- data.table(dx, key='ID')

> # fast self join
> system.time(ans2<-dxt[J(unique(ID)),mult="first"])
 user  system elapsed 
0.048   0.016   0.064

> # slower using .SD
> system.time(ans1<-dxt[, .SD[1], by=ID])
  user  system elapsed 
14.209   0.012  14.281 

> mapply(identical,ans1,ans2)  # ans1 is keyed but ans2 isn't, otherwise identical
  ID  AGE  FEM 
TRUE TRUE TRUE 

Jeśli potrzebujesz tylko pierwszego wiersza każdej grupy, o wiele szybciej jest dołączyć bezpośrednio do tego wiersza. Po co tworzyć obiekt .SD za każdym razem, aby użyć tylko pierwszego jego wiersza?

Porównaj 0.064 data.table z „Matt Parker alternatywą dla rozwiązania Chase'a” (który do tej pory wydawał się najszybszy):

> system.time(ans3<-dxt[c(TRUE, dxt$ID[-1] != dxt$ID[-length(dxt$ID)]), ])
 user  system elapsed 
0.284   0.028   0.310 
> identical(ans1,ans3)
[1] TRUE 

Tak więc ~ 5 razy szybciej, ale to mały stolik w mniej niż 1 milion wierszy. Wraz ze wzrostem wielkości rośnie różnica.

Matt Dowle
źródło
Wow, nigdy tak naprawdę nie doceniałem, jak „inteligentna” [.data.tablemoże być ta funkcja… Chyba nie zdawałem sobie sprawy, że nie stworzyłeś .SDobiektu, jeśli tak naprawdę go nie potrzebujesz. Niezłe!
Steve Lianoglou
Tak, to jest naprawdę szybkie! Nawet jeśli dxt <- data.table(dx, key='ID')dodasz do wywołania system.time (), jest to szybsze niż rozwiązanie @ Matta.
zablokowane
Wydaje mi się, że jest to obecnie nieaktualne, ponieważ w przypadku nowszych wersji data.table SD[1L]został w pełni zoptymalizowany, a odpowiedź na @SteveLianoglou byłaby dwa razy szybsza dla wierszy 5e7.
David Arenburg
@DavidArenburg Od wersji 1.9.8 listopada 2016 tak. Edytuj tę odpowiedź bezpośrednio, a może to Q musi być wiki społeczności lub coś takiego.
Matt Dowle
10

Nie potrzebujesz wielu merge()kroków, tylko aggregate()obie interesujące zmienne:

> aggregate(dx[, -1], by = list(ID = dx$ID), head, 1)
  ID AGE FEM
1  1  30   1
2  2  40   0
3  3  35   1

> system.time(replicate(1000, aggregate(dx[, -1], by = list(ID = dx$ID), 
+                                       head, 1)))
   user  system elapsed 
  2.531   0.007   2.547 
> system.time(replicate(1000, {ag <- data.frame(ID=levels(dx$ID))
+ ag <- merge(ag, aggregate(AGE ~ ID, data=dx, function(x) x[1]), "ID")
+ ag <- merge(ag, aggregate(FEM ~ ID, data=dx, function(x) x[1]), "ID")
+ }))
   user  system elapsed 
  9.264   0.009   9.301

Porównanie czasów:

1) Rozwiązanie Matta:

> system.time(replicate(1000, {
+ agg <- by(dx, dx$ID, FUN = function(x) x[1, ])
+ # Which returns a list that you can then convert into a data.frame thusly:
+ do.call(rbind, agg)
+ }))
   user  system elapsed 
  3.759   0.007   3.785

2) Rozwiązanie reshape2 Zacha:

> system.time(replicate(1000, {
+ dx <- melt(dx,id=c('ID','FEM'))
+ dcast(dx,ID+FEM~variable,fun.aggregate=mean)
+ }))
   user  system elapsed 
 12.804   0.032  13.019

3) Rozwiązanie tabeli danych Steve'a:

> system.time(replicate(1000, {
+ dxt <- data.table(dx, key='ID')
+ dxt[, .SD[1,], by=ID]
+ }))
   user  system elapsed 
  5.484   0.020   5.608 
> dxt <- data.table(dx, key='ID') ## one time step
> system.time(replicate(1000, {
+ dxt[, .SD[1,], by=ID] ## try this one line on own
+ }))
   user  system elapsed 
  3.743   0.006   3.784

4) Szybkie rozwiązanie Chase'a za pomocą liczb, a nie faktorów ID:

> dx2 <- within(dx, ID <- as.numeric(ID))
> system.time(replicate(1000, {
+ dy <- dx[order(dx$ID),]
+ dy[ diff(c(0,dy$ID)) != 0, ]
+ }))
   user  system elapsed 
  0.663   0.000   0.663

oraz 5) Matt Parker jako alternatywa dla rozwiązania Chase'a, jeśli chodzi o charakter lub czynnik ID, który jest nieco szybszy niż numeryczny Chase'a ID:

> system.time(replicate(1000, {
+ dx[c(TRUE, dx$ID[-1] != dx$ID[-length(dx$ID)]), ]
+ }))
   user  system elapsed 
  0.513   0.000   0.516
Przywróć Monikę - G. Simpson
źródło
Och, racja, dzięki! Zapomniałem o tej składni dla agregacji.
zablokowane
Jeśli chcesz dodać rozwiązanie Chase'a, oto co mam:dx$ID <- sample(as.numeric(dx$ID)) #assuming IDs arent presorted system.time(replicate(1000, { dy <- dx[order(dx$ID),] dy[ diff(c(0,dy$ID)) != 0, ] })) user system elapsed 0.58 0.00 0.58
zablokowany
@lockedoff - gotowe, dziękuję, ale nie losowo próbowałem IDs, więc wynik był porównywalny z innymi rozwiązaniami.
Przywróć Monikę - G. Simpson
I czas wersji @Matt Parker w komentarzach do odpowiedzi @ Chase
Przywróć Monikę - G. Simpson
2
Dzięki za ustalenie czasu, Gavin - to jest naprawdę pomocne w przypadku takich pytań.
Matt Parker,
10

Możesz spróbować użyć data.table pakietu .

W tym konkretnym przypadku zaletą jest to, że jest (niesamowicie) szybki. Kiedy po raz pierwszy się z tym zapoznałem, pracowałem nad obiektami data.frame z setkami tysięcy wierszy. „Normal” aggregatelub ddplymetody zostały podjęte ~ 1-2 minut, aby kompletne (to było przed Hadley wprowadził idata.framemojo do ddply). Przy użyciu data.tableoperacja została wykonana dosłownie w ciągu kilku sekund.

Minusem jest to, że jest tak szybki, ponieważ ucieka się do twoich danych.tabela (jest to jak ramka danych) według „kluczowych kolumn” i używa inteligentnej strategii wyszukiwania, aby znaleźć podzbiory twoich danych. Spowoduje to zmianę kolejności danych przed zebraniem statystyk nad nimi.

Biorąc pod uwagę, że będziesz chciał tylko pierwszego rzędu każdej grupy - być może zmiana kolejności zepsuje, który wiersz jest pierwszy, dlatego może nie być odpowiedni w twojej sytuacji.

W każdym razie będziesz musiał ocenić, czy data.tablejest to właściwe, ale możesz to wykorzystać w połączeniu z prezentowanymi danymi:

install.packages('data.table') ## if yo udon't have it already
library(data.table)
dxt <- data.table(dx, key='ID')
dxt[, .SD[1,], by=ID]
     ID AGE FEM
[1,]  1  30   1
[2,]  2  40   0
[3,]  3  35   1

Aktualizacja: Matthew Dowle (główny twórca pakietu data.table) zapewnił lepszy / mądrzejszy / (wyjątkowo) bardziej wydajny sposób korzystania z data.table do rozwiązania tego problemu jako jednej z odpowiedzi tutaj ... zdecydowanie sprawdź to .

Steve Lianoglou
źródło
4

Spróbuj reshape2

library(reshape2)
dx <- melt(dx,id=c('ID','FEM'))
dcast(dx,ID+FEM~variable,fun.aggregate=mean)
Zach
źródło
3

Możesz spróbować

agg <- by(dx, dx$ID, FUN = function(x) x[1, ])
# Which returns a list that you can then convert into a data.frame thusly:
do.call(rbind, agg)

Nie mam jednak pojęcia, czy będzie to szybsze niż plyr.

Matt Parker
źródło