保持矩阵列表中每行的2个最高值

Question

假设我有一个矩阵列表:

$`2010`
   1  2  3 4
1  0  3  5 6
2  5  1  9 5
3  0  0  0 0
4 10 10 10 0

$`2011`
  1 2 3 4
1 0 2 3 6
2 5 0 3 1
3 2 4 0 1
4 2 1 2 1

创建矩阵的代码:

cntry<-c(1,2,3,4)
a<-c(0,5,0,10)
b<-c(3,1,0,10)
c<-c(5,9,0,10)
d<-c(6,5,0,0)
k<-data.frame(a,b,c,d)
k<-as.matrix(k)
dimnames(k)<-list(cntry,cntry)

e<-c(0,5,2,2)
f<-c(2,0,4,1)
g<-c(3,3,0,2)
h<-c(6,1,1,1)
l<-data.frame(e,f,g,h)
l<-as.matrix(l)
dimnames(l)<-list(cntry,cntry)

list<-list(k,l)
names(list)<-2010:2011

我希望在每一行中保留两个最高值,并将同一行中其他单元格的剩余较小值替换为0.

如果有两个以上的单元格具有最高值,我希望保留所有这些单元格(例如:10 10 10 0-> 10 10 10 0,5 1 9 5 - > 5 0 9 5).该行的所有其他单元格应再次设置为0.

结果应如下所示:

$`2010`
   1  2  3 4
1  0  0  5 6
2  5  0  9 5
3  0  0  0 0
4 10 10 10 0

$`2011`
  1 2 3 4
1 0 0 3 6
2 5 0 3 0
3 2 4 0 0
4 2 0 2 0

我不确定如何处理这个问题,所以非常欢迎任何帮助!

Answer 1

这是一种方法：

lapply(list, function(x) {
  t(apply(x, 1, function(y) {
    y[!y %in% tail(sort(y), 2)] <- 0
    y
  }))
})

## $`2010`
##    1  2  3 4
## 1  0  0  5 6
## 2  5  0  9 5
## 3  0  0  0 0
## 4 10 10 10 0
## 
## $`2011`
##   1 2 3 4
## 1 0 0 3 6
## 2 5 0 3 0
## 3 2 4 0 0
## 4 2 0 2 0

它的工作原理是迭代列表的元素 (with lapply)，依次将每个元素视为 object x，然后迭代该元素的行x(with apply(x, 1, ...)) 调用该行y并向其应用函数。

y应用于列表元素行的函数x是：

function(y) {
  y[y < tail(sort(y), 2)] <- 0
  y
}

它标识行 ( tail(sort(y), 2)) 的两个最高值元素，返回一个逻辑向量，指示 的 哪些元素y不在该集合中（带有y < ...），用该逻辑向量对向量的元素进行子集化y，然后分配0给这些元素。最后，它返回修改后的y.