Cara cepat di R untuk mendapatkan baris pertama dari bingkai data yang dikelompokkan oleh pengidentifikasi [ditutup]


14

Terkadang saya hanya perlu mendapatkan baris pertama dari kumpulan data yang dikelompokkan berdasarkan pengidentifikasi, seperti saat mengambil usia dan jenis kelamin saat ada beberapa pengamatan per individu. Apa cara cepat (atau tercepat) untuk melakukan ini di R? Saya menggunakan agregat () di bawah dan curiga ada cara yang lebih baik. Sebelum memposting pertanyaan ini saya mencari sedikit di google, menemukan dan mencoba ddply, dan terkejut bahwa itu sangat lambat dan memberi saya kesalahan memori pada dataset saya (400.000 baris x 16 cols, 7.000 ID unik), sedangkan versi agregat () cukup cepat.

(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,])

UPDATE: Lihat jawaban Chase dan komentar Matt Parker untuk apa yang saya anggap sebagai pendekatan yang paling elegan. Lihat jawaban @Matthew Dowle untuk solusi tercepat yang menggunakan data.tablepaket.


Terima kasih atas semua jawaban Anda. Solusi data.table dari @Steve adalah yang tercepat dengan faktor ~ 5 pada kumpulan data saya di atas solusi agregat () dari @Gavin (yang pada gilirannya lebih cepat daripada kode agregat () saya), dan faktor ~ 7,5 atas solusi by () dari @Matt. Saya tidak mengatur waktu gagasan pembentukan ulang karena saya tidak bisa membuatnya bekerja dengan cepat. Saya menduga solusi yang diberikan @Chase akan menjadi yang tercepat dan sebenarnya itulah yang saya cari, tetapi ketika saya mulai menulis komentar ini, kodenya tidak berfungsi (saya lihat sudah diperbaiki sekarang!).
Terkunci

Sebenarnya @Chase lebih cepat dengan faktor ~ 9 atas data.tabel, jadi saya mengubah jawaban yang saya terima. Terima kasih sekali lagi semuanya - pelajari banyak alat baru.
Terkunci

maaf, saya memperbaiki kode saya. Satu peringatan atau trik di sini adalah menyatukan nilai yang bukan salah satu ID Anda diff()sehingga Anda dapat mengambil ID pertama dx.
Mengejar

Jawaban:


10

Apakah kolom ID Anda benar-benar faktor? Jika ini sebenarnya numerik, saya pikir Anda dapat menggunakan difffungsi ini untuk keuntungan Anda. Anda juga bisa memaksa ke numerik 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, ]

1
Pintar! Anda juga dapat melakukannya dx[c(TRUE, dx$ID[-1] != dx$ID[-length(dx$ID)], ]untuk data non-numerik - Saya mendapatkan 0,03 untuk karakter, 0,05 untuk faktor. PS: ada tambahan )di system.time()fungsi pertama Anda , setelah nol kedua.
Matt Parker

@ Mat - panggilan yang bagus dan tangkapan yang bagus. Tampaknya saya tidak dapat menyalin / menempelkan kode yang layak untuk flip hari ini.
Chase

Saya bekerja pada skema London Cycle Hire, dan perlu menemukan cara untuk menemukan contoh pertama dan terakhir dari pengguna sepeda. Dengan 1 juta pengguna, 10 juta perjalanan per tahun dan data beberapa tahun, loop "untuk" saya menghasilkan 1 pengguna per detik. Saya mencoba solusi "by", dan gagal menyelesaikannya setelah satu jam. Pada awalnya saya tidak bisa memahami apa yang dilakukan "alternatif Matt Parker untuk solusi Chase", tetapi akhirnya uang itu turun, dan uang itu dieksekusi dalam hitungan detik. Jadi poin tentang peningkatan menjadi lebih besar dengan kumpulan data yang lebih besar terbukti dari pengalaman saya.
George Simpson

@ GeorgeSimpson - senang melihat ini masih dirujuk! The data.tablesolusi di bawah harus membuktikan menjadi yang tercepat, jadi saya akan memeriksa bahwa jika aku jadi kau (mungkin harus menjadi jawaban diterima di sini).
Chase

17

Menindaklanjuti jawaban Steve, ada cara yang jauh lebih cepat dalam data.tabel:

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

Jika Anda hanya membutuhkan baris pertama dari setiap grup, itu jauh lebih cepat untuk bergabung ke baris itu secara langsung. Mengapa membuat objek .SD setiap kali, hanya menggunakan baris pertama saja?

