选择每组中具有最大值的行

在每个主题具有多个观察值的数据集中。对于每个主题，我想选择最大值为‘ pt’的行。例如，使用以下数据集:

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)
#   Subject pt Event
# 1       1  2     1
# 2       1  3     1
# 3       1  5     2 # max 'pt' for Subject 1
# 4       2  2     1
# 5       2  5     2
# 6       2  8     1
# 7       2 17     2 # max 'pt' for Subject 2
# 8       3  3     2
# 9       3  5     2 # max 'pt' for Subject 3

受试者1、2和3的 pt 值最大，分别为5、17和5。

我怎样才能首先找到每个主题的最大 pt 值，然后把这个观察结果放到另一个数据框架中呢？生成的数据框架对于每个主题应该只有最大的 pt 值。

171731 次浏览
小开

我不确定你想怎么处理“事件”栏目，但如果你也想保留这个栏目，不如

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”的“ Value”列。然后我们确定哪个值是最大值，然后将其转换为逻辑向量，我们可以使用它来对原始 data.frame 进行子集。

小开

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
小开
最佳答案

这里有一个 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

在这种情况下，这没有什么区别，因为数据中的任何组中都没有多个最大值。

小开

使用 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
小开

最直观的方法是在 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
小开

另一个选择是 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
小开 
do.call(rbind, lapply(split(group,as.factor(group$Subject)), function(x) {return(x[which.max(x$pt),])}))

使用基本 R

小开

如果您想要一个主题的 pt 值最大，您可以简单地使用:

   pt_max = as.data.frame(aggregate(pt~Subject, group, max))
小开

这里是另一个 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]
小开

另一个基础解决方案

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中重复的行

小开

还有一个基 R 解:

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


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

另一种 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
小开

另一种 data.table解决方案:

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

by是数据帧 tapply的一个版本:

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
小开

在 基地中，您可以使用 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
小开

自{ 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 软件包于2020-08-18创作(0.3.0.9001)

会议信息 
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
小开

使用 dplyr1.0.2现在有两种方法可以做到这一点，一种是使用 long hand，另一种是使用动词 cross () :

      # create data
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)

长话短说动词是 max () ，但请注意 na.rm = TRUE，这对于那些有 NAs 的例子很有用，比如闭合问句: 在数据框架中合并行，其中的行是不相交的并且包含 NA:

       group %>%
group_by(Subject) %>%
summarise(pt = max(pt, na.rm = TRUE),
Event = max(Event, na.rm = TRUE))

如果只有少数几列，但是如果表中有许多横跨()的列，则这样做是可以的。这个动词的示例通常使用总结(cross (start _ with...) ，但是在这个示例中，列的开头并不使用相同的字符。它们要么可以改变，要么可以列出以下职位:

    group %>%
group_by(Subject) %>%
summarise(across(1:ncol(group)-1, max, na.rm = TRUE, .names = "{.col}"))

注意，动词 cross ()1指的是第一列 之后，第一个实际列，因此使用 ncol(group)不起作用，因为这样的列太多了(使其位置为4而不是3)。


提交答案