読者です 読者をやめる 読者になる 読者になる

数独(Sudoku)をMathematica で解く(4): NakedSingle

Mathematica Sudoku

目次へ

前回で作った関数makeMapを使って 候補のリストmapini を作る。これを表示したものが次である。

mapini=makeMap[ini];
Show[Rasterize[plotMapGrid[ini,mapini]],ImageSize->350]

この候補図の中に「シングル」(要素の数が1個)の候補として、3行2列に9 、6行7列の2、6行9列の8、7行8列の5 の4個を見つけることができる。 この手続きを Mathematica で表現する。

関数 findNakedSingle を作る

候補mapini の中身は、9行9列の行列の要素がリストになっている。具体的には3行2列の要素は {9} である。関数Position を使って、パターン{_} にマッチする要素の位置を求める。

pos=Position[mapini,{_}]
⇒ {{3, 2}, {6, 7}, {6, 9}, {7, 8}}

これは、候補のリストの中で「シングル」の「位置のリスト」である。位置 {3, 2} にある数は 9 である。次で確認する。

mapini[[3,2]]
⇒ {9}

次に、位置のリストpos を入力として、その位置に入っている数のリストを求める。はじめに、リストpos の1番目の要素を入力として、 mapini からその位置の要素を取り出す。

pos[[1]]
⇒ {3, 2}

次のように、pos[[1]] を代入すると望みの結果は得られない。

mapini[[pos[[1]]]]
⇒ {{{},{9},{2,9},{},{},{1,2,5,7,9},{1,2,3,7,9},{1,2},{3,7,9}},
   {{},{},{},{2,7,8,9},{7,8,9},{2,7,8,9},{},{2,8},{6,7,8,9}}}

これはmapini[[{3,2}]] と書いたことになっている。 リストを表す中括弧が余分にあるので、3行と2行を取り出している。この中括弧を取り除くことが必要となる。関数Apply を使うことにより望み通りの要素を取り出すことができる。

mapini[[Apply[Sequence, {3, 2}]]]
⇒ {9}
mapini[[Sequence @@ {3, 2}]] (* 別の書き方をすれば次になる *)
⇒ {9}

これを利用して、関数 Mapを使うことにより位置のリストposを入力として、その位置に入っている数のリストを求めることができる。

pos
⇒ {{3, 2}, {6, 7}, {6, 9}, {7, 8}}
element = Map[mapini[[Sequence @@ #]] &, pos]
⇒ {{9}, {2}, {8}, {5}}

後の利用のために次の構造を持つデータをつくる。

Transpose[{Flatten[element], pos}]
⇒ {{9, {3, 2}}, {2, {6, 7}}, {8, {6, 9}}, {5, {7, 8}}}
Transpose[{element, pos}]
⇒ {{{9}, {3, 2}}, {{2}, {6, 7}}, {{8}, {6, 9}}, {{5}, {7, 8}}}

以上をまとめて関数 findNakedSinglefindNakedSingleColor をつくる。

findNakedSingle[mapini_] := Module[{pos, element},
  pos = Position[mapini, {_}];
  element = Map[mapini[[Sequence @@ #]] &, pos];
  Transpose[{Flatten[element], pos}]
  ]
findNakedSingle[mapini]
⇒ {{9, {3, 2}}, {2, {6, 7}}, {8, {6, 9}}, {5, {7, 8}}}
  
findNakedSingleColor[mapini_] := Module[{pos, element},
  pos = Position[mapini, {_}];
  element = Map[mapini[[Sequence @@ #]] &, pos];
  Transpose[{element, pos}]
  ]
findNakedSingleColor[mapini]
⇒ {{{9}, {3, 2}}, {{2}, {6, 7}}, {{8}, {6, 9}}, {{5}, {7, 8}}}

関数 makeMatrixByNakedSingle を作る

関数findNakedSingleで見つけた答えを、行列iniに埋める関数を作る。

singles = findNakedSingle[mapini]
⇒ {{9, {3, 2}}, {2, {6, 7}}, {8, {6, 9}}, {5, {7, 8}}}

リストini の3行2列の位置に 9 を入れる作業は 関数 ReplacePart を使って次のように実現できる。

initmp = ReplacePart[ini, {3, 2} -> 9];
Show[Rasterize[plotGame[initmp]], ImageSize -> 250]

入れるべき数は4カ所あるので次のようにして実行する。

singles
⇒ {{9, {3, 2}}, {2, {6, 7}}, {8, {6, 9}}, {5, {7, 8}}}
(* これを ReplacePart に使う形に変形する *)
rules = Map[Apply[Rule, Reverse[#]] &, singles]
⇒ {{3, 2} -> 9, {6, 7} -> 2, {6, 9} -> 8, {7, 8} -> 5}

ルール を4回適用するのだが、1 回適用するたびに行列ini は更新される。この場合、関数Fold を使って実現できる。図に描くことで、singles に示されている数が埋められていること確認できる。

ini2 = Fold[ReplacePart[#1, #2] &, ini, rules];
Show[Rasterize[plotGame[ini2]], ImageSize -> 250]

このグラフより「シングル」の部分が埋め込まれたことを確認できる。しかし、ここで埋めこんだ数字を分かりやすくする工夫が必要である。これについては次回(5)で説明する。

上で述べた作業を関数 makeMatrixByNakedSingle にまとめる。

makeMatrixByNakedSingle[ini_] := Module[{mapini, singles},
  mapini = makeMap[ini];
  singles = findNakedSingle[mapini];
  rules = Map[Apply[Rule, Reverse[#]] &, singles];
  Fold[ReplacePart[#1, #2] &, ini, rules]
  ]
ini2 = makeMatrixByNakedSingle[ini];
Show[Rasterize[plotGame[ini2]], ImageSize -> 250];

ここまでに作った関数のまとめ

  • makeMap[ini_]           (3)で説明
  • findNakedSingle[mapini_]     (4)で説明
  • findNakedSingleColor[mapini_] (4)
  • makeMatrixByNakedSingle[ini_] (4)

表示に関する関数

  • plotGame[ini_]         (1)で説明
  • plotMapGrid[ini_, mapini_] (2)で説明

目次へ