难以置信的欺骗。。。嗯。。。R中图的求解

难以置信的欺骗。。。嗯。。。R中图的求解,r,graph,permutation,igraph,adjacency-matrix,R,Graph,Permutation,Igraph,Adjacency Matrix,我看过其他一些关于这个游戏的帖子,但是没有一篇是关于我选择的算法类型的,至少没有太多细节。这也是我学习更多关于图形(例如使用包)的借口。不用说,我不鼓励人们在任何情况下作弊。这确实是我为自己设定的一个学习挑战——通常是通过那些我最终学到最多的东西 我的计划包括一些准备工作,除了明显的收集资料 第一个大步骤是构建一个类似这样的igraph,说明Boggle字母之间允许的连接。(对于不熟悉Boggle的人,你只能从直接相邻的字母(包括对角线)中创建单词。单词越长,奖励越大) 下一步(可能不太理想,

我看过其他一些关于这个游戏的帖子,但是没有一篇是关于我选择的算法类型的,至少没有太多细节。这也是我学习更多关于图形(例如使用包)的借口。不用说,我不鼓励人们在任何情况下作弊。这确实是我为自己设定的一个学习挑战——通常是通过那些我最终学到最多的东西

我的计划包括一些准备工作,除了明显的收集资料

第一个大步骤是构建一个类似这样的igraph,说明Boggle字母之间允许的连接。(对于不熟悉Boggle的人,你只能从直接相邻的字母(包括对角线)中创建单词。单词越长,奖励越大)

下一步(可能不太理想,但无法直接从igraph包中找到实现方法)。无论如何,它是使用以下方法生成所有排列:

置换(n=16,r=3)
置换(n=16,r=4)

然后使用
igraph::neigbourhood
函数“验证”每一个排列,看看它们是否在Boggle游戏中合法。我们从下面的数字中看到,“样本”越大(如果您愿意,单词越长),拒绝的排列就越多。因此,获得很少的额外信息需要很大的处理能力。显然不是最优的。当r达到7以上时,所有的麻烦都消失了(我的8GB内存仍然不够!)

因此,现在我想找到一种方法,以一种更感性的方式生成这些排列(也许它们可以被称为“路径”或“轨迹”),也许可以使用诸如igraph之类的工具,这样我就不会因为玩得太开心而炒我的主板了。处理图形对我来说是一件新鲜事,所以它可能就在我面前,但我在文档中看不到“生成通过图形上N个相邻节点的所有轨迹”或类似的内容。也许它存在,但它被称为“某个家伙的算法”,不幸的是,我以前从未听说过这个家伙

当所有的准备工作完成后,我对结果非常满意。它相当快而且完全准确。我只是被7个字母的单词困住了(可怜的5分呵呵)。如果ppl感兴趣的话,我可能会把它放到GitHub上。我认为,对图形有足够了解的人应该能够为我指出正确的方向,这就是为什么我认为在长度上进行任何编码都不会起到任何作用

提前谢谢


(为了完整性起见,一旦计算出“有效排列”,我就根据字典条目运行结果词,并将匹配的词放在一边。我使用RSQLite,处理长度不断增加的词块;以这种方式使代码非常容易理解,也使数据库搜索非常快。)

这里有一个递归解决方案,它可以找到长度小于等于
L的所有路径

使用由此创建的图形:

总排列

> sum(sapply(path.list, nrow))
[1] 12029540

我想你可以用递归来解决这个问题:你能发布你用来创建igraph的代码吗?我认为一个简单的解决方案是使用
igraph::neights
递归地向向量追加数字,直到达到某个长度。然后,结果向量的每个子集将是较小的
r
的路径。Welp,对于任何想尝试解决方案的人来说,下面是创建boggle网络的代码:为了创建igraph,我使用
graph.lattice
作为基础,然后使用
get.adjacy
提取邻接矩阵,并手动将对角线添加到后者,并使用
graph.adjacence
从修改后的邻接矩阵构建最终的igraph。我相信有一些更好的方法可以做到这一点,但无论如何它都是有效的!工作起来很有魅力!谢谢把我算在那些有兴趣在github上看到你的项目的人当中!嗯,函数似乎没有检测到某些排列;在一两天内查看github页面以查看更新。我的答案的子集部分似乎删除了一些排列。。。我不会使用解决方案的那一部分。我更新了我的帖子,对每条L长度的路径进行了彻底的计数。12029540的数字也在互联网上浮动。Quora上的人也计算了所有的组合,包括1-2个字母路径,我也可以匹配这个数字。我认为解决方案是可行的,只需忽略子集快捷方式。
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
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
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)))
}
> 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