布尔矩阵中所需的最小行数，使得生成的子矩阵每列至少有一个“1”？

Question

背景

假设，在布尔矩阵

m

中，我们有

1

随机分布在每一行中，例如，

> set.seed(1)

> (m <- matrix(+(runif(30) > 0.6), 6))
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    1    1    0    0
[2,]    0    1    0    1    0
[3,]    0    1    1    1    0
[4,]    1    0    0    0    0
[5,]    0    0    1    1    1
[6,]    1    0    1    0    0

问题

通过上面的例子，我有两个问题：

1. 如何高效计算最小行数，使得生成的子矩阵每列至少有一个

   1

   ？
2. 如何高效地枚举所有这些子矩阵的行？

我的尝试

我想到的第一个方法是使用

combn

，我尝试的一个强力示例是

f <- function(m) {
    n <- nrow(m)
    for (k in 1:n) {
        u <- combn(n, k, \(...) list(
            flag = all(colSums(m[..., , drop = FALSE]) > 0),
            idx = c(...)
        ), simplify = FALSE)
        lst <- Filter(\(x) x$flag, u)
        if (length(lst) > 0) {
            return(
                list(
                    minReqNrOfRows = k,
                    allCombos = lapply(lst, `[[`, "idx")
                )
            )
        }
    }
}

我们可以看到，我们至少需要

3

行（例如，子矩阵

m[c(1,4,5),]

每列至少有一个

1

）并且总共有

6

这样的行元组

> f(m)
$minReqNrOfRows
[1] 3

$allCombos
$allCombos[[1]]
[1] 1 4 5

$allCombos[[2]]
[1] 1 5 6

$allCombos[[3]]
[1] 2 4 5

$allCombos[[4]]
[1] 2 5 6

$allCombos[[5]]
[1] 3 4 5

$allCombos[[6]]
[1] 3 5 6

任何先进的算法来提高性能

我必须承认，在找到所需的最小行数之前，当矩阵中有大量行时，

combn

的计算量很大。

我在想：是否有更高级的算法可以避免遍历所有可能的行组合？可能是动态规划或回溯，但我需要一些提示。非常感谢提前！

Answer 1

我认为如果我们首先使用

CVXR

来解决所需的最小行数，即

k

，然后从所有

k

元组中找出所需的输出，BUT，可能会更快，事实证明这种方法慢很多！！！

library(CVXR)

f1 <- function(m) {
    n <- nrow(m)
    for (k in 1:n) {
        u <- combn(n, k, \(...) list(
            flag = all(colSums(m[..., , drop = FALSE]) > 0),
            idx = c(...)
        ), simplify = FALSE)
        lst <- Filter(\(x) x$flag, u)
        if (length(lst) > 0) {
            return(
                list(
                    minReqNrOfRows = k,
                    allCombos = lapply(lst, `[[`, "idx")
                )
            )
        }
    }
}


f2 <- function(m) {
    n <- nrow(m)
    # use igraph to solve the minimal required nubmer of rows
    x <- Variable(1, n, boolean = TRUE)
    obj <- Minimize(sum_entries(x))
    constr <- list(sum_entries(x %*% m, axis = 2) >= 1)
    prob <- Problem(obj, constr)
    res <- solve(prob)
    k <- round(res$value)

    # filter the results from all k-tupbles
    u <- combn(n, k, \(...) list(
        flag = all(colSums(m[..., , drop = FALSE]) > 0),
        idx = c(...)
    ), simplify = FALSE)
    list(
        minReqNrOfRows = k,
        allCombos = lapply(Filter(\(x) x$flag, u), `[[`, "idx")
    )
}

基准测试

microbenchmark(
    f1 = f1(m),
    f2 = f2(m),
    check = "equal"
)

表演

Unit: microseconds
 expr     min       lq      mean   median      uq      max neval
   f1   236.9   270.10   340.195   289.70   377.9    806.2   100
   f2 58399.4 66965.85 81720.124 73988.95 88971.2 203266.3   100