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

Question

我有一个逻辑矩阵，我想找出全部为 TRUE 的最大行数和列数。也就是说，我希望对于最多的列数，每行的 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 行和 3 列 - 所有给出总共 6 个 TRUE。

我怎样才能解决这个问题，以便它可以扩展到更大的矩阵？

我认为我没有很好地传达这个问题 - 但也想不出如何更好地表达它，所以请寻求澄清。

Answer 1

这是您要找的吗？请检查并告诉我:)

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)