Question

我有一个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位，然后再次对其进行重新绑定。但这听起来很不专业！

这是一个生成类似例子的命令：

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

谢谢大家。

Answer 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

Answer 2

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

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

这可以通过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)

前两种方法（托马斯和我的第一种方法）花费了相当多的时间，因此我只需将它们计时一次，而不是基准测试。

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

Answer 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)), ]

以下是使用拆分 - 应用 - 合并策略所需的代码：

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

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

3 个答案:

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