Bandingkan 0,064 data. Tabel untuk "Alternatif Matt Parker untuk solusi Chase" (yang tampaknya menjadi yang tercepat sejauh ini):

> 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 

Jadi ~ 5 kali lebih cepat, tapi meja kecil di bawah 1 juta baris. Ketika ukuran bertambah, begitu pula perbedaannya.


Wow, saya tidak pernah benar-benar menghargai betapa "pintar" [.data.tablefungsi itu bisa ... Saya kira saya tidak menyadari Anda tidak membuat .SDobjek jika Anda tidak benar-benar membutuhkannya. Yang bagus!
Steve Lianoglou

Ya, itu memang cepat! Bahkan jika Anda memasukkan dxt <- data.table(dx, key='ID')dalam panggilan ke system.time (), itu lebih cepat daripada solusi @ Matt.
terkunci

Saya kira ini sudah ketinggalan zaman sekarang karena dengan data yang lebih baru. Versi tabel SD[1L]sepenuhnya dioptimalkan dan sebenarnya @SteveLianoglou jawaban akan dua kali lebih cepat untuk baris 5e7.
David Arenburg

@DavidArenburg Mulai dari v1.9.8 Nov 2016, ya. Jangan ragu untuk mengedit jawaban ini secara langsung, atau mungkin Q ini perlu komunitas wiki atau semacamnya.
Matt Dowle

10

Anda tidak perlu beberapa merge()langkah, cukup aggregate()kedua variabel yang diminati:

> 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

Pengaturan waktu perbandingan:

1) solusi Matt:

> 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) solusi pembentukan kembali Zach:

> 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) solusi data.table Steve:

> 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) Chase solusi cepat menggunakan numerik, bukan faktor, 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

dan 5) alternatif Matt Parker untuk solusi Chase, untuk karakter atau faktor ID, yang sedikit lebih cepat daripada yang numerik Chase 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

Oh, benar terima kasih! Lupa sintaks untuk agregat itu.
Terkunci

Jika Anda ingin menambahkan solusi Chase, inilah yang saya dapat: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
lockoff

@lockedoff - selesai, terima kasih, tapi saya tidak mengambil sampel secara acak IDsehingga hasilnya sebanding dengan solusi lain.
Pasang kembali Monica - G. Simpson

Dan waktu versi @Matt Parker di komentar untuk jawaban @ Chase
Reinstate Monica - G. Simpson

2
Terima kasih telah melakukan pengaturan waktunya, Gavin - itu sangat membantu untuk pertanyaan seperti ini.
Matt Parker

9

Anda dapat mencoba menggunakan paket data.table .

Untuk kasus khusus Anda, kelebihannya adalah (gila) cepat. Pertama kali saya diperkenalkan dengannya, saya mengerjakan objek data.frame dengan ratusan ribu baris. "Normal" aggregateatau ddplymetode diambil ~ 1-2 menit untuk menyelesaikan (ini sebelum Hadley memperkenalkan idata.framemojo ke dalam ddply). Menggunakan data.table, operasi secara harfiah dilakukan dalam hitungan detik.

Kelemahannya adalah hal itu sangat cepat karena akan menggunakan data Anda. Tabel (seperti halnya data.frame) dengan "kolom kunci" dan menggunakan strategi pencarian cerdas untuk menemukan himpunan bagian dari data Anda. Ini akan menghasilkan penataan ulang data Anda sebelum Anda mengumpulkan statistik.

Mengingat bahwa Anda hanya ingin baris pertama dari setiap grup - mungkin pemesanan ulang akan mengacaukan baris yang pertama, itulah sebabnya mungkin tidak sesuai untuk situasi Anda.

Bagaimanapun, Anda harus menilai apakah data.tablepantas atau tidak di sini, tetapi ini adalah bagaimana Anda akan menggunakannya dengan data yang Anda sajikan:

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

Pembaruan: Matthew Dowle (pengembang utama paket data.table) telah menyediakan cara yang lebih baik / lebih pintar / (sangat) lebih efisien untuk menggunakan data.tabel untuk memecahkan masalah ini sebagai salah satu jawaban di sini ... pasti periksa .


4

Coba bentuk ulang2

library(reshape2)
dx <- melt(dx,id=c('ID','FEM'))
dcast(dx,ID+FEM~variable,fun.aggregate=mean)

3

Kamu bisa mencoba

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)

Saya tidak tahu apakah ini akan menjadi lebih cepat daripada plyr.

Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.