プログラマの道具箱(深さ優先探索と幅優先探索) Mathematica編

参考:数独の平凡な解法(C言語Mathematica

「数独で見るRuby(とMathematica)のパワーと表現力」という記事で、『プログラミング言語Ruby』に載っている数独のコードには、Rubyのイメージをダウンさせる危険があるという話をしました。

ああいうことになってしまった原因は、与えられた問題に特化したコードを書こうとする姿勢にあると思われます。

問題を解くときには、その問題専用の道具をいきなり作ろうとするのではなく、まずは手持ちの道具の中から使えそうなものを探してみるといいでしょう。

今回の題材である数独には、簡単な探索ツールで十分です(これは、試してみてからわかることではありますが)。たいていのプログラマの道具箱には、深さ優先探索や幅優先探索のためのコードが入っているはずなので、それを使います。単純な探索ツールが道具箱に無い人は、Peter Norvigさん(Googleの研究本部長)の名著『実用 Common Lisp』の第6章(原著ではBuilding Software Tools)あたりから始めるといいかもしれません。

単純な探索というのは図のような探索木の探索です。木構造に並べた候補の中から解を探します。

探索木

木構造を探索する方法には、深さ優先探索と幅優先探索があります。これらの名前と図に示した候補を調べる順番を照らし合わせれば、探索がどのように行われるかは簡単にわかるでしょう。

探索木

実装には木構造は使いません。ノードの管理にスタックを使えば深さ優先探索に、キューを使えば幅優先探索になります。ちょっと横着して、(1)候補は前から取り出す、(2)新たな候補を、深さ優先なら前に、幅優先なら後ろに追加する、ということに決めてしまえば、いつもリストを使えばよくなります。

Mathematicaで実装すると次のようになります。

search[fringe_, combiner_, findAll_] :=
 If[fringe != {},
  With[{x = First@fringe},
   search[
    If[goal@x, report@x; If[findAll, Rest@fringe, {}],
     combiner[Rest@fringe, expand@x]],
    combiner, findAll]]]

goal[x_]:=解かどうかを判定する述語

report[x_]:=解を報告する手続き

expand[x_]:=探索木の子ノードのリスト(上図のAに対する{B,C}やBに対する{D,E,F}を返す関数)

ここで、fringeは解の候補を入れるリスト、combinerはリストに候補を追加するための関数、findAllは解をすべて見つけるかどうかを指示するboolean値です。

今、このような探索木のための道具が道具箱にあったとして、数独のためには次のような関数を用意しなければなりません。

goal[x_] := Not@MemberQ[x, 0, 2]

report[x_] := Sow[TableForm@x]

expand[x_] := With[{pos = First@Position[x, 0]}, 
  ReplacePart[x, pos -> #] & /@ candidates[x, pos]]

ここでcandidates[board_, {i_, j_}]は、boardのi行j列に入りうる数字のリストを作る関数です。

candidates[board_, {i_, j_}] := Complement[Range[1, 9],
  board[[i]],
  board[[Range[1, 9], j]],
  Flatten[Take[board, 3 Ceiling[i/3] - {2, 0}, 3 Ceiling[j/3] - {2, 0}]]]

準備が出来たら繰り返しの制限を緩和してから実行します(combinerをJoin[#2, #1] &にすれば深さ優先、Join[#1, #2] &にすれば幅優先探索になります)。

$IterationLimit = Infinity;

Reap@search[{ {
    {1, 0, 0, 0, 0, 7, 0, 9, 0},
    {0, 3, 0, 0, 2, 0, 0, 0, 8},
    {0, 0, 9, 6, 0, 0, 5, 0, 0},
    {0, 0, 5, 3, 0, 0, 9, 0, 0},
    {0, 1, 0, 0, 8, 0, 0, 0, 2},
    {6, 0, 0, 0, 0, 4, 0, 0, 0},
    {3, 0, 0, 0, 0, 0, 0, 1, 0},
    {0, 4, 0, 0, 0, 0, 0, 0, 7},
    {0, 0, 7, 0, 0, 0, 3, 0, 0}
   } }, Join[#2, #1] &, False]

{Null, {{1 6 2 8 5 7 4 9 3}}}
         5 3 4 1 2 9 6 7 8
         7 8 9 6 4 3 5 2 1
         4 7 5 3 1 2 9 8 6
         9 1 3 5 8 6 7 4 2
         6 2 8 7 9 4 1 3 5
         3 5 6 4 7 8 2 1 9
         2 4 1 9 3 5 8 6 7
         8 9 7 2 6 1 3 5 4

他の例:油売り算(Mathematica)

ここで紹介したのは一般的な方法ですが、深さ優先探索だけでいいなら、論理演算をつかってきれいに書けます。その方法は、「数独で見るRuby(とMathematica)のパワーと表現力」で紹介しました(HaskellPythonに移植されています)。木構造の一段下にある候補の論理和がそのノードの評価になるようにするのですが、Haskellは遅延評価なので、一つでも解が見つかればそこで評価が終了します。すべての解を求めたい場合には、そのための工夫をしなければなりません。Mathematicaは遅延評価ではないので、解が一つ見つかればいいという場合に工夫が必要です。

他の例:

参考:プログラマの道具箱(深さ優先探索と幅優先探索) C++編

2 thoughts on “プログラマの道具箱(深さ優先探索と幅優先探索) Mathematica編

  1. プログラミングRuby 第2版 言語編

    プログラミングRuby 第2版 言語編
    うーん。
    少々、わかりにくい(初心者みえで)けど、
    逆にこれがないとわ…

  2. すばらしいプログラムと思います。理解のため、4×4 のsudoku を解けるように改良し途中結果を出力して、計算過程を見るようにしました。プログラムの計算過程が手に取るように分かります。9×9 と4×4 は相似関係にあるので、4×4 で試しました。
    関数 candidates と自分が作った関数を比較して理解を深めました。
    Combinatorica に BackTrack 関数があります。この search 関数を参考に調べる手がかりができました。ありがとうございます。

コメントは停止中です。