数独の平凡な解法(Mathematica)


数独の平凡な解法(C言語)という記事を書いたら、「わかりやすさを重視する時はC言語なのですか」と言われてしまったので、いつものようにMathematicaでも書いておきます。

canBePlaced[board_, {row_, col_}, b_, x_] := And[
  Not[MemberQ[board[[row]], x]]  ,
  Not[MemberQ[board[[All, col]], x]] ,
  With[{
    r = 1 + b Quotient[row, b, 1],
    c = 1 + b Quotient[col, b, 1]},
   Not[MemberQ[board[[r ;; r + b - 1, c ;; c + b - 1]], x, 2]]]]

check[board_] := With[{next = Position[board, 0]}, 
  If[Length@next == 0, Sow@TableForm@board, (* solution is found *)
   Map[If[canBePlaced[board, First@next, Sqrt@Length@board, #], 
      check[ReplacePart[board, First@next -> #]]] &, Range@Length@board]]]

実行例は以下の通り。(UMMでも動きます。)

Reap[check@{
   {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}}][[2]]

  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

数独で見るRuby(とMathematica)のパワーと表現力で紹介した方法のほうが、他の問題に転用しやすい汎用的なものだと思いますが、数独が解ければそれで十分という場合には、この方法のほうがわかりやすくていいでしょう。

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です