在R中有效地提取逻辑矩阵中每行的第一个TRUE

Question

给定以下矩阵:

         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")))

我们如何有效地提取每行具有TRUE值的第一列?当然，我们可以用每行apply然后得到min(which(...))。

下面是期望的输出:

[1] A B C B B A

这个帖子似乎是我的问题的重复，但它不是:

1. 这里我们讨论的是逻辑矩阵而不是数字数据帧
2. 这里我们寻求获得第一个TRUE的位置，而不是最大值

Answer 1

我们可以使用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"))]

Answer 2

另一个愿景，使用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

Answer 3

这是我的尝试。这不是一行字，但它是闪电般的快。

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

Answer 4

这是另一种具有更好性能的方法。

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

给出@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

因此，以下是按效率排序的解决方案:

乔
2. akrun
3. m0h3n
4. 导管