Создать матрицу с записями, уникальными для строки и столбца R - PullRequest
0 голосов
/ 09 ноября 2018

Мне нужно найти все возможные 5x5 матрицы целых чисел 1-5, уникальных для каждой строки и столбца (представьте себе Судоку) в R.

Есть ли эффективный способ сделать это, не создавая все матрицы 120C5, а затем находя подходящие?

Спасибо!

1 Ответ

0 голосов
/ 09 ноября 2018

Как я уже говорил в моем комментарии выше, матрицы этого типа называются латинскими квадратами .

Для начала, мы уже знаем , что существует 56 так называемых сокращенных латинских квадратов и 161280 всех латинских квадратов размера 5. Сокращенные латинские квадраты таковы, что как первый столбец, так и первый ряд только 1, 2, 3, 4, 5 (в этом порядке). Учитывая эти уменьшенные латинские квадраты, можно легко (при условии, что размер не больше 5) генерировать все латинские квадраты: переставлять все строки, кроме первого, и переставлять все столбцы. Следовательно, как и ожидалось, 161280 = 5! * 4! * 56.

Ограничив первую строку и столбец, можно сгенерировать 4! * 3! * 2! = 288 матриц и проверить, какие 56 являются латинскими квадратами. Однако я собираюсь пропустить это и взять их список из здесь .

Сначала мы читаем и переставляем данные

reduced <- read.table("http://users.cecs.anu.edu.au/~bdm/data/reduced5.txt", head = FALSE, colClasses = "character")
reduced <- lapply(1:nrow(reduced), function(r) matrix(as.numeric(unlist(strsplit(unlist(reduced[r, ]), ""))) + 1, 5))
length(reduced)
# [1] 56

Теперь давайте сгенерируем все 5! и 4! перестановки 1, 2, 3, 4, 5 и 1, 2, 3, 4 соответственно.

library(combinat)
perms5 <- permn(1:5)
perms4 <- permn(1:4)

Наконец, мы проходим все сокращенные латинские квадраты и переставляем их всеми возможными способами

allLS <- sapply(reduced, function(m) {
  LS <- vector("list", gamma(6) * gamma(5))
  for(i in 1:gamma(5))
    for(j in 1:gamma(6))
      LS[[(i - 1) * gamma(6) + j]] <- m[perms4[[i]] + 1, perms5[[j]]]
  LS
})

Это займет всего пару секунд, и мы получим результат

length(allLS)
# [1] 161280

Легко убедиться, что они все разные

table(table(sapply(allLS, paste0, collapse = "")))
#      1 
# 161280 

и вы также можете проверить, все ли они латинские квадраты.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...