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

R 从行中选择第i个最高值并分配给新列的最快方法,r,R,我正在寻找一种解决方案,向现有的dataframe/datatable添加一个新列,该列是每行中第I个最高值。例如,如果我想要第四高的值,新列的第一行将包含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),

我正在寻找一种解决方案,向现有的dataframe/datatable添加一个新列,该列是每行中第I个最高值。例如,如果我想要第四高的值,新列的第一行将包含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))

data我更新了答案,提供了三种解决方案
fun2()
在retrospect中是最好(最快、最健壮、易于理解)的答案

有各种StackOverflow POST用于查找第n个最高值,例如。下面是实现该解决方案的函数

nth <- function(x, nth_largest) {
    n <- length(x) - (nth_largest - 1L)
    sort(x, partial=n)[n]
}
然后做了一些基本的计时

> 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)
}
然后对整个矩阵进行排序,将值的行索引按顺序排列

o <- order(m)
i <- row(m)[o]
因此,另一种解决方案是

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


显示大部分时间都花在订单()上。
;我不完全确定如何在多个因素上实现
order()
,但它可能具有与基数排序相关的复杂性。不管是什么情况,都很快

fwiw,
fun2
比在每行上使用
Rfast::nth
更快。我可以假定复杂性是以基数排序的O(wn)为界的吗?@chinsoon12我为
fun2()
添加了一些分析信息,并更改了我的答案,这样我就不会对复杂性做出明确的陈述。
m[顺序(行(m),m)]
实际上是一种在没有任何外部包的情况下对矩阵的每一行进行排序的难以置信的快速方法。您能允许我将此解决方案发布到中,然后将其引用回此处吗?@chinsoon12当然!看到这是多么的灵活,真是太不可思议了;我想行排序需要
matrix(m[order(row(m),m)],nrow(m),byrow=TRUE)
,但列排序只需要
m[]=m[order(col(m),m)]
fun0 <-
    function(df, nth_largest)
{
    n <- ncol(df) - (nth_largest - 1L)
    nth <- function(x)
        sort(x, partial=n)[n]
    apply(df, 1, nth)
}
m <- as.matrix(data[,-1])
o <- order(m)
i <- row(m)[o]
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]][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
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
> 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
...