子集每个唯一 ID 的前 4 个观察值答案

【问题标题】：Subsetting top 4 observations of each unique ID子集每个唯一 ID 的前 4 个观察值
【发布时间】：2014-02-24 09:29:02
【问题描述】：

我有一个 4 列和几千行的数据框。我根据他们的第 4 列（即它们的 ID）（降序）对数据框进行排序，然后到第二列（升序）。这是我的数据的样子：

 X1 X2 X3 X4
 24  1 23 25
 21  3 19 25
 19  6 20 25
 11 12 14 25
 14  9 21 24
  3 12 25 24
 24 15 23 24
  8  1  4 23
 17  4 12 23
 16 11 23 23
 20 19 21 23
 24 19 16 23
 19 20  7 23
 19 22 22 22
 11  2 18 21
 15  9 19 21
 10 14  9 21
 17 15 19 21
 16 20  6 21

我试图保留每个 ID 的最高 4 个值（如果可用），我想要的输出是

 X1 X2 X3 X4
 24  1 23 25
 21  3 19 25
 19  6 20 25
 11 12 14 25
 14  9 21 24
  3 12 25 24
 24 15 23 24
  8  1  4 23
 17  4 12 23
 16 11 23 23
 20 19 21 23
 19 22 22 22
 11  2 18 21
 15  9 19 21
 10 14  9 21
 17 15 19 21
# note that 2 of the 23 ID observations and one of the 21 ID observations were removed.

我想知道是否有一些简短的命令可以为我完成这项工作？我能想到一个大约 1 页长的命令！这是根据第 4 列对数据进行子集化，取前 5 个，然后再次 rbind。但这听起来太不专业了！

这是生成类似示例的命令：

m0 <- matrix(0, 100, 4)
df <- data.frame(apply(m0, c(1,2), function(x) sample(c(0:25),1)))
##fix(df)
odf <- df[order(-as.numeric(df$X4), as.numeric(df$X2)), ]

谢谢大家。

【问题讨论】：

标签： r dataframe subset

【解决方案1】：

也许data.table:

require(data.table)

