Sudoku(数独) を Mathematicaで解く(10): HiddenSingleColumn

Mathematica Sudoku

目次へ

10.1 HiddenSingleColumn について

この関数は前回(9)で説明した行に関する探索 HiddenSingleRow とほぼ同じです。行を列に変えればよい。 「裸のシングル」 が見つからないゲームの行列は ini4 であった。前回の(9)に定義が書いてあります。

mapini4=makeMap[ini4];
Show[Rasterize[plotMapGridsColoredByNakedSingle[ini4]],ImageSize->350]

候補図の 1 列目に注目する。1 は2個、2 は1個、3 は1個、4 は3個、6 は5個、7は2個である。2は1個なので 「9行1列に 2を入れる」が答となる。また、3も1個なので「5行1列に 3を入れる」が答えになる。 この作業をMathematica で表現する。1列を取り出すと次になる。

mapini4[[All, 1]]
⇒{{4, 6}, {}, {}, {6, 7}, {3, 7}, {}, {4, 6}, {1, 4, 6}, {1, 2, 6}}

DeleteCases[mapini4[[All, 1]], {}]
⇒{{4, 6}, {6, 7}, {3, 7}, {4, 6}, {1, 4, 6}, {1, 2, 6}}

(* 内部の中括弧を外す *)
Flatten[DeleteCases[mapini4[[All, 1]], {}]]
⇒{4, 6, 6, 7, 3, 7, 4, 6, 1, 4, 6, 1, 2, 6}

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

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

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

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

(* この数の位置を求める。*)
Position[mapini4[[All,1]],#]&/@nums
⇒{{{5,1}},{{9,2}}}

Flatten[Position[mapini4[[All,1]],#]&/@nums,1]
⇒{{5,1},{9,2}}

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

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

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

findHiddenSingleColumn2[map_,ncol_]:=Module[{maptmpx,nums,pos,pos99},
   maptmpx=map[[All,ncol]];
   nums=Cases[Tally[Flatten[maptmpx]],{_,1}][[All,1]];
   pos=Flatten[(Position[maptmpx,#]&/@nums),1][[All,1]];
   pos99={#,ncol}&/@pos;
   {nums,pos99}
]

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

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

findHiddenSingleColumn[mapini4]
⇒{{3, {5, 1}}, {2, {9, 1}}, {9, {7, 3}}}

プロットに関数する関数

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

plotMapGridsColoredByHiddenSingleColumn[ini_]:=Module[{mapini,delList,grids},
   mapini=makeMap[ini];
   delList=findHiddenSingleColumnColor[mapini];
   grids=makeGridsColored[makeGrids[mapini],delList,"Yellow"];
   plotGridsColored[ini,grids]
]

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

新しい行列を作る関数は次になる。

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

ini5 = makeMatrixByHiddenSingleColumn[ini4];

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

新しく作った関数

  • findHiddenSingleColumn2[map_, nrow_]
  • findHiddenSingleColumn[map_]
  • findHiddenSingleColumnColor[map_]
  • plotMapGridsColoredByHiddenSingleColumn[ini_]
  • makeMatrixByHiddenSingleColumn[ini_]

続く

次回は、ボックス内でHiddenSingle を探す関数を説明します。

目次へ