Bagaimana memilih baris dengan nilai maksimal di setiap kelompok

94

Dalam dataset dengan beberapa observasi untuk setiap subjek, saya ingin mengambil subset dengan hanya nilai data maksimum untuk setiap record. Misalnya, dengan set data berikut:

ID    <- c(1,1,1,2,2,2,2,3,3)
Value <- c(2,3,5,2,5,8,17,3,5)
Event <- c(1,1,2,1,2,1,2,2,2)

group <- data.frame(Subject=ID, pt=Value, Event=Event)

Subjek 1, 2, dan 3 memiliki nilai pt terbesar masing-masing sebesar 5, 17, dan 5.

Bagaimana saya bisa pertama kali menemukan nilai pt terbesar untuk setiap subjek, dan kemudian, meletakkan pengamatan ini di bingkai data lain? Bingkai data yang dihasilkan seharusnya hanya memiliki nilai pt terbesar untuk setiap subjek.

r  dataframe  r-faq 
— Xinting WANG
sumber
2
Ini sangat erat kaitannya tetapi untuk minimum bukannya maksimum stackoverflow.com/questions/24070714/…
— David Arenburg
— Henrik

Jawaban:

96

Inilah data.tablesolusinya:

require(data.table) ## 1.9.2
group <- as.data.table(group)

Jika Anda ingin menyimpan semua entri yang sesuai dengan nilai maksimal ptdalam setiap grup:

group[group[, .I[pt == max(pt)], by=Subject]$V1]
#    Subject pt Event
# 1:       1  5     2
# 2:       2 17     2
# 3:       3  5     2

Jika Anda hanya menginginkan nilai maks pertama dari pt:

group[group[, .I[which.max(pt)], by=Subject]$V1]
#    Subject pt Event
# 1:       1  5     2
# 2:       2 17     2
# 3:       3  5     2

Dalam hal ini, tidak ada bedanya, karena tidak ada beberapa nilai maksimum dalam grup mana pun di data Anda.

— Arun
sumber
2
mengingat data.table telah mengalami BANYAK perubahan sejak 2014, apakah ini masih merupakan solusi tercepat / terbaik untuk pertanyaan ini?
— Ben
2
@ Ben, dalam hal ini, jawaban tercepat masih ini, ya. .SDoptimasi untuk kasus ini masih ada dalam daftar. Memiliki mata pada # 735 .
— Arun
6
Hai, Apa $ V1 di sini? #noob
— sriharsha KB
1
Mengakses kolom nama otomatis. Jalankan tanpa itu untuk memahami lebih baik.
— Arun
2
@HappyCoding, lihat ?`.I`dan lihat apakah penjelasan dan contoh di sana membantu?
— Arun
63

Metode yang paling intuitif adalah dengan menggunakan fungsi group_by dan top_n di dplyr

    group %>% group_by(Subject) %>% top_n(1, pt)

Hasil yang Anda dapatkan adalah

    Source: local data frame [3 x 3]
    Groups: Subject [3]

      Subject    pt Event
        (dbl) (dbl) (dbl)
    1       1     5     2
    2       2    17     2
    3       3     5     2
— Xi Liang
sumber
2
dplyr juga berguna ketika Anda ingin mengakses nilai terkecil dan terbesar dalam grup karena nilainya tersedia sebagai larik. Jadi, Anda dapat mengurutkan terlebih dahulu berdasarkan pt menurun dan kemudian menggunakan pt [1] atau pertama (pt) untuk mendapatkan nilai tertinggi: group %>% group_by(Subject) %>% arrange(desc(pt), .by_group = TRUE) %>% summarise(max_pt=first(pt), min_pt=last(pt), Event=first(Event))
— cw '
3
Ini akan mencakup beberapa baris jika ada ikatan. Gunakan slice(which.max(pt))untuk hanya menyertakan satu baris per grup.
— cakraww
36

Solusi yang lebih singkat menggunakan data.table:

setDT(group)[, .SD[which.max(pt)], by=Subject]
#    Subject pt Event
# 1:       1  5     2
# 2:       2 17     2
# 3:       3  5     2
— Mark Chamness
sumber
4
Perhatikan bahwa, ini bisa lebih lambat dari yang group[group[, .I[which.max(pt)], by=Subject]$V1]diusulkan di atas oleh @Arun; lihat perbandingannya di sini
— Valentin
1
Saya suka yang ini karena cukup cepat untuk konteks saya saat ini dan lebih mudah untuk saya dibandingkan .Iversinya
— arvi1000
setDT (grup) [, .SD [pt == max (pt)], oleh = Subjek]
— Ferroao
19

Pilihan lainnya adalah slice

library(dplyr)
group %>%
     group_by(Subject) %>%
     slice(which.max(pt))