df<-read.table(header=T,text=" X1 X2 X3 X4
 24  1 23 25
 21  3 19 25
 19  6 20 25
 11 12 14 25
 14  9 21 24
  3 12 25 24
 24 15 23 24
  8  1  4 23
 17  4 12 23
 16 11 23 23
 20 19 21 23
 24 19 16 23
 19 20  7 23
 19 22 22 22
 11  2 18 21
 15  9 19 21
 10 14  9 21
 17 15 19 21
 16 20  6 21")

data.table(df)[,.SD[order(X2)][1:4,],by="X4"][!is.na(X3)][,list(X1,X2,X3,X4)]

   X1 X2 X3 X4
1: 24  1 23 25
2: 21  3 19 25
3: 19  6 20 25
4: 11 12 14 25
5: 14  9 21 24
6:  3 12 25 24
7: 24 15 23 24
8:  8  1  4 23
9: 17  4 12 23
10: 16 11 23 23
11: 20 19 21 23
12: 19 22 22 22
13: 11  2 18 21
14: 15  9 19 21
15: 10 14  9 21
16: 17 15 19 2

这是data.table 通话中发生的事情：

data.table(df)[         # data.table of df
  ,.SD[                 # for each by=X4, .SD is the sub-table
    order(X2)][1:4,],   # first four entries ordered by X2 
  by="X4"][             # X4 is the grouping variable
    !is.na(X3)][        # filter out NAs (i.e. less than 4 entries per row)
      ,list(X1,X2,X3,X4)] # order the columns

【讨论】：

+1。或者更好的是，将第一个订单也带到data.table：data.table(df)[order(-X4)][,.SD[order(X2)][1:4,],by="X4"][!is.na(X3)][,list(X1,X2,X3,X4)]

【解决方案2】：

我认为 Thomas 的解决方案很好，但可以改进。我猜想拆分、重组和重新排序可能很耗时。

相反，我会创建一个向量，我们可以从中进行子集化。

这很容易使用ave 完成，并且应该可以工作，因为数据已经排序。

继续：

odf <- df[order(-as.numeric(df$X4), as.numeric(df$X2)), ]

我们可以做到：

out <- odf[ave(odf$X4, odf$X4, FUN = seq_along) <= 4, ]
head(out)
#    X1 X2 X3 X4
# 24  3  4 13 25
# 6  23  5 13 25
# 19  9 11 24 25
# 40 10 13 11 25
# 93 16  2 25 24
# 26 10 11 13 24

tail(out)
#    X1 X2 X3 X4
# 61 23  7 13  2
# 2   9  9  5  2
# 17 18 18 16  2
# 67 12  1  1  1
# 52 22 14 24  1
# 9  16 24  6  1

更新：新的替代方案和基准

“dplyr”包非常适合这个，而且语法非常紧凑。但首先，让我们进行一些设置，看看这些选项有多快：

基准函数

fun1 <- function() {
  odf <- df[order(-as.numeric(df$X4), as.numeric(df$X2)), ]
  out <- do.call(rbind, lapply(split(odf, odf$X4), function(z) head(z[order(z$X2),],4) ))
  out[order(out$X4, decreasing=TRUE),]
}

fun2 <- function() {
  odf <- df[order(-as.numeric(df$X4), as.numeric(df$X2)), ]
  odf[ave(odf$X4, odf$X4, FUN = seq_along) <= 4, ]
}

fun3 <- function() {
  DT <- data.table(df)
  DT[, X := -X4]
  setkey(DT, X, X2)
  DT[, .SD[sequence(min(.N, 4))], by = X][, X:=NULL][]
}

fun4 <- function() {
  group_by(arrange(df, desc(X4), X2), X4) %.% 
    mutate(vals = seq_along(X4)) %.% 
    filter(vals <= 4)
}

更大版本的样本数据

set.seed(1)
df <- data.frame(matrix(sample(0:1000, 1000000 * 4, replace = TRUE), ncol = 4))

必要的包

library(data.table)
library(dplyr)
library(microbenchmark)

前两种方法（Thomas 的方法和我的第一种方法）需要相当长的时间，因此我不会进行基准测试，而是只计算一次。

system.time(fun1())
#    user  system elapsed 
#   6.645   0.007   6.670 

system.time(fun2())
#    user  system elapsed 
#   4.053   0.004   4.186

这是“dplyr”和“data.table”的结果。

microbenchmark(fun3(), fun4(), times = 20)
# Unit: seconds
#    expr      min       lq   median       uq      max neval
#  fun3() 2.157956 2.221746 2.303286 2.343951 2.392391    20
#  fun4() 1.169212 1.180780 1.194994 1.206651 1.369922    20

比较“dplyr”和“data.table”方法的输出：

out_DT <- fun3()
out_DP <- fun4()
out_DT
#        X1 X2  X3   X4
#    1: 340  0 708 1000
#    2: 144  1 667 1000
#    3:  73  2 142 1000
#    4:  79  2 826 1000
#    5: 169  0 870  999
#   ---                
# 4000:  46  4   2    1
# 4001:  88  0 809    0
# 4002: 535  0 522    0
# 4003:  75  3 234    0
# 4004: 983  3 492    0
head(out_DP, 5)
# Source: local data frame [5 x 5]
# Groups: X4
# 
#    X1 X2  X3   X4 vals
# 1 340  0 708 1000    1
# 2 144  1 667 1000    2
# 3  73  2 142 1000    3
# 4  79  2 826 1000    4
# 5 169  0 870  999    1
tail(out_DP, 5)
# Source: local data frame [5 x 5]
# Groups: X4
# 
#       X1 X2  X3 X4 vals
# 4000  46  4   2  1    4
# 4001  88  0 809  0    1
# 4002 535  0 522  0    2
# 4003  75  3 234  0    3
# 4004 983  3 492  0    4

【讨论】：

+1 我怀疑重新排序是我的版本和您的第一个版本中真正耗时的部分。我们是否在 SO 上的其他任何地方对 order 运行了基准测试？
@Thomas，order 绝对是一个瓶颈，当我们有很多值要订购时，它变得越来越严重。

【解决方案3】：

我再次通过set.seed 调用包含您的代码，以便完全可以重现。

set.seed(1)
m0 <- matrix(0, 100, 4)
df <- data.frame(apply(m0, c(1,2), function(x) sample(c(0:25),1)))
odf <- df[order(-as.numeric(df$X4), as.numeric(df$X2)), ]

这是您使用 split-apply-combine 策略所需的代码：

out <- do.call(rbind, lapply(split(odf, odf$X4), function(z) head(z[order(z$X2),],4) ))
out <- out[order(out$X4, decreasing=TRUE),]

结果：

> dim(out)
[1] 79  4
> head(out)
      X1 X2 X3 X4
25.24  3  4 13 25
25.6  23  5 13 25
25.19  9 11 24 25
25.40 10 13 11 25
24.93 16  2 25 24
24.26 10 11 13 24

【讨论】：

感谢 Thomas，所以它基本上是相同的想法，但是脚本要好得多 :) 赞赏。
刚刚将其转换为“dplyr”方法。没有太多使用 dplyr，所以甚至不确定它是否是最好的方法，但我提出的解决方案是 fast。
感谢@AnandaMahto，我可能需要最快的方法来解决这个问题，数据集非常庞大！我会阅读您在答案中发布的详细信息。干杯