12

Mathematica辞書から3文字すべての単語を選択するとします。 

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

そして私は次のような完全なスクラブルのようなセットを作りたいです： 

A B E
R A Y
E R E

単語を水平方向と垂直方向に読むことができる場所。

明らかに、セットは再帰とバックトラックで見つけることができます。だが：

1）パターンを使用してそれを解決する方法はありますか？
2）有効な解決策はどの次元にありますか？

編集

DictionaryLookup[]可変長レコードの妥当なサイズのデータ​​ベースであるという理由だけで、質問を書きました。私の本当の問題は、辞書の検索ではなく、特定の種類の織機パターンに関連しています。

4

2 に答える 2

11

次のアプローチパターンベースを検討するかどうかはわかりませんが、機能し、多くの次元に拡張できると考えられますが、all3データセットを使用すると、おそらくかなり早い段階で解決されます...

アイデアは、空白のクロスワードから始めることです。

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

次に、次の手順を再帰的に実行します。特定のパターンについて、行を順番に確認し、（1つだけ入力して入力した後）一致数が最も少ない行のパターンを展開します。 

(* 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以上のサイズのワードリスト付き...

于 2011-02-03T02:28:22.817 に答える
8

別のアプローチはSatisfiabilityInstances、すべての行とすべての列が有効な単語でなければならないことを指定する制約を使用することです。以下のコードは、200個の3文字の単語の辞書を使用して最初の5つのソリューションを取得するのに40秒かかります。このようなクロスワードの数を取得するには、にSatisfiabilityInstances置き換えることができます。SatisfiabilityCount

setupCrossword[wordStrings_] := (
   m = Length[chars];

   words = Characters /@ wordStrings;
   chars = Union@Flatten@words;

   wordMatch[vars_, word_] := And @@ (Thread[{vars, word}]);
   validWord[vars_] := Or @@ (wordMatch[vars, #] & /@ words);
   validCell[{i_, j_}] := 
    BooleanCountingFunction[{1}, {{i, j}, #} & /@ chars];

   row[i_] := {i, #} & /@ Range[n];
   col[i_] := {#, i} & /@ Range[n];
   cells = Flatten[row /@ Range[n], 1];

   rowCons = validWord[row[#]] & /@ Range[n];
   colCons = validWord[col[#]] & /@ Range[n];
   cellCons = validCell /@ cells;
   formula = And @@ (Join[rowCons, colCons, cellCons]);
   vars = 
    Table[{{i, j}, c}, {i, 1, n}, {j, 1, n}, {c, chars}] // 
     Flatten[#, 2] &;
   decodeInstance[instance_] := (
     choices = Extract[vars, Position[instance, True]];
     grid = Table[{i, j}, {i, 1, n}, {j, 1, n}] /. Rule @@@ choices
     )
   );

n = 3;
wordLimit = 200;
wordStrings = 
  Select[DictionaryLookup[], 
   StringLength[#] == n && LowerCaseQ[#] &];
setupCrossword[wordStrings[[;; wordLimit]]];

vals = SatisfiabilityInstances[formula, vars, 5];
Framed@TableForm@decodeInstance@# & /@ vals


（出典：yaroslavvb.com）

このアプローチ{{i,j},"c"}では、セル{i,j}が文字「c」を取得することを示すなどの変数を使用します。各セルはBooleanCountingFunction、有効な単語を作成するために、すべての行と列が制約された1文字だけを取得するように制約されています。たとえば、最初の行が「ace」または「bar」のいずれかでなければならないという制約は、次のようになります。

{{1,1},"a"}&&{{1,2},"c"}&&{{1,3},"e"}||{{1,1},"b"}&&{{1,2},"a"}&&{{1,3},"r"}
于 2011-02-01T22:41:44.873 に答える