Suppose I have a list of matrices:
$`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
Code to create the matrices:
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
I want to keep the two highest values in each row, and replace the remaining smaller values of the other cells in the same row with 0's.
If there are more than two cells that have the highest value, I want to leave all those cells as they are (for example: 10 10 10 0-> 10 10 10 0, 5 1 9 5 -> 5 0 9 5). All the other cells of the row should be set to 0 again.
The results should look like this:
$`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
I'm not sure how to approach this problem, so any help is highly welcome!
Here's one approach:
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
This works by iterating over elements of the list (with lapply
), treating each in turn as the object x
, and then iterating over the rows of that x
(with apply(x, 1, ...)
) calling the row y
and applying a function to it.
The function applied to the row y
of list element x
is:
function(y) {
y[y < tail(sort(y), 2)] <- 0
y
}
which identifies the two highest-valued elements of the row (tail(sort(y), 2)
), returns a logical vector indicating which of the elements of y
are not in that set (with y < ...
), subsets the elements of the vector y
with that logical vector, and assigns 0
to these elements. Finally, it returns the modified y
.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With