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

时间:2019-02-06 12:08:16

标签: r subset

我有一个逻辑矩阵,我想找出全部为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。

我如何解决这个问题,以便可以扩展到更大的矩阵?

我认为我对这个问题的沟通不太好-但也无法弄清楚如何更好地表达它,因此请澄清。

1 个答案:

答案 0 :(得分:2)

这是您要找的东西吗?请检查并让我知道:)

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)