Sudoku(数独) を Mathematicaで解く(14): 数独を解くMain(2)

目次へ

Main(2): NakedSingle とHiddenSingle の探索を繰り返す

前回に示したNotebookの構造に従い main(2) を追加します。

初期設定

ini = Module[{b}, {{b, 7, b,  b, b, b,  5, b, b},
                   {5, 3, 1,  b, b, b,  4, b, b},
                   {8, b, b,  6, 4, b,  b, b, b},     
                   {b, 2, b,  b, b, 4,  b, 3, 5},
                   {b, 1, b,  b, b, b,  b, 6, b},
                   {9, 4, b,  1, b, b,  b, 7, b},     
                   {b, b, b,  b, 2, 3,  b, b, 1},
                   {b, b, 3,  b, b, b,  8, 9, 2},
                   {b, b, 7,  b, b, b,  b, 4, b}} /. b -> Null];      
     Show[Rasterize[plotGame[ini]], ImageSize -> 250]

main(2) プログラム

  • 各ステップごとの答えと行列をsolSeq, matSeq に記録している。
  • 終了条件は行列の中にブランクが無いことです。While文の条件に使っている。
  • Which文のなかでNakedSingle,HiddenSingleを探し判断している。
  • 条件に合わない場合には、Break文でWhile文から抜け出すようにしている。
(* begin: Initialization  *)
  solSeq = {};
  matSeq = {};
  matSeq = Append[matSeq, ini]; 
  xylistSeq = {};
  xylistSeq = Append[xylistSeq, {}];
(*  end: Initialization  *)
i=0;
While[(no=Count[Flatten[Last[matSeq],1],Null])!=0,
  i=i+1;Print["i= ",i];
  mat=Last[matSeq];
  Which[
     (sol=findNakedSingle[makeMap[mat]])=!={},
      Print["NakedSigle: ",sol];
      AppendTo[solSeq,sol];
      AppendTo[matSeq,makeMatrixByNakedSingle[mat]];
      AppendTo[xylistSeq,First[#]&/@rules];,

     (sol=findHiddenSingleRow[makeMap[mat]])=!={{{},{}}},
      Print["HiddenSigleRow: ",sol];
      AppendTo[solSeq,sol];
      AppendTo[matSeq,makeMatrixByHiddenSingleRow[mat]];
      AppendTo[xylistSeq,First[#]&/@rules];,

     (sol=findHiddenSingleColumn[makeMap[mat]])=!={{{},{}}},
      Print["HiddenSigleColumn: ",sol];
      AppendTo[solSeq,sol];
      AppendTo[matSeq,makeMatrixByHiddenSingleColumn[mat]];
      AppendTo[xylistSeq,First[#]&/@rules];,

     (sol=findHiddenSingleBox[makeMap[mat]])=!={{{},{}}},
      Print["HiddenSigleBox: ",sol];
      AppendTo[solSeq,sol];
      AppendTo[matSeq,makeMatrixByHiddenSingleBox[mat]];
      AppendTo[xylistSeq,First[#]&/@rules];,

      True,Print["No of blank= ",no];Break[];
   ];
];
If[no==0,Print["No of blank= ",no,"  Succeeded !"]];
MatrixForm[Last[matSeq]]]

実行結果

i= 1
NakedSigle: {{9,{3,2}},{2,{6,7}},{8,{6,9}},{5,{7,8}}}
i= 2
NakedSigle: {{2,{3,3}},{9,{5,7}}}
i= 3
NakedSigle: {{1,{3,8}},{1,{4,7}},{4,{5,9}}}
i= 4
HiddenSigleRow: {{6,{2,9}},{5,{3,6}},{3,{6,5}},{2,{9,1}}}
i= 5
NakedSigle: {{6,{6,6}},{3,{9,9}}}
i= 6
NakedSigle: {{9,{1,9}},{7,{3,9}},{5,{6,3}},{6,{9,7}}}
i= 7
NakedSigle: {{3,{3,7}},{8,{5,3}},{7,{7,7}}}
i= 8
NakedSigle: {{6,{4,3}}}
i= 9
NakedSigle: {{4,{1,3}},{7,{4,1}}}
i= 10
NakedSigle: {{6,{1,1}},{3,{5,1}},{9,{7,3}}}
i= 11
NakedSigle: {{4,{7,1}}}
i= 12
NakedSigle: {{8,{7,4}},{1,{8,1}}}
i= 13
NakedSigle: {{9,{4,4}},{6,{7,2}},{7,{8,6}}}
i= 14
NakedSigle: {{8,{4,5}},{2,{5,6}},{5,{8,2}},{5,{9,4}}}
i= 15
NakedSigle: {{1,{1,5}},{7,{5,4}},{4,{8,4}},{6,{8,5}},{8,{9,2}}}
i= 16
NakedSigle: {{8,{1,6}},{2,{2,4}},{5,{5,5}},{9,{9,5}}}
i= 17
NakedSigle: {{3,{1,4}},{2,{1,8}},{7,{2,5}},{9,{2,6}},{8,{2,8}},{1,{9,6}}}
No of blank= 0  Succeeded !

結果の読み方

NakedSigle: {{9,{3,2}},{2,{6,7}},{8,{6,9}},{5,{7,8}}}

NakedSigles で見つけた答えは次の4コである。3行2列に9を、6行7列に2を、6行9列に8を、7行8列に5を入れる。

最終結果

Show[Rasterize[plotGame[Last[matSeq]]], ImageSize -> 250]

途中結果をManipulateを使って表示させることができる。

Manipulate[
 Show[Rasterize[plotGameSeq[matSeq[[i]], xylistSeq[[i]]]], 
  ImageSize -> 250], {i, 1, Length[matSeq], 1}] 

このベージでは Manipulate のスライダーを動かすことができないので Wolfram Cloud に載せた。

次をクリックしてください。 Sudoku animation

まとめ

この数独の例は、NakedSingle とHiddenSingleを探すことで答えが見つかった。しかし、答えが見つからない場合はどうするか。

解法は The Logic of Sudoku, Andrew C Stuart の本とウェブサイトに書いてあります。 http://www.sudokuwiki.org/strategy_families

目次へ