#    Subject    pt Event
#    <dbl> <dbl> <dbl>
#1       1     5     2
#2       2    17     2
#3       3     5     2
— akrun
sumber
14

Sebuah dplyrsolusi:

library(dplyr)
ID <- c(1,1,1,2,2,2,2,3,3)
Value <- c(2,3,5,2,5,8,17,3,5)
Event <- c(1,1,2,1,2,1,2,2,2)
group <- data.frame(Subject=ID, pt=Value, Event=Event)

group %>%
    group_by(Subject) %>%
    summarize(max.pt = max(pt))

Ini menghasilkan kerangka data berikut:

  Subject max.pt
1       1      5
2       2     17
3       3      5
— tkmckenzie.dll
sumber
11
Saya pikir OP ingin menjaga Eventkolom di subset dalam hal ini Anda dapat melakukan: df %>% group_by(Subject) %>% filter(pt == max(pt))(termasuk hubungan jika ada)
— talat
8

Saya tidak yakin apa yang ingin Anda lakukan tentang kolom Peristiwa, tetapi jika Anda ingin menyimpannya juga, bagaimana dengan

isIDmax <- with(dd, ave(Value, ID, FUN=function(x) seq_along(x)==which.max(x)))==1
group[isIDmax, ]

#   ID Value Event
# 3  1     5     2
# 7  2    17     2
# 9  3     5     2

Di sini kita gunakan aveuntuk melihat kolom "Nilai" untuk setiap "ID". Kemudian kami menentukan nilai mana yang maksimal dan kemudian mengubahnya menjadi vektor logis yang dapat kami gunakan untuk membuat subset data.frame asli.

— MrFlick
sumber
Terima kasih banyak, tetapi saya punya pertanyaan lain di sini. Mengapa digunakan dengan fungsi dalam metode ini karena ave (Value, ID, FUN = function (x) seq_along (x) == which.max (x)) == 1 bekerja sangat baik? Saya agak bingung
— Xinting WANG
Saya menggunakan withkarena agak aneh memiliki data yang tersedia baik di dalam maupun di luar groupdata.frame. Jika Anda membaca data dengan read.tableatau sesuatu, Anda perlu menggunakan withkarena nama kolom tersebut tidak akan tersedia di luar data.frame.
— MrFlick
6 
do.call(rbind, lapply(split(group,as.factor(group$Subject)), function(x) {return(x[which.max(x$pt),])}))

Menggunakan Base R

— Kalees Waran
sumber
6

Sejak {dplyr} v1.0.0 (Mei 2020) ada slice_*sintaks baru yang menggantikan top_n().

Lihat juga https://dplyr.tidyverse.org/reference/slice.html .

library(tidyverse)

ID    <- c(1,1,1,2,2,2,2,3,3)
Value <- c(2,3,5,2,5,8,17,3,5)
Event <- c(1,1,2,1,2,1,2,2,2)

group <- data.frame(Subject=ID, pt=Value, Event=Event)

group %>% 
  group_by(Subject) %>% 
  slice_max(pt)
#> # A tibble: 3 x 3
#> # Groups:   Subject [3]
#>   Subject    pt Event
#>     <dbl> <dbl> <dbl>
#> 1       1     5     2
#> 2       2    17     2
#> 3       3     5     2

Dibuat pada 2020-08-18 oleh paket reprex (v0.3.0.9001)

