Boggle作弊......呃......用R中的图表解决
Boggle cheat... erm... solutioning with graphs in R
我看过其他一些与此游戏相关的帖子,但其中 none 以我选择的算法类型为中心,至少目前还没有太多细节。这也是我学习更多有关图形的借口(例如 igraph 包)。不用说,我不鼓励人们在任何情况下作弊。这真的是我为自己设定的一个学习挑战——通常是通过那些我最终学到最多的东西。
除了 French dictionary 的明显收集之外,我的计划还包括一些准备工作。
第一步是构建一个像这样的 igraph,说明 Boggle 字母之间允许的连接。 (对于那些不熟悉 Boggle 的人,您只能从直接相邻的字母创建单词,包括对角线。单词越长,奖励越大)。
下一步(可能不理想,但无法弄清楚如何直接从 igraph 包中实现)。无论如何,它是使用 gtools:
生成所有排列
permutations(n=16, r=3)
permutations(n=16, r=4)
然后使用 igraph::neigbourhood
函数对每个排列进行 "validate" 以查看它们在 Boggle 游戏中是否合法。从下面的数字我们可以看出,"sample" 越大(单词越长,如果你愿意的话),被拒绝的排列越多。因此,获得很少的附加信息需要大量的处理能力。显然不是最优的。当 r 超过 7 时,一切都会崩溃(我的 8 Gb Ram 仍然不够用!)
4 letter permutations - total : 43680
legit : 1764 (4.0%)
6 letter permutations - total : 5765760
legit : 22672 (0.4%)
and so forth
所以现在我想找到一种方法以更合理的方式生成这些排列(也许它们可以称为 "paths" 或 "trajectories"),也许可以使用诸如 igraph 之类的工具,这样我就不会因为玩得太开心而炸毁我的主板。使用图表对我来说是新的,所以它可能就在我面前,但我在文档中看不到 "generate all trajectories passing through N adjacent nodes on the graph" 或类似内容。也许它存在,但它被称为 "Some Guy's algorithm",不幸的是,我以前从未听说过他。
所有准备工作完成后,我对结果非常满意。它相当快且完全准确。我只是被7个字母的单词卡住了(5个惨点嘿嘿嘿)。如果有人感兴趣,我可能会在某个时候把它放在 GitHub 上。我认为对图表有足够了解的人应该能够为我指明正确的方向,这就是为什么我认为在这里进行任何编码都不会起到任何作用。
提前致谢!
(为了完整起见,一旦 "valid permutations" 被计算出来,我 运行 根据字典条目生成的单词并搁置匹配的单词。我正在使用 RSQLite 并使用增加长度的词块;以这种方式将事物分开使得代码很容易理解,也使得数据库搜索非常快。)
这是一个递归解决方案,可以找到长度不超过 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
我看过其他一些与此游戏相关的帖子,但其中 none 以我选择的算法类型为中心,至少目前还没有太多细节。这也是我学习更多有关图形的借口(例如 igraph 包)。不用说,我不鼓励人们在任何情况下作弊。这真的是我为自己设定的一个学习挑战——通常是通过那些我最终学到最多的东西。
除了 French dictionary 的明显收集之外,我的计划还包括一些准备工作。
第一步是构建一个像这样的 igraph,说明 Boggle 字母之间允许的连接。 (对于那些不熟悉 Boggle 的人,您只能从直接相邻的字母创建单词,包括对角线。单词越长,奖励越大)。
下一步(可能不理想,但无法弄清楚如何直接从 igraph 包中实现)。无论如何,它是使用 gtools:
生成所有排列permutations(n=16, r=3)
permutations(n=16, r=4)
然后使用 igraph::neigbourhood
函数对每个排列进行 "validate" 以查看它们在 Boggle 游戏中是否合法。从下面的数字我们可以看出,"sample" 越大(单词越长,如果你愿意的话),被拒绝的排列越多。因此,获得很少的附加信息需要大量的处理能力。显然不是最优的。当 r 超过 7 时,一切都会崩溃(我的 8 Gb Ram 仍然不够用!)
4 letter permutations - total : 43680
legit : 1764 (4.0%)
6 letter permutations - total : 5765760
legit : 22672 (0.4%)
and so forth
所以现在我想找到一种方法以更合理的方式生成这些排列(也许它们可以称为 "paths" 或 "trajectories"),也许可以使用诸如 igraph 之类的工具,这样我就不会因为玩得太开心而炸毁我的主板。使用图表对我来说是新的,所以它可能就在我面前,但我在文档中看不到 "generate all trajectories passing through N adjacent nodes on the graph" 或类似内容。也许它存在,但它被称为 "Some Guy's algorithm",不幸的是,我以前从未听说过他。
所有准备工作完成后,我对结果非常满意。它相当快且完全准确。我只是被7个字母的单词卡住了(5个惨点嘿嘿嘿)。如果有人感兴趣,我可能会在某个时候把它放在 GitHub 上。我认为对图表有足够了解的人应该能够为我指明正确的方向,这就是为什么我认为在这里进行任何编码都不会起到任何作用。
提前致谢!
(为了完整起见,一旦 "valid permutations" 被计算出来,我 运行 根据字典条目生成的单词并搁置匹配的单词。我正在使用 RSQLite 并使用增加长度的词块;以这种方式将事物分开使得代码很容易理解,也使得数据库搜索非常快。)
这是一个递归解决方案,可以找到长度不超过 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