pattern-matching - Mathematica 中使用模式匹配的填字游戏

Question

假设我从 Mathematica 字典中选择了所有 3 个字符词:

all3 = Characters /@ Select[DictionaryLookup[], StringLength[#] == 3 &];  

我想形成完整的拼字游戏集，例如:

A B E
R A Y
E R E  

可以水平和垂直阅读单词的地方。

显然，可以通过递归和回溯找到这些集合。但是:

1)有没有办法使用模式解决它？
2)对于哪些维度有有效的解决方案？

编辑

我为 DictionaryLookup[] 写了问题仅仅因为它是一个合理大小的可变长度记录数据库。我真正的问题与字典查找无关，而是与某种织机模式有关。

Answer 1

我不确定您是否会考虑基于以下方法模式 - 但它有效，并且可以想象它可以扩展到许多维度，尽管使用 all3数据集，它可能会很早就结束......

这个想法是从一个空白的填字游戏开始:

blankCW={{_,_,_},{_,_,_},{_,_,_}};

然后递归地执行以下操作:对于给定的模式，依次查看行，并(在填写任何一个完成后)扩展匹配数最少的行上的模式:

(* Cache the number of matches for a given pattern *)
nmatch[patt_]:=nmatch[Verbatim@patt]=Length@Cases[all3,patt]

(* A helper to fill single matches if needed *)
fixone[ml_,nl_]:=If[FreeQ[ml[[nl]],Verbatim[_]],ml, 
  ReplacePart[ml, nl->First@Cases[all3,ml[[nl]]]]];

findCompletions[m_]:=Module[{nn,ur},
  (* Pattern w/ filled single matches -> ur, ordering by # of matches -> nn *)
  {ur,nn}=NestWhile[{fixone[#[[1]],First@#[[2]]], Rest@#[[2]]}&,
    {m,Ordering[nmatch/@m]},
    (Length[#[[2]]]>0&&nmatch@#[[1,#[[2,1]]]]==1)&];

  (* Expand on the word with the fewest number og matches *)
  If[Length[nn]==0,{ur},
    With[{n=First@nn},ReplacePart[ur,n-> #]&/@Cases[all3,ur[[n]]]]]];

对于给定的候选模式，尝试沿两个维度完成并保留产生最少的那个:

findCompletionsOriented[m_]:=Module[{osc},
  osc=findCompletions/@Union[{m,Transpose@m}];
  osc[[First@Ordering[Length/@osc,1]]]]

我先做递归广度才能使用 Union，但深度优先对于更大的问题可能是必要的。性能一般:在示例问题中找到 116568 个匹配项需要 8 分钟的笔记本电脑时间:

Timing[crosswords=FixedPoint[Union[Join@@(findCompletionsOriented/@#)]&,{blankCW}];]
Length@crosswords
TableForm/@Take[crosswords,5]

Out[83]= {472.909,Null}
Out[84]= 116568
          aah aah aah aah aah
Out[86]={ ace ace ace ace ace }
          hem hen hep her hes

原则上，应该可以将其递归到更高的维度，即使用填字游戏列表而不是维度 3 的单词列表。如果将模式与列表匹配的时间在列表长度中是线性的，这将非常慢拥有 100000+ 大小的词表...