Info sesi 
sessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#>  setting  value                                      
#>  version  R version 4.0.2 Patched (2020-06-30 r78761)
#>  os       macOS Catalina 10.15.6                     
#>  system   x86_64, darwin17.0                         
#>  ui       X11                                        
#>  language (EN)                                       
#>  collate  en_US.UTF-8                                
#>  ctype    en_US.UTF-8                                
#>  tz       Europe/Berlin                              
#>  date     2020-08-18                                 
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package     * version    date       lib source                            
#>  assertthat    0.2.1      2019-03-21 [1] CRAN (R 4.0.0)                    
#>  backports     1.1.8      2020-06-17 [1] CRAN (R 4.0.1)                    
#>  blob          1.2.1      2020-01-20 [1] CRAN (R 4.0.0)                    
#>  broom         0.7.0      2020-07-09 [1] CRAN (R 4.0.2)                    
#>  cellranger    1.1.0      2016-07-27 [1] CRAN (R 4.0.0)                    
#>  cli           2.0.2      2020-02-28 [1] CRAN (R 4.0.0)                    
#>  colorspace    1.4-1      2019-03-18 [1] CRAN (R 4.0.0)                    
#>  crayon        1.3.4      2017-09-16 [1] CRAN (R 4.0.0)                    
#>  DBI           1.1.0      2019-12-15 [1] CRAN (R 4.0.0)                    
#>  dbplyr        1.4.4      2020-05-27 [1] CRAN (R 4.0.0)                    
#>  digest        0.6.25     2020-02-23 [1] CRAN (R 4.0.0)                    
#>  dplyr       * 1.0.1      2020-07-31 [1] CRAN (R 4.0.2)                    
#>  ellipsis      0.3.1      2020-05-15 [1] CRAN (R 4.0.0)                    
#>  evaluate      0.14       2019-05-28 [1] CRAN (R 4.0.0)                    
#>  fansi         0.4.1      2020-01-08 [1] CRAN (R 4.0.0)                    
#>  forcats     * 0.5.0      2020-03-01 [1] CRAN (R 4.0.0)                    
#>  fs            1.5.0      2020-07-31 [1] CRAN (R 4.0.2)                    
#>  generics      0.0.2      2018-11-29 [1] CRAN (R 4.0.0)                    
#>  ggplot2     * 3.3.2      2020-06-19 [1] CRAN (R 4.0.1)                    
#>  glue          1.4.1      2020-05-13 [1] CRAN (R 4.0.0)                    
#>  gtable        0.3.0      2019-03-25 [1] CRAN (R 4.0.0)                    
#>  haven         2.3.1      2020-06-01 [1] CRAN (R 4.0.0)                    
#>  highr         0.8        2019-03-20 [1] CRAN (R 4.0.0)                    
#>  hms           0.5.3      2020-01-08 [1] CRAN (R 4.0.0)                    
#>  htmltools     0.5.0      2020-06-16 [1] CRAN (R 4.0.1)                    
#>  httr          1.4.2      2020-07-20 [1] CRAN (R 4.0.2)                    
#>  jsonlite      1.7.0      2020-06-25 [1] CRAN (R 4.0.2)                    
#>  knitr         1.29       2020-06-23 [1] CRAN (R 4.0.2)                    
#>  lifecycle     0.2.0      2020-03-06 [1] CRAN (R 4.0.0)                    
#>  lubridate     1.7.9      2020-06-08 [1] CRAN (R 4.0.1)                    
#>  magrittr      1.5        2014-11-22 [1] CRAN (R 4.0.0)                    
#>  modelr        0.1.8      2020-05-19 [1] CRAN (R 4.0.0)                    
#>  munsell       0.5.0      2018-06-12 [1] CRAN (R 4.0.0)                    
#>  pillar        1.4.6      2020-07-10 [1] CRAN (R 4.0.2)                    
#>  pkgconfig     2.0.3      2019-09-22 [1] CRAN (R 4.0.0)                    
#>  purrr       * 0.3.4      2020-04-17 [1] CRAN (R 4.0.0)                    
#>  R6            2.4.1      2019-11-12 [1] CRAN (R 4.0.0)                    
#>  Rcpp          1.0.5      2020-07-06 [1] CRAN (R 4.0.2)                    
#>  readr       * 1.3.1      2018-12-21 [1] CRAN (R 4.0.0)                    
#>  readxl        1.3.1      2019-03-13 [1] CRAN (R 4.0.0)                    
#>  reprex        0.3.0.9001 2020-08-13 [1] Github (tidyverse/reprex@23a3462) 
#>  rlang         0.4.7      2020-07-09 [1] CRAN (R 4.0.2)                    
#>  rmarkdown     2.3.3      2020-07-26 [1] Github (rstudio/rmarkdown@204aa41)
#>  rstudioapi    0.11       2020-02-07 [1] CRAN (R 4.0.0)                    
#>  rvest         0.3.6      2020-07-25 [1] CRAN (R 4.0.2)                    
#>  scales        1.1.1      2020-05-11 [1] CRAN (R 4.0.0)                    
#>  sessioninfo   1.1.1      2018-11-05 [1] CRAN (R 4.0.2)                    
#>  stringi       1.4.6      2020-02-17 [1] CRAN (R 4.0.0)                    
#>  stringr     * 1.4.0      2019-02-10 [1] CRAN (R 4.0.0)                    
#>  styler        1.3.2.9000 2020-07-05 [1] Github (pat-s/styler@51d5200)     
#>  tibble      * 3.0.3      2020-07-10 [1] CRAN (R 4.0.2)                    
#>  tidyr       * 1.1.1      2020-07-31 [1] CRAN (R 4.0.2)                    
#>  tidyselect    1.1.0      2020-05-11 [1] CRAN (R 4.0.0)                    
#>  tidyverse   * 1.3.0      2019-11-21 [1] CRAN (R 4.0.0)                    
#>  utf8          1.1.4      2018-05-24 [1] CRAN (R 4.0.0)                    
#>  vctrs         0.3.2      2020-07-15 [1] CRAN (R 4.0.2)                    
#>  withr         2.2.0      2020-04-20 [1] CRAN (R 4.0.0)                    
#>  xfun          0.16       2020-07-24 [1] CRAN (R 4.0.2)                    
#>  xml2          1.3.2      2020-04-23 [1] CRAN (R 4.0.0)                    
#>  yaml          2.2.1      2020-02-01 [1] CRAN (R 4.0.0)                    
#> 
#> [1] /Users/pjs/Library/R/4.0/library
#> [2] /Library/Frameworks/R.framework/Versions/4.0/Resources/library
— tepuk-s
sumber
5

