r - 从行中选择第 i 个最高值并分配给新列的最快方法

Question

我正在寻找一种解决方案，将新列添加到现有数据框/数据表中，这是每个单独行中的第 i 个最大值。例如，如果我想要第 4 个最高值，新列的第一行将包含 1.9。

data <- data.frame(a = c("a","a","b","b","c","a"),
                   peak1 = c(1.1,2.5,2.4,2.1,2.5,2.6),
                   peak2 = c(1.2,2.5,2.4,2.1,2.5,2.6),
                   peak3 = c(1.3,2.5,2.4,2.1,2.5,2.6),
                   peak4 = c(1.4,2.5,2.5,2.1,2.5,2.6),
                   peak5 = c(1.5,2.5,2.46,2.1,2.5,2.6),
                   peak6 = c(1.6,2.5,2.4,2.1,2.5,2.6),
                   peak7 = c(1.7,2.5,2.4,2.1,2.5,2.0),
                   peak8 = c(1.8,2.5,2.4,2.1,2.5,2.1),
                   peak9 = c(1.9,2.2,2.4,2.1,2.5,2.2),
                   peak10 = c(2,2.5,2.4,2.1,2.5,2.3),
                   peak11 = c(2.1,2.5,2.4,2.1,2.5,2.4),
                   peak12 = c(2.2,2.5,2.4,2.99,3,2.5))

我尝试添加一个索引列，然后使用 lapply 函数选择值，但它在每个单元格中返回一个列表，并且在实际数据集上运行速度非常慢，该数据集有 ~3.000.000 条记录。理想情况下，我正在寻找一种可以在几秒钟内解决此问题的解决方案，因为它运行良好。

data$index <- lapply(split(data[,c(-1)],seq(nrow(data))),FUN = order, decreasing = TRUE)
rank <- 4
data$result <- lapply(1:nrow(data), function(row) data[row, data$test[[row]][rank]+1])

Answer 1

我更新了我的答案以提供三种解决方案；回想起来，fun2() 是最好的(最快、最健壮、易于理解)答案。

有各种 StackOverflow 帖子用于查找第 n 个最高值，例如 https://stackoverflow.com/a/2453619/547331 。这是实现该解决方案的函数

nth <- function(x, nth_largest) {
    n <- length(x) - (nth_largest - 1L)
    sort(x, partial=n)[n]
}

将此应用于 data.frame 的每个(数字)行

data$nth <- apply(data[,-1], 1, nth, nth_largest = 4)

我做了一个大数据集

for (i in 1:20) data = rbind(data, data)

然后做了一些基本的计时

> system.time(apply(head(data[,-1], 1000), 1, nth, 4))
   user  system elapsed
  0.012   0.000   0.012
> system.time(apply(head(data[,-1], 10000), 1, nth, 4))
   user  system elapsed
  0.150   0.005   0.155
> system.time(apply(head(data[,-1], 100000), 1, nth, 4))
   user  system elapsed
  1.274   0.005   1.279
> system.time(apply(head(data[,-1], 1000000), 1, nth, 4))
   user  system elapsed
 14.847   0.095  14.943

因此它与行数成线性比例(不足为奇...)，大约每百万行 15 秒。

为了比较，我把这个解决方案写成

fun0 <-
    function(df, nth_largest)
{
    n <- ncol(df) - (nth_largest - 1L)
    nth <- function(x)
        sort(x, partial=n)[n]
    apply(df, 1, nth)
}

用作fun0(data[,-1], 4)。

另一种策略是从数值数据创建矩阵

m <- as.matrix(data[,-1])

然后对整个矩阵进行排序，将值的行索引进行排序

o <- order(m)
i <- row(m)[o]

然后对于最大，次大，...值，将每行索引的最后一个值设置为NA；第 n 个最大值就是行索引的最后一次出现

for (iter in seq_len(nth_largest - 1L))
    i[!duplicated(i, fromLast = TRUE)] <- NA_integer_
idx <- !is.na(i) & !duplicated(i, fromLast = TRUE)

对应的值为m[o[idx]]，按行顺序放置

m[o[idx]][order(i[idx])]

因此另一种解决方案是

fun1 <-
    function(df, nth_largest)
{
    m <- as.matrix(df)
    o <- order(m)
    i <- row(m)[o]

    for (idx in seq_len(nth_largest - 1L))
        i[!duplicated(i, fromLast = TRUE)] <- NA_integer_
    idx <- !is.na(i) & !duplicated(i, fromLast = TRUE)

    m[o[idx]][order(i[idx])]
}

我们有

> system.time(res0 <- fun0(head(data[,-1], 1000000), 4))
   user  system elapsed 
 17.604   0.075  17.680 
> system.time(res1 <- fun1(head(data[,-1], 1000000), 4))
   user  system elapsed 
  3.036   0.393   3.429 
> identical(unname(res0), res1)
[1] TRUE

一般来说，当 nth_largest 不太大时，fun1() 似乎会更快。

对于fun2()，将原始数据先行后值排序，只保留相关索引

fun2 <-
    function(df, nth_largest)
{
    m <- as.matrix(df)
    o <- order(row(m), m)
    idx <- seq(ncol(m) - (nth_largest - 1), by = ncol(m), length.out = nrow(m))
    m[o[idx]]
}        

与

> system.time(res1 <- fun1(head(data[, -1], 1000000), 4))
   user  system elapsed 
  2.948   0.406   3.355 
> system.time(res2 <- fun2(head(data[, -1], 1000000), 4))
   user  system elapsed 
  0.316   0.062   0.379 
> identical(res1, res2)
[1] TRUE

在完整数据集上分析 fun2()

> dim(data)
[1] 6291456      13
> Rprof(); res2 <- fun2(data[, -1], 4); Rprof(NULL); summaryRprof()
$by.self
              self.time self.pct total.time total.pct
"order"            1.50    63.56       1.84     77.97
"unlist"           0.36    15.25       0.36     15.25
"row"              0.34    14.41       0.34     14.41
"fun2"             0.10     4.24       2.36    100.00
"seq.default"      0.06     2.54       0.06      2.54
...

表明大部分时间花在了order()上；我不完全确定多个因素的 order() 是如何实现的，但它可能具有与基数排序相关的复杂性。无论如何，它都非常快!