Effectively retrieve the first TRUE row in the logical matrix in R

Given the following matrix:

         A     B    C
[1,]  TRUE FALSE TRUE
[2,] FALSE  TRUE TRUE
[3,] FALSE FALSE TRUE
[4,] FALSE  TRUE TRUE
[5,] FALSE  TRUE TRUE
[6,]  TRUE  TRUE TRUE

m <- structure(c(TRUE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, 
FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), .Dim = c(6L, 
3L), .Dimnames = list(NULL, c("A", "B", "C")))

How can we extract the first column with a true value for a row efficiently ? Of course, we could use applyper line and then get min(which(...)).

Here is the desired result:

[1] A B C B B A

This thread may seem like a duplicate of my question, but it doesn't exist:

  • Here we are talking about a logical matrix NOT a numerical data frame
  • Here we strive to obtain the position of the first TRUE, and not the highest value
+4
source share
4 answers

We can use max.col

colnames(m)[max.col(m, "first")]
#[1] "A" "B" "C" "B" "B" "A"

TRUE, NA ( )

colnames(m)[max.col(m, "first")*NA^!rowSums(m)]

ifelse

colnames(m)[ifelse(rowSums(m)==0, NA, max.col(m, "first"))]
+7

, which logical :

colnames(m)[aggregate(col~row, data=which(m, arr.ind = TRUE), FUN=min)$col]
#[1] "A" "B" "C" "B" "B" "A"

TRUE, () , , .

library(microbenchmark)
n <- matrix(FALSE, nrow=1000, ncol=500) # couldn't afford a bigger one...
n <- t(apply(n, 1, function(rg) {rg[sample(1:500, 1, replace=TRUE)] <- TRUE ; rg}))
colnames(n) <- paste0("name", 1:500)
akrun <- function(n){colnames(n)[max.col(n, "first")]}
cath <- function(n){colnames(n)[aggregate(col~row, data=which(n, arr.ind = TRUE), FUN=min)$col]}

all(akrun(n)==cath(n))
#[1] TRUE

microbenchmark(akrun(n), cath(n))
# expr       min        lq      mean    median        uq      max neval cld
#akrun(n)  6.985716  7.233116  8.231404  7.525513  8.842927 31.23469   100  a 
# cath(n) 18.416079 18.811473 19.586298 19.272398 20.262169 22.42786   100   b
+7

. , .

joe <-  function(x) {
    y <- which(x)
    nR <- nrow(x)
    myR <- y %% nR
    myR[myR==0] <- nR
    myNames <- colnames(x)[ceiling(y/nR)]
    myCols <- which(!(duplicated(myR)))
    myNames[myCols][order(myR[myCols])]
}

, , @Cath:

microbenchmark(akrun(n), cath(n), joe(n))
Unit: microseconds
    expr       min        lq      mean    median        uq       max neval
akrun(n)  4248.760  5588.8640  6148.1816  5926.7130  6378.887 12502.437   100
 cath(n) 12641.189 13733.1415 14808.6524 14532.8115 15559.287 20628.037   100
  joe(n)   555.418   642.2405   758.5293   713.2585   800.697  4849.334   100

all.equal(akrun(n), cath(n), joe(n))
[1] TRUE
+3
source

Here is another way that has better wrt performance @Cath Solutions:

a <- which(m, arr.ind = T)
colnames(m)[aggregate(col~row,a[order(a[,1]),],min)$col]

# [1] "A" "B" "C" "B" "B" "A"

Benchmarking based on the matrix used by @Cath:

m0h3n <- function(m){
   a <- which(m, arr.ind = T)
   colnames(m)[aggregate(col~row,a[order(a[,1]),],min)$col]
}

all.equal(akrun(n), cath(n), joe(n), m0h3n(n))
# [1] TRUE

microbenchmark(akrun(n), cath(n), joe(n), m0h3n(n))

# Unit: microseconds
     # expr      min       lq      mean    median        uq       max neval
 # akrun(n) 2291.981 2395.793 2871.7156 2482.7790 3561.9150  4205.370   100
  # cath(n) 8263.210 8554.665 9695.9375 8782.8710 9947.9415 58239.983   100
   # joe(n)  274.029  298.517  526.6722  312.0375  342.5355  2366.798   100
 # m0h3n(n) 3890.178 3974.309 4280.6677 4073.1635 4227.7550  6337.501   100

So, here are the ranked solutions (in terms of efficiency):

  • Joe
  • akrun
  • m0h3n
  • Cath
+2
source

Source: https://habr.com/ru/post/1654126/


All Articles