Solusi dasar lainnya

group_sorted <- group[order(group$Subject, -group$pt),]
group_sorted[!duplicated(group_sorted$Subject),]

# Subject pt Event
#       1  5     2
#       2 17     2
#       3  5     2

Urutkan bingkai data dengan pt(turun) lalu hapus baris yang diduplikasiSubject

— Kera
sumber
3

Satu lagi solusi dasar R:

merge(aggregate(pt ~ Subject, max, data = group), group)

  Subject pt Event
1       1  5     2
2       2 17     2
3       3  5     2
— sindri_baldur
sumber
2

Berikut data.tablesolusi lain , karena which.maxtidak berfungsi pada karakter

library(data.table)
group <- data.table(Subject=ID, pt=Value, Event=Event)

group[, .SD[order(pt, decreasing = TRUE) == 1], by = Subject]
— Kyoma G
sumber
1

byadalah versi tapplyuntuk bingkai data:

res <- by(group, group$Subject, FUN=function(df) df[which.max(df$pt),])

Ini mengembalikan objek kelas byjadi kami mengubahnya menjadi bingkai data:

do.call(rbind, b)
  Subject pt Event
1       1  5     2
2       2 17     2
3       3  5     2
— Karolis Koncevičius
sumber
1

Dalam basis Anda dapat menggunakan aveuntuk mendapatkan maxper grup dan membandingkannya dengan ptdan mendapatkan vektor logis untuk subset data.frame.

group[group$pt == ave(group$pt, group$Subject, FUN=max),]
#  Subject pt Event
#3       1  5     2
#7       2 17     2
#9       3  5     2

Atau bandingkan sudah di fungsinya.

group[as.logical(ave(group$pt, group$Subject, FUN=function(x) x==max(x))),]
#group[ave(group$pt, group$Subject, FUN=function(x) x==max(x))==1,] #Variant
#  Subject pt Event
#3       1  5     2
#7       2 17     2
#9       3  5     2
— GKi
sumber
0

data.tablePilihan lain :

library(data.table)
setDT(group)
group[group[order(-pt), .I[1L], Subject]$V1]

Atau lainnya (kurang terbaca tetapi sedikit lebih cepat):

group[group[, rn := .I][order(Subject, -pt), {
    rn[c(1L, 1L + which(diff(Subject)>0L))]
}]]

kode waktu:

library(data.table)
nr <- 1e7L
ng <- nr/4L
set.seed(0L)
DT <- data.table(Subject=sample(ng, nr, TRUE), pt=1:nr)#rnorm(nr))
DT2 <- copy(DT)


microbenchmark::microbenchmark(times=3L,
    mtd0 = {a0 <- DT[DT[, .I[which.max(pt)], by=Subject]$V1]},
    mtd1 = {a1 <- DT[DT[order(-pt), .I[1L], Subject]$V1]},
    mtd2 = {a2 <- DT2[DT2[, rn := .I][
        order(Subject, -pt), rn[c(TRUE, diff(Subject)>0L)]
    ]]},
    mtd3 = {a3 <- unique(DT[order(Subject, -pt)], by="Subject")}
)
fsetequal(a0[order(Subject)], a1[order(Subject)])
#[1] TRUE
fsetequal(a0[order(Subject)], a2[, rn := NULL][order(Subject)])
#[1] TRUE
fsetequal(a0[order(Subject)], a3[order(Subject)])
#[1] TRUE

pengaturan waktu:

Unit: seconds
 expr      min       lq     mean   median       uq      max neval
 mtd0 3.256322 3.335412 3.371439 3.414502 3.428998 3.443493     3
 mtd1 1.733162 1.748538 1.786033 1.763915 1.812468 1.861022     3
 mtd2 1.136307 1.159606 1.207009 1.182905 1.242359 1.301814     3
 mtd3 1.123064 1.166161 1.228058 1.209257 1.280554 1.351851     3
— chinsoon12
sumber
0

data.tableSolusi lain :

library(data.table)
setDT(group)[, head(.SD[order(-pt)], 1), by = .(Subject)]
— Vykta Wakandigara
sumber
-1

Jika Anda menginginkan nilai pt terbesar untuk sebuah subjek, Anda dapat menggunakan:

   pt_max = as.data.frame(aggregate(pt~Subject, group, max))
— Mutyalama
sumber
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.