Решение Boggle Cheat erm с графиками в R

Я видел несколько других постов, касающихся этой игры, но ни один из них не был сосредоточен на типе алгоритма, который я выбрал, по крайней мере, пока не в подробностях. Это также предлог для меня, чтобы узнать больше о графах (например, с igraph пакет). Излишне говорить, что я не призываю людей обманывать в любой ситуации. Это действительно трудная задача, которую я ставлю перед собой — часто именно благодаря этим вещам я больше всего узнаю в конце.

Мой план включает в себя некоторую подготовительную работу помимо очевидного набора французского словаря.

Первым большим шагом было создание igraph, который выглядит следующим образом, иллюстрируя допустимые связи между буквами Boggle. (Для тех, кто не знаком с Boggle, вы можете создавать слова только из непосредственно соседних букв, в том числе по диагонали. И чем длиннее слова, тем больше награды).

igraph, построенный из graph.lattice, добавление диагоналей вручную

Следующий шаг (который может быть не идеальным, но я не мог понять, как добиться этого непосредственно из пакета igraph). В любом случае, нужно было сгенерировать все перестановки с помощью gtools:

permutations(n=16, r=3) permutations(n=16, r=4)

а затем использовать функцию igraph::neigbourhood для "проверки" каждой отдельной перестановки, чтобы увидеть, будут ли они законными в игре Boggle. Из приведенных ниже цифр видно, что чем больше «выборка» (чем длиннее слова, если хотите), тем больше перестановок отвергается. Таким образом, требуется много вычислительной мощности, чтобы получить очень мало дополнительной информации. Явно не оптимально. И когда r становится выше 7, начинается ад (моих 8 Гб ОЗУ все еще мало!)

4 letter permutations - total : 43680 
                        legit : 1764 (4.0%)
6 letter permutations - total : 5765760 
                        legit : 22672 (0.4%) 
and so forth

Так что теперь я хотел бы найти способ генерировать эти перестановки более разумным способом (возможно, их можно было бы назвать «путями» или «траекториями»), возможно, с помощью такого инструмента, как igraph, чтобы я не поджарил свои материнская плата для того, чтобы иметь слишком много удовольствия. Работа с графами для меня в новинку, поэтому она может стоять прямо у меня перед носом, но я не вижу ничего вроде «сгенерировать все траектории, проходящие через N соседних узлов на графе» или что-то подобное в Документах. Может быть, он и существует, но он называется «Алгоритм какого-то парня», парень, о котором я, к сожалению, никогда раньше не слышал.

Я очень доволен результатами, когда вся подготовительная работа завершена. Это достаточно быстро и абсолютно точно. Я просто застрял со словами из 7 букв (5 жалких баллов, хе-хе-хе). Я мог бы разместить его на GitHub в какой-то момент, если люди заинтересованы. Я думаю, что люди, которые достаточно разбираются в графиках, должны быть в состоянии указать мне правильное направление, поэтому я не думаю, что какое-либо кодирование длин будет служить здесь какой-либо цели.

Заранее спасибо!

(Для полноты картины, после того как вычислены «допустимые перестановки», я сравниваю получившиеся слова со словарными записями и откладываю те, которые соответствуют. Я использую RSQLite и работаю с фрагментами слов возрастающей длины; разделяю вещи. таким образом делает код довольно простым для понимания, а также делает поиск в базе данных довольно быстрым.)


person Dominic Comtois    schedule 19.02.2015    source источник
comment
Я думаю, вы можете решить эту проблему с помощью рекурсии: cs.bu.edu/teaching/alg/ лабиринт   -  person Zelazny7    schedule 19.02.2015
comment
Можете ли вы опубликовать код, который вы использовали для создания igraph? Я думаю, что простым решением было бы использовать igraph::neighbors для рекурсивного добавления чисел к вектору до тех пор, пока не будет достигнута определенная длина. Тогда каждое подмножество результирующих векторов будет путями для меньших r.   -  person Zelazny7    schedule 19.02.2015
comment
Хорошо, для всех, кто хочет попробовать решение, вот код, который создает сеть boggle: gist.github .com/Zelazny7/fd396b5cb0fed713048c   -  person Zelazny7    schedule 19.02.2015
comment
Чтобы создать igraph, я использовал graph.lattice в качестве основы, затем извлек матрицу смежности с помощью get.adjacency и вручную добавил диагонали к последней, а затем использовал graph.adjacency для построения окончательного igraph из измененной матрицы смежности. Я уверен, что есть несколько лучших способов сделать это, но это все равно работает!   -  person Dominic Comtois    schedule 20.02.2015


Ответы (1)


Вот рекурсивное решение, которое находит все пути до длины L.

Используя график, созданный этим Gist:

getPaths <- function(v, g, L = 4) {
  paths <- list()
  recurse <- function(g, v, path = NULL) {
    path <- c(v, path)

    if (length(path) >= L) {
      return(NULL)
    } else {    
      for (i in neighbors(g, v)) {
        if (!(i %in% path)) {
          paths[[length(paths) + 1]] <<- c(i, path)
          recurse(g, i, path)
        }
      }
    }
  }
  recurse(g, v)
  return(paths)
}

allPaths <- lapply(V(g), getPaths, g)

# look at the first few paths from vertex 1:
> head(allPaths[[1]])
[[1]]
[1] 2 1

[[2]]
[1] 3 2 1

[[3]]
[1] 4 3 2 1

[[4]]
[1] 6 3 2 1

[[5]]
[1] 7 3 2 1

[[6]]
[1] 8 3 2 1

Изменить

Вот более эффективное решение, которое сохраняет только пути L-длины.

getPaths <- function(v, g, L = 4) {
  paths <- list()

  recurse <- function(g, v, path = NULL) {
    path <- c(v, path)

    if (length(path) >= L) {
      paths[[length(paths) + 1]] <<- rev(path)      
    } else {    
      for (i in neighbors(g, v)) {
        if (!(i %in% path)) recurse(g, i, path)
      }
    }
  }
  recurse(g, v)
  return(paths)
}

allPaths <- lapply(V(g), getPaths, g, 4)

L4way <- do.call(rbind, lapply(allPaths, function(x) do.call(rbind, x)))

> head(L4way)
     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4
[2,]    1    2    3    6
[3,]    1    2    3    7
[4,]    1    2    3    8
[5,]    1    2    5    6
[6,]    1    2    5    9

Редактировать № 2:

library(doSNOW)
library(foreach)

# this is a very parallel problem and can be parallel-ized easily
cl <- makeCluster(4)
registerDoSNOW(cl)

allPaths <- foreach(i = 3:16) %:%
  foreach(v = V(g), .packages = c('igraph')) %dopar% getPaths(v, g, i)

stopCluster(cl)

path.list <- list()
for (i in seq_along(3:16)) {
  path.list[[i]] <- do.call(rbind, lapply(allPaths[[i]],
      function(x) do.call(rbind, x)))
}

Количество перестановок для слов длины L:

> data.frame(length=3:16, nPerms=sapply(path.list, nrow))
   length  nPerms
1       3     408
2       4    1764
3       5    6712
4       6   22672
5       7   68272
6       8  183472
7       9  436984
8      10  905776
9      11 1594648
10     12 2310264
11     13 2644520
12     14 2250192
13     15 1260672
14     16  343184

Всего перестановок

> sum(sapply(path.list, nrow))
[1] 12029540
person Zelazny7    schedule 19.02.2015
comment
Работает как шарм! Спасибо!! - person Dominic Comtois; 20.02.2015
comment
Считайте меня среди тех, кто хочет увидеть ваш проект на github! - person Zelazny7; 20.02.2015
comment
хм, кажется, некоторые перестановки не были обнаружены функцией; работая над этим, посмотрите страницу github через день или два, чтобы увидеть обновления. - person Dominic Comtois; 25.02.2015
comment
Часть подмножества моего ответа, кажется, отбрасывает некоторые перестановки... Я бы не стал использовать эту часть решения. Я обновил свой пост с подсчетом каждого пути L-длины. - person Zelazny7; 25.02.2015
comment
Число 12 029 540 также распространяется в Интернете. Кто-то на Quora также вычислил ВСЕ комбинации, включая пути из 1-2 букв, и я тоже могу сопоставить это число. Я думаю, что решение работает, просто игнорируйте ярлык поднастройки. - person Zelazny7; 25.02.2015
comment
Хороший улов! Мне нужно повнимательнее взглянуть на те пакеты, которые вы используете :) - person Dominic Comtois; 25.02.2015
comment
Привет, прошло много времени с тех пор, как этот ответ был опубликован. Но сработало ли это для неполностью связного графа? Например, чтобы получить все возможные пути от всех узлов с максимальной длиной пути 5. - person Christophe D.; 13.06.2017