Sudoku(数独) を Mathematicaで解く(9): HiddenSinglesRow

目次へ

9.1 HiddenSingle の説明

Naked Single「裸のシングル」が見つからない場合には、次の選択として Hidden Single「隠れたシングル」を探す。この解法は The logic of sudoku by Andrew C Stuart に解説が書いてある。これを参考にしている。 http://sudokuwiki.com/The_Logic_of_Sudoku

「裸のシングル」が見つからないゲームの行列は ini4 であった。

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

mapini4 = makeMap[ini4];

(* Show[Rasterize[plotGame[ini4]], ImageSize -> 250]; *)
Show[Rasterize[plotMapGridsColoredByNakedSingle[ini4]],ImageSize -> 350]

候補図の 3行目に注目する。3 は2個、5 は1個、7は3個である。5 は1個なので「3行6列に 5 を入れる」が答となる。このように「隠れたシングル」を探すことを HiddenSingle 法という。この作業を Mathematica で表現する。

mapini4[[3]]
⇒ {},{},{},{},{},{5,7},{3,7},{},{3,7}}

DeleteCases[mapini4[[3]],{}]
⇒ {{5,7},{3,7},{3,7}}

(* 内部の中括弧を外す。*)
Flatten[DeleteCases[mapini4[[3]],{}]]
⇒ {5, 7, 3, 7, 3, 7}

個数を数える関数として Tally がある。次の結果が意味することは、リストの中で 5 を数えると1個、7 が 3個, 3 が 2個を示している。次に1個の数を選び出すために関数 Cases を使う。

Tally[Flatten[DeleteCases[mapini4[[3]], {}]]]
⇒ {{5, 1}, {7, 3}, {3, 2}}

Cases[Tally[Flatten[DeleteCases[mapini4[[3]], {}]]], {_, 1}]
⇒ {{5, 1}}

nums = Cases[Tally[Flatten[DeleteCases[mapini4[[3]], {}]]], {_, 1}][[All, 1]]
⇒ {5}

(* この数の位置を求める。*)
Flatten[Position[mapini4[[3]], #] & /@ nums, 1]
⇒ {{6, 1}}

pos = Flatten[Position[mapini4[[3]], #] & /@ nums, 1][[All, 1]]
⇒ {6}

(* 従って位置は 3 行 6列である。*)
pos99 = {3, #} & /@ pos
⇒ {{3, 6}}

この手続きを関数にまとめる。

findHiddenSingleRow2[map_, nrow_] := Module[{maptmpx, nums, pos, pos99},
   maptmpx = map[[nrow]];
   nums = Cases[Tally[Flatten[maptmpx]], {_, 1}][[All, 1]];
   pos = Flatten[(Position[maptmpx, #] & /@ nums), 1][[All, 1]];
   pos99 = {nrow, #} & /@ pos;
  {nums, pos99}
]
  
findHiddenSingleRow2[mapini4, 3]
⇒ {{5}, {{3, 6}}}

(* 全ての行について調べる関数は次になる *)
findHiddenSingleRow[map_] := Module[{tmp},
  tmp = DeleteCases[
    Table[findHiddenSingleRow2[map, nrow], {nrow, 1, 9}],
    {{}, {}}];
  If[tmp == {}, {{{}, {}}},Flatten[Function[x, MapThread[{#1, #2} &, x]] /@ tmp, 1]]
]

findHiddenSingleRow[mapini4]
⇒ {{6, {2, 9}}, {5, {3, 6}}, {3, {6, 5}}, {2, {9, 1}}}

findHiddenSingleRowColor[map_] := Module[{tmp},
  tmp = findHiddenSingleRow[map];
  If[tmp == {{{}, {}}}, tmp, {{#[[1]]}, #[[2]]} & /@ tmp]
]

findHiddenSingleRowColor[mapini4]
⇒ {{{6}, {2, 9}}, {{5}, {3, 6}}, {{3}, {6, 5}}, {{2}, {9, 1}}}

plotMapGridsColoredByHiddenSingleRow[ini_] := Module[{mapini, delList, grids},
  mapini = makeMap[ini];
  delList = findHiddenSingleRowColor[mapini];
      grids = getGridsColored[makeGrids[mapini], delList, "Yellow"];
  plotGridsColored[ini, grids]
]

Show[Rasterize[plotMapGridsColoredByHiddenSingleRow[ini4]],ImageSize -> 350]

findHiddenSingleRow で見つかった答えを埋めて新しい行列を作る関数は次になる。

makeMatrixByHiddenSingleRow[ini_] := Module[{mapini, singles},
  mapini = makeMap[ini];
  singles = findHiddenSingleRow[mapini];
  rules = Map[Apply[Rule, Reverse[#]] &, singles];
  Fold[ReplacePart[#1, #2] &, ini, rules]
  ]
  
ini5 = makeMatrixByHiddenSingleRow[ini4];

xylist = First[#] & /@ rules;
Show[Rasterize[plotGameSeq[ini5, xylist]], ImageSize -> 250]