Максимизировать столбцы и строки из двоичной матрицы - PullRequest
Новая
       12

Максимизировать столбцы и строки из двоичной матрицы

0 голосов
/ 06 февраля 2019

У меня есть логическая матрица, и я хочу найти максимальное количество строк и столбцов, которые являются ИСТИННЫМИ.То есть я хочу иметь наибольшее количество ИСТИНА на строку для наибольшего количества столбцов.

Вот некоторые примеры данных 

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 ИСТИНА.

Как я могу понять это, чтобы она могла масштабироваться до гораздо большей матрицы?

Не думаю, что я очень хорошо передаю эту проблему - но также не могу понять, какчтобы сформулировать это лучше, поэтому, пожалуйста, попросите разъяснений.

1 Ответ

0 голосов
/ 06 февраля 2019

Это то, что вы ищете?Пожалуйста, проверьте и дайте мне знать:) 

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