在R中保持矩阵（或data.frame）中每行前2个值的最快方法

假设我有一个矩阵

M

，我只想保持这些矩阵中每行的2个最高值，其他值将设置为零

M <- rbind(c(0.1, 0.6, 0.2, 0.3, 0.7), c(0.8, 0.1, 0.7, 0.2, 0.4))

> M
     [,1] [,2] [,3] [,4] [,5]
[1,]  0.1  0.6  0.2  0.3  0.7
[2,]  0.8  0.1  0.7  0.2  0.4

我理解

apply（M，1，sort）

可以做到这一点，但是如果矩阵

M

很大，它会很慢，那么最快的方法是什么呢

---

谢谢。

我建议使用

data.table

，这需要一些重塑，但应该很快。如果你不必在最后做最后的整形步骤就可以脱身，那也应该可以节省一些时间

library(data.table)

dt <- as.data.table(M)

## define a 'grouping variable', which in this case is just the row number
## this lets us keep track of the row of the matrix
dt[, grp := .I]

## melt into long form
dt <- melt(dt, id.vars = "grp")

## order the data by the value, for each group, and select the top 2 rows
dt_max <- dt[ dt[ order(-value), .I[c(1,2)], by = .(grp)]$V1 ]

## set all the original values to 0
dt[, value := 0]

## then overwrite those 0s with the 'top 2' values in dt_max
dt[ dt_max, on = c("grp", "variable"), value := i.value]

as.matrix(dcast(dt, formula = grp ~ variable))
     grp  V1  V2  V3 V4  V5
[1,]   1 0.0 0.6 0.0  0 0.7
[2,]   2 0.8 0.0 0.7  0 0.0

库（data.table）
dt某些逻辑如@SYMBOLXAU，但使用基R函数：

tmp <- data.frame(row=c(row(M)), val=c(M), seq=seq_along(M))
tmp <- tmp[do.call(order,c(tmp[1:2],decreasing=TRUE)),]
M[tmp$seq] <- with(tmp, ave(val,row,FUN=function(x) replace(x, -(1:2), 0) ))
M

#     [,1] [,2] [,3] [,4] [,5]
#[1,]  0.0  0.6  0.0    0  0.7
#[2,]  0.8  0.0  0.7    0  0.0

tmp
然后将这些给定值分配给新分配的零数组中的给定索引。
使用
pmax的方法：

m <- M
x1 <- do.call(pmax, lapply(1:ncol(M), function(x) M[, x]))
m[m == x1]  <- NA
x2 <- do.call(pmax, c(lapply(1:ncol(M), function(x) m[, x]), na.rm = T))
M[M != x1 & M != x2] <- 0
M  

此外，如果给定行中存在最大两个数字的重复项，其他方法似乎会将重复项设置为零。
dt[，grp:=1.N]
可以用
dt[，grp:=.I]
@BioChemoinformatics来简化。然而，mine不是最快的解决方案。没有问题。你是第一个回答，速度相当快，相对容易理解@黄卫煌是迄今为止跑得最快的。通过使用新的基准测试，我将了解到，Weihuang的测试速度是您的7倍。这次我必须接受他的回答。Thank.sry的意思是：==mx1，也可以通过使用以下语法指定0来结束：M[1，-c（wh1，wh2）]=0，然后使用lappy对每一行执行操作。最好编辑您的答案，而不是将其作为commentbuildLocalMatrix@SymbolXau，我无法以良好的格式编辑它，但
buildLocalMatrix（）
是我现在使用的函数，基于
pmax（）
的思想，它是快速的。谢谢。卫煌最快的。谢谢。回答得很好，但是如果我现在想保留前7个值，那么这个值在执行时间上是如何伸缩的呢？另外，
do.call（pmax，data.frame（M））)
可能会简化代码，但在时间上几乎没有差异。对于Xau和LateMail：
matrixStats:：rowMaxs
是完成我的问题的好功能，速度比@Weihuang Wong快。谢谢
mx1 = max(M[1,])
wh1 = which(M[1,]==mx,arr.ind=TRUE)
mx2 = max(M[1,-wh1])
wh2 = which(M[1,-wh1]==mx2,arr.ind=TRUE)

m <- M
x1 <- do.call(pmax, lapply(1:ncol(M), function(x) M[, x]))
m[m == x1]  <- NA
x2 <- do.call(pmax, c(lapply(1:ncol(M), function(x) m[, x]), na.rm = T))
M[M != x1 & M != x2] <- 0
M  

set.seed(1234)
M <- matrix(floor(rnorm(1e7, 100, 10)), nc = 10)
f1 <- function(M) {
  m <- M
  x1 <- do.call(pmax, lapply(1:ncol(M), function(x) M[, x]))
  m[m == x1]  <- NA
  x2 <- do.call(pmax, c(lapply(1:ncol(M), function(x) m[, x]), na.rm = T))
  M[M != x1 & M != x2] <- 0
  M  
}

f2 <- function(M) {
  dt <- as.data.table(M)
  dt[, grp := 1:.N]
  dt <- melt(dt, id.vars = "grp")
  dt_max <- dt[ dt[ order(-value), .I[c(1,2)], by = .(grp)]$V1 ]
  dt[, value := 0]
  dt[ dt_max, on = c("grp", "variable"), value := i.value]
  as.matrix(dcast(dt, formula = grp ~ variable))  
}

f3 <- function(M) {
  tmp <- data.frame(row=c(row(M)), val=c(M), seq=seq_along(M))
  tmp <- tmp[do.call(order,c(tmp[1:2],decreasing=TRUE)),]
  M[tmp$seq] <- with(tmp, ave(val,row,FUN=function(x) replace(x, -(1:2), 0) ))
  M
}

microbenchmark::microbenchmark(
  f1 = { f1(M) }, 
  f2 = { f2(M) }, 
  f3 = { f3(M) },
  times = 10L)
# Unit: milliseconds
#  expr        min         lq      mean    median        uq       max neval cld
#    f1   926.9069   946.6892  1084.038  1009.497  1082.454  1476.972    10 a  
#    f2  6315.3971  6750.1864  7327.610  7237.323  7785.078  9198.780    10  b 
#    f3 13076.0617 13435.9920 15360.451 15118.323 16497.295 19792.398    10   c