R 最大化二进制矩阵中的列和行

我有一个逻辑矩阵，我想找出所有为真的行和列的最大数量。也就是说，对于最多的列，我希望每行有最大数量的TRUE

下面是一些示例数据

a = c(T, T, T, T, T)
b = c(F, T, T, T, F)
c = c(F, F, T, T, F)
d = c(T, T, T, F, F)

x = matrix(c(a, b, c, d), nrow = 4, byrow = TRUE)

看起来是这样的：

> x
      [,1]  [,2] [,3]  [,4]  [,5]
[1,]  TRUE  TRUE TRUE  TRUE  TRUE
[2,] FALSE  TRUE TRUE  TRUE FALSE
[3,] FALSE FALSE TRUE  TRUE FALSE
[4,]  TRUE  TRUE TRUE FALSE FALSE

在本例中，有三种解决方案，这是一种可能性。 我可以保留

x[c（1,2,4），2:3]

，

x[1:3,3:4]

，和

x[1:2,2:3]

，其中两个给出了3行和2列，一个给出了2行和3列，总共给出了6个TRUE

我怎样才能弄明白这一点，使它能够扩展到更大的矩阵

---

我认为我没有很好地沟通这个问题，但也不知道如何更好地表达它，所以请要求澄清

这就是你要找的吗？请检查并让我知道：）

库（tidyverse）
图书馆（gtools）
找到完整的%
as_tible（）%>%
重命名所有（~str_replace（.x，'V，'r'））%>%
交叉点（。，
组合（ncol（mat），n_col）%>%
as_tible（）%>%
重命名所有（~str_replace（.x，'V，'c'））
) %>%
变异（rn=行数（））%>%
聚集（键，val，-rn）%>%
变异（key=key%>%str_remove（'\\d'））%>%
分组人（注册护士，钥匙）%>%
嵌套（）%>%
突变（数据=map_chr（数据，~str_c（.x$val，collapse='，'）））%>%
排列（键、数据）%>%
选择（-rn）%>%
变异（检查=pmap_lgl（，函数（…）{
r_ind=str_split（…2，pattern='，'）[[1]]%>%as.numeric（）
c_ind=str_split（…1，pattern='，'）[[1]]%>%as.numeric（）
mat[r_ind，c_ind]]>%sum（）==n_行*n列
})) %>%
过滤器（检查==真）%>%
选择（-check）%>%
将_重命名为（1:2，~c（'col_ind'，'row_ind'））
}
最大化%
as.data.frame（）
对于（i in 1:nrow（to_check））{
温度%nrow（）！=0）{
如果（i>1）{
if（to_check[i，3]==to_check[i-1，3]）{
最佳
x[1:2,2:4]
也给出了6.答案应该包括这样的情况？啊-是的，很好的地方。它也应该包括这个。我将进行编辑。我想知道你给出的矩阵的所有解都包括第1行和第3列，这是否只是巧合，它们都是
真的
？嗨，Pawel，这给出了正确的解，但是当我在我的更大的矩阵上运行它时，它非常慢。有什么想法可以加快速度吗？例如，如果你只对更多的真值感兴趣，你可以将
交叉（r=1:nrow（mat），c=1:ncol（mat））
更改为
交叉（r=4:nrow（mat），c=4:ncol（mat））
例如。或者从另一边开始可能会更有效……因为组合的数量较少。我必须仔细考虑。
library(tidyverse)
library(gtools)

find_complete <- function(mat, n_row, n_col) {

  combinations(nrow(mat), n_row) %>%
    as_tibble() %>%
    rename_all(~str_replace(.x, 'V', 'r')) %>%
    crossing(.,
      combinations(ncol(mat), n_col) %>%
        as_tibble() %>%
        rename_all(~str_replace(.x, 'V', 'c'))
    ) %>%
    mutate(rn = row_number()) %>%
    gather(key, val, -rn) %>%
    mutate(key = key %>% str_remove('\\d')) %>%
    group_by(rn, key) %>%
    nest() %>%
    mutate(data = map_chr(data, ~str_c(.x$val, collapse = ','))) %>%
    spread(key, data) %>%
    select(-rn) %>%
    mutate(check = pmap_lgl(., function(...) {
      r_ind = str_split(..2, pattern = ',')[[1]] %>% as.numeric()
      c_ind = str_split(..1, pattern = ',')[[1]] %>% as.numeric()
      mat[r_ind, c_ind] %>% sum() == n_row * n_col
    })) %>%
    filter(check == TRUE) %>%
    select(-check) %>%
    rename_at(1:2, ~c('col_ind', 'row_ind'))

}

maximise <- function(mat) {

  best <- NULL

  to_check <-
    crossing(
      r = 1:nrow(mat),
      c = 1:ncol(mat)
    ) %>%
    mutate(s = r * c) %>%
    arrange(s) %>%
    as.data.frame()

  for (i in 1:nrow(to_check)) {
    temp <- find_complete(mat, to_check[i, 1], to_check[i, 2])
    if (temp %>% nrow() != 0) {
      if (i > 1) {
        if (to_check[i, 3] == to_check[i-1, 3]) {
          best <- bind_rows(best, temp)
        } else {
          best <- temp
        }
      } 
    } else {
      return(best)
    }
  }

}

maximise(x)