r - 为命名字段具有MAX值的数据框行提取索引

Question

我有一个相当大的数据框，我需要一种好的方法(波纹管说明)来提取在一组特定标签内具有给定字段最大值的行的索引。为了更好地说明这一点，下面是一个示例的10行数据帧:

      value label
1  5.531637     D
2  5.826498     A
3  8.866210     A
4  1.387978     C
5  8.128505     C
6  7.391311     B
7  1.829392     A
8  4.373273     D
9  7.380244     A
10 6.157304     D

产生:

structure(list(value = c(5.531637, 5.826498, 8.86621, 1.387978, 8.128505, 
7.391311, 1.829392, 4.373273, 7.380244, 6.157304), 
label = c("D", "A", "A", "C", "C", "B", "A", "D", "A", "D")), 
.Names = c("value", "label"), class = "data.frame", row.names = c(NA, -10L))

如果我想知道每个标签具有最大值的行的索引是什么，我目前使用以下代码:

idx <- sapply(split(1:nrow(d), d$label), function(x) {
  x[which.max(d[x,"value"])]
})

产生此答案:

A  B  C  D 
3  6  5 10

我也玩过 ddply，但还没有找到更好的方法来做到这一点。在这种情况下，“更好”的意思是速度更快( ddply相当慢，我目前使用的语言也不落后)，并且也更优雅，因为上述解决方案似乎也太罗word了。

Answer 1

首先:您可以使用以下方法加快速度:

idx <- sapply(split(seq_len(nrow(d)), d$label), function(x) {
      x[which.max(d$value[x])]})

对于100k的 data.frame，在我的机器上，它比 d[x,"value"]版本快5倍。

对于较大的 data.frame和许多标签，您可以使用与 I posted in earlier question类似的方法:

dd <- d[i<-order(d$label, d$value),] # dd is sorted by label and value
ind <- c(dd$label[-1] != dd$label[-n], TRUE)
idx <- setNames(seq_len(nrow(d))[i][ind], dd$label[ind])

编辑:使用来自 Martin Morgan answer的技巧的更有效的解决方案:

v <- d$label[i<-order(d$value)] # we need only label, and with Martin
                                # trick sorting over label is not needed
ind <- !duplicated(v, fromLast=TRUE) # it finds last (max) occurrence of label
idx <- setNames(seq_len(nrow(d))[i][ind], v[ind])

注意:最终向量的顺序是不同的。

这取决于您的实际数据结构，但是您应该获得很好的加速:

时间:

# NOTE: different machine, so timing differ from previous
set.seed(6025051)
n <- 100000; k <- 20000
d <- data.frame(value=rnorm(n), 
    label=sample(paste("A",seq_len(k),sep="_"), n, replace=TRUE))

system.time(
    idx_1 <- sapply(split(1:nrow(d), d$label), function(x) {
        x[which.max(d[x,"value"])]})
)
# user  system elapsed 
# 1.30    0.02    1.31 
system.time(
    idx_1b <- sapply(split(seq_len(nrow(d)), d$label), function(x) {
        x[which.max(d$value[x])]})
)
# user  system elapsed 
# 0.23    0.00    0.23
all.equal(idx_1, idx_1b)
# [1] TRUE
system.time({
    dd <- d[i<-order(d$label, d$value),]
    ind <- c(dd$label[-1] != dd$label[-n], TRUE)
    idx_2 <- setNames(seq_len(nrow(d))[i][ind],dd$label[ind])
})
# user  system elapsed 
# 0.19    0.00    0.19 
all.equal(idx_1, idx_2)
# [1] TRUE

新解决方案

system.time({
    v <- d$label[i<-order(d$value)]
            ind <- !duplicated(v, fromLast=TRUE)
            idx_3 <- setNames(seq_len(nrow(d))[i][ind], v[ind])
})
# user  system elapsed 
# 0.05    0.00    0.04 
all.equal(sort(idx_1), sort(idx_3))
# [1] TRUE