각 그룹에서 최대 값이있는 행을 선택하는 방법


94

각 주제에 대한 여러 관측치가있는 데이터 세트에서 각 레코드에 대한 최대 데이터 값만있는 하위 집합을 취하려고합니다. 예를 들어 다음 데이터 세트를 사용합니다.

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)

주제 1, 2 및 3은 각각 5, 17 및 5의 가장 큰 pt 값을 갖습니다.

먼저 각 주제에 대한 가장 큰 pt 값을 찾은 다음이 관측치를 다른 데이터 프레임에 넣으려면 어떻게해야합니까? 결과 데이터 프레임에는 각 주제에 대해 가장 큰 pt 값만 있어야합니다.


2
이것은 매우 밀접한 관련이 대신 최대의 최소있다 stackoverflow.com/questions/24070714/...
데이비드 Arenburg을

답변:


96

data.table해결책은 다음과 같습니다 .

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

pt각 그룹 내에서의 최대 값에 해당하는 모든 항목을 유지하려는 경우 :

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

의 첫 번째 최대 값 만 원하는 경우 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

이 경우 데이터의 어떤 그룹에도 최대 값이 여러 개 없기 때문에 차이가 없습니다.


2
data.table이 2014 년 이후로 많은 변화를 겪었 기 때문에 이것이 여전히이 질문에 대한 가장 빠른 / 최상의 솔루션입니까?
Ben

2
@Ben,이 경우 가장 빠른 대답은 여전히 ​​이것입니다. .SD이러한 경우에 대한 최적화는 여전히 목록에 있습니다. # 735를 주시하십시오 .
Arun

6
안녕하세요, $ V1이 무엇인가요? #noob
스리 하샤 KB

1
자동 이름이 지정된 열에 액세스합니다. 더 잘 이해하려면 그것없이 실행하십시오.
Arun

2
@HappyCoding, ?`.I`설명과 예제가 도움이되는지 살펴 보 시겠습니까?
Arun

63

가장 직관적 인 방법은 dplyr에서 group_by 및 top_n 함수를 사용하는 것입니다.

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

당신이 얻는 결과는

    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는 값을 배열로 사용할 수 있기 때문에 그룹에서 가장 작은 값과 가장 큰 값에 액세스하려는 경우에도 유용합니다. 따라서 먼저 pt 내림차순으로 정렬 한 다음 pt [1] 또는 first (pt)를 사용하여 가장 높은 값을 얻을 수 있습니다. group %>% group_by(Subject) %>% arrange(desc(pt), .by_group = TRUE) %>% summarise(max_pt=first(pt), min_pt=last(pt), Event=first(Event))
cw '

3
동점이있는 경우 여러 행이 포함됩니다. slice(which.max(pt))그룹당 하나의 행만 포함하는 데 사용 합니다.
cakraww

36

다음을 사용하는 더 짧은 솔루션 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
이것은 group[group[, .I[which.max(pt)], by=Subject]$V1]@Arun이 위에서 제안한 것보다 느릴 수 있습니다 . 비교를 참조 여기에
발렌틴

1
나는 이것이 나의 현재 상황에 대해 충분히 빠르고 .I버전에 비해 나를 위해 더 쉽게
구할

setDT (group) [, .SD [pt == max (pt)], by = Subject]
Ferroao

19

또 다른 옵션은 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

14

dplyr솔루션 :

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

그러면 다음 데이터 프레임이 생성됩니다.

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

11
나는 OP가 Event당신이 할 수있는 경우에 열을 하위 집합에 유지하기를 원한다고 생각합니다 : df %>% group_by(Subject) %>% filter(pt == max(pt))(존재하는 경우 동점 포함)
talat

8

이벤트 칼럼에 대해 뭘하고 싶은지 잘 모르겠지만, 그대로 유지하고 싶다면

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

여기 ave에서 각 "ID"에 대한 "값"열을 살펴 봅니다. 그런 다음 어떤 값이 최대 값인지 결정한 다음이를 논리 벡터로 변환하여 원래 데이터 프레임을 부분 집합으로 만듭니다.


대단히 감사하지만 여기에 또 다른 질문이 있습니다. ave (Value, ID, FUN = function (x) seq_along (x) == which.max (x)) == 1이 매우 잘 작동하므로이 메서드에서 함수와 함께 사용하는 이유는 무엇입니까? 조금 혼란 스럽습니다.
Xinting WANG

data.frame with안팎에서 데이터를 사용할 수 있다는 것이 약간 이상하기 때문에 사용 했습니다 group. read.table또는 무언가로 데이터를 읽는 경우 with해당 열 이름을 data.frame 외부에서 사용할 수 없기 때문에 사용해야 합니다.
MrFlick

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

베이스 사용 R


6

{dplyr} v1.0.0 개발자 (2020 년 5 월) 이후 새로운 존재 slice_*하는 대체 구문은 top_n().

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

reprex 패키지 (v0.3.0.9001)에 의해 2020-08-18에 생성됨

세션 정보
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

5

또 다른 기본 솔루션

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

데이터 프레임을 pt(내림차순) 정렬 한 다음 중복 된 행을 제거합니다.Subject


3

하나 더 기본 R 솔루션 :

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

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

2

캐릭터에서 작동하지 않기 data.table때문에 다른 해결책 which.max이 있습니다.

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

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

1

bytapply데이터 프레임 의 버전입니다 .

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

클래스의 객체를 반환 by하므로 데이터 프레임으로 변환합니다.

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

1

에서 기본 당신은 사용할 수 있습니다 ave얻을 max그룹당과 함께이 비교 pt하고, 부분 집합하는 논리적 벡터를 얻을 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

또는 함수에서 이미 비교하십시오.

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

다른 data.table옵션 :

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

또는 다른 (읽기 어렵지만 약간 더 빠름) :

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

타이밍 코드 :

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

타이밍 :

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

또 다른 data.table해결책 :

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

-1

주제에 대해 가장 큰 pt 값을 원하면 다음을 사용할 수 있습니다.

   pt_max = as.data.frame(aggregate(pt~Subject, group, max))
당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.