So wählen Sie die Zeile mit dem Maximalwert in jeder Gruppe aus


91

In einem Datensatz mit mehreren Beobachtungen für jedes Subjekt möchte ich eine Teilmenge mit nur dem maximalen Datenwert für jeden Datensatz erstellen. Zum Beispiel mit einem folgenden Datensatz:

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)

Subjekt 1, 2 und 3 haben den größten pt-Wert von 5, 17 bzw. 5.

Wie könnte ich zuerst den größten pt-Wert für jedes Subjekt finden und diese Beobachtung dann in einen anderen Datenrahmen einfügen? Der resultierende Datenrahmen sollte nur die größten pt-Werte für jedes Subjekt haben.


2
Dies ist sehr eng verwandt, aber für minimale statt maximale stackoverflow.com/questions/24070714/…
David Arenburg

Antworten:


95

Hier ist eine data.tableLösung:

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

Wenn Sie alle Einträge behalten möchten, die den Maximalwerten ptjeder Gruppe entsprechen:

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

Wenn Sie nur den ersten Maximalwert von möchten 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

In diesem Fall macht es keinen Unterschied, da Ihre Daten in keiner Gruppe mehrere Maximalwerte enthalten.


2
Da data.table seit 2014 viele Änderungen vorgenommen hat, ist dies immer noch die schnellste / beste Lösung für diese Frage?
Ben

2
@ Ben, in diesem Fall ist die schnellste Antwort immer noch diese, ja. .SDDie Optimierung für diese Fälle steht noch auf der Liste. Behalte # 735 im Auge .
Arun

6
Hallo, was ist $ V1 hier? #noob
sriharsha KB

1
Zugriff auf die automatisch benannte Spalte. Führen Sie es ohne aus, um es besser zu verstehen.
Arun

2
@HappyCoding, schauen Sie sich an, ?`.I`ob die Erklärungen und Beispiele dort helfen?
Arun

59

Die intuitivste Methode ist die Verwendung der Funktionen group_by und top_n in dplyr

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

Das Ergebnis ist

    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

2
dplyr ist auch nützlich, wenn Sie auf den kleinsten und größten Wert in einer Gruppe zugreifen möchten, da die Werte als Array verfügbar sind. Sie können also zuerst nach absteigendem group %>% group_by(Subject) %>% arrange(desc(pt), .by_group = TRUE) %>% summarise(max_pt=first(pt), min_pt=last(pt), Event=first(Event))
cw

3
Dies schließt mehrere Zeilen ein, wenn es Bindungen gibt. Verwenden Sie slice(which.max(pt))diese Option, um nur eine Zeile pro Gruppe einzuschließen.
Cakraww

35

Eine kürzere Lösung mit 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

4
Beachten Sie, dass dies langsamer sein kann als group[group[, .I[which.max(pt)], by=Subject]$V1]oben von @Arun vorgeschlagen. siehe Vergleiche hier
Valentin

1
Ich mag dieses, weil es schnell genug für meinen aktuellen Kontext ist und für mich einfacher zu verstehen ist als die .IVersion
arvi1000

setDT (Gruppe) [, .SD [pt == max (pt)], von = Betreff]
Ferroao

15

Eine andere Option ist 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

2
Immer gut zu merken which.max(), so eine nützliche Funktion!
Lauren Fitch

13

Eine dplyrLösung:

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

Dies ergibt den folgenden Datenrahmen:

  Subject max.pt
1       1      5
2       2     17
3       3      5

10
Ich denke, das OP möchte die EventSpalte in der Teilmenge behalten. In diesem Fall könnten Sie df %>% group_by(Subject) %>% filter(pt == max(pt))
Folgendes

7

Ich war mir nicht sicher, was Sie mit der Spalte "Ereignis" tun wollten, aber wenn Sie das auch beibehalten möchten, wie wäre es dann?

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

Hier sehen wir uns die aveSpalte "Wert" für jede "ID" an. Dann bestimmen wir, welcher Wert das Maximum ist, und wandeln diesen in einen logischen Vektor um, mit dem wir den ursprünglichen Datenrahmen unterteilen können.


Vielen Dank, aber ich habe hier eine andere Frage. Warum mit Funktion in dieser Methode verwenden, da ave (Wert, ID, FUN = Funktion (x) seq_along (x) == which.max (x)) == 1 sehr gut funktioniert? Ich bin ein bisschen durcheinander.
Xinting WANG

Ich habe es verwendet, withweil es etwas seltsam ist, die Daten sowohl innerhalb als auch außerhalb des groupdata.frame verfügbar zu haben . Wenn Sie die Daten mit read.tableoder etwas einlesen , müssen Sie sie verwenden, withda diese Spaltennamen außerhalb des data.frame nicht verfügbar sind.
MrFlick

6
do.call(rbind, lapply(split(group,as.factor(group$Subject)), function(x) {return(x[which.max(x$pt),])}))

Base verwenden R


4

Eine andere Basislösung

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

Ordnen Sie den Datenrahmen nach pt(absteigend) und entfernen Sie die darin duplizierten ZeilenSubject


3

Noch eine Base R-Lösung:

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

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

2

Hier ist eine andere data.tableLösung, da which.maxsie nicht für Zeichen funktioniert

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

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

1

Seit {dplyr} v1.0.0 (Mai 2020) gibt es die neue slice_*Syntax, die ersetzt top_n().

Siehe auch 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

Erstellt am 18.08.2018 durch das reprex-Paket (v0.3.0.9001)

Sitzungsinfo
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

0

Eine weitere data.tableOption:

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

Oder eine andere (weniger lesbar, aber etwas schneller):

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

Timing-Code:

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

Timings:

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

0

Eine andere data.tableLösung:

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

0

byist eine Version von tapplyfür Datenrahmen:

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

Es gibt ein Objekt der Klasse zurück, byalso konvertieren wir es in einen Datenrahmen:

do.call(rbind, b)
  Subject pt Event
1       1  5     2
2       2 17     2
3       3  5     2

0

In der Basis können Sie verwenden ave, um maxpro Gruppe zu erhalten und dies mit zu vergleichen ptund einen logischen Vektor zu erhalten, um die zu unterteilen 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

Oder vergleichen Sie es bereits in der Funktion.

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

0

Base R - Schnell - einfach in jeder Funktion anwendbar

Im Gegensatz zu anderen Lösungen ist diese Lösung immer noch schnell, benötigt keine zusätzliche Bibliothek und kann problemlos mit Argumenten innerhalb einer Funktion verwendet werden (verwenden Sie dann group [[argument]], wobei argument zB Zeichen ist).

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)
#sorting is needed
group <- group[order(group$Event), ]

Erstes Maximum

group[unlist(tapply(group$pt, group$Event, function(x) seq_along(x) == which.max(x))), ]

Alles maximal

group[unlist(tapply(group$pt, group$Event, function(x) x == max(x))), ]

-1

Wenn Sie den größten pt-Wert für ein Thema wünschen, können Sie einfach Folgendes verwenden:

   pt_max = as.data.frame(aggregate(pt~Subject, group, max))
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.