目次へ戻る
今後、ノートブック上にプログラムを作るために、(6)で説明したグループ化された関数の集まり code1, code2, code3, code4 を整理して以下に示します。
コードの中に書いてある (* begin{Section} *)
と (* end{Section} *)
はノートブックの中ではコメント文です。セルのスタイルをSection
に設定すると便利なのでこれを書き入れました。
7.1 code1: plotGame について
これはゲームを表示する関数です。(1)と(5)で説明した関数をまとめたものです。
(* code1 : plotGame and plotGameSeq *)
(* begin{Section} *)
plotGame[ini_?MatrixQ]:=Grid[ini,
ItemStyle->{Directive[Blue,25,Bold],None},
ItemSize->{2.5,2.5},Dividers -> {{{Thickness[2],True,True}},{{Thickness[2],True,True}}},
Background -> {Automatic,Automatic,
Flatten[Table[{i, j} -> If[EvenQ[Plus @@ Floor[{i - 1, j - 1}/3]],
LightGreen, White], {i, 9}, {j, 9}]]},Spacings->{0,0.45}]
plotGameSeq[ini_?MatrixQ,xylist:{{_,_}..}]:=Grid[ini,
ItemStyle->{Directive[FontSize->25,Darker[Blue],Bold],Automatic,Thread[xylist->Table[Pink,{Length[xylist]}]]},
ItemSize->{2.5,2.5},Dividers -> {{{Thickness[2],True,True}},{{Thickness[2],True,True}}},
Background -> {Automatic,Automatic,
Flatten[Table[{i, j} -> If[EvenQ[Plus @@ Floor[{i - 1, j - 1}/3]],
LightGreen, White], {i, 9}, {j, 9}]]},Spacings->{0,0.45}]
plotGameSeq[ini_?MatrixQ,xylist:{}]:=plotGame[ini]
(* end{Section} *)
7.2 code2: plotMap について
候補図(map)を描く関数です。(1)と(5)で説明した関数をまとめたものです。
(* code2 : 候補図: plotMapGrid and plotGridsColored *)
(* begin{Section} *)
gridBox[lst_List]:=Grid[Partition[ReplacePart[Table[blank,{9}],Thread[lst->lst]],3]/.blank->Null]
plotMapGrid[ini_?MatrixQ,mapini_List]:=Module[{numbers,grids,mapgrid},
numbers=DeleteCases[Flatten[Table[If[ini[[i,j]]=!=Null,{i,j}->ini[[i,j]],"aa"],{i,1,9},{j,1,9}],1],_?StringQ];
grids=Table[gridBox[mapini[[i,j]]],{i,1,9},{j,1,9}];
mapgrid=ReplacePart[grids,numbers];
Grid[mapgrid,
ItemStyle->{Directive[Blue,13,Bold],Automatic,Thread[numbers[[All,1]]->Table[Directive[Blue,30,Bold],{Length[numbers]}]]},
ItemSize->{3.5,3.5},Dividers -> {{{Thickness[2],True,True}},{{Thickness[2],True,True}}},
Background -> {Automatic,Automatic,
Flatten[Table[{i, j} -> If[EvenQ[Plus @@ Floor[{i - 1, j - 1}/3]],
LightGreen, White], {i, 9}, {j, 9}]]}
]
]
(* begin{Subsection}: coloring *)
makeGrids[mapini_]:=Table[gridBox[mapini[[i,j]]],{i,1,9},{j,1,9}]
coloring2[grids_,{nums_List,{i_,j_}},bkg_:Green,moji_:Black]:=Module[{tmp},
tmp=grids;
tmp[[i,j]]=grids[[i,j]]/.Flatten[{#->Item[Style[#,moji], Background -> bkg]}&/@nums,1];
tmp
]
makeGridsColored[grids_,colors_,bkg_String]:=Module[{moji},
Which[bkg=="Green",
Fold[coloring2[#1,#2,Symbol[bkg],Black]&,grids,colors],bkg=="Yellow",
Fold[coloring2[#1,#2,Symbol[bkg],Red]&,grids,colors]
]
]
plotGridsColored[ini_,grids_]:=Module[{numbers,mapgrid},
numbers=DeleteCases[Flatten[Table[If[ini[[i,j]]=!=Null,{i,j}->ini[[i,j]],"aa"],{i,1,9},{j,1,9}],1],_?StringQ];
mapgrid=ReplacePart[grids,numbers];
Grid[mapgrid,
ItemStyle->{Directive[Blue,13,Bold],Automatic,Thread[numbers[[All,1]]->Table[Directive[Blue,30,Bold],{Length[numbers]}]]},
ItemSize->{3.4,3.6},Dividers -> {{{Thickness[2],True,True}},{{Thickness[2],True,True}}},
Background -> {Automatic,Automatic,
Flatten[Table[{i, j} -> If[EvenQ[Plus @@ Floor[{i - 1, j - 1}/3]],
LightGreen, White], {i, 9}, {j, 9}]]}
]
]
(* end{Subsection} *)
(* end{Section} *)
7.3 code3: makeMap について
各ブランクに入れるべき候補を決める関数 makeMap です。(3)で説明したものと同じです。
(* code3 : makeMap *)
(* begin{Section} *)
candidates[ini_?MatrixQ,{i_,j_}]:=Module[{f},
f[k_]:=Which[1<=k<=3, 1;;3,4<=k<=6,4;;6,7<=k<=9,7;;9];
If[ini[[i,j]]=!=Null,{},
Complement[Range[9],
Union[ini[[i]],ini[[All,j]],Flatten[ini[[f[i],f[j]]]]]]
]
]
makeMap[ini_?MatrixQ]:=Table[candidates[ini,{i,j}],{i,1,9},{j,1,9}]
(* end{Section} *)
7.4 code4: NakedSingle について
NakedSingle(裸のシングル)を探す関数です。(5)で説明した関数を整理のためまとめたものです。
(* code4 : NakedSingle *)
(* begin{Section} *)
findNakedSingle[mapini_]:=Module[{p,element},
p=Position[mapini,{_}];
element=Map[mapini[[Sequence@@#]]&,p];
Transpose[{Flatten[element],p}]
]
findNakedSingleColor[mapini_]:=Module[{p,element},
p=Position[mapini,{_}];
element=Map[mapini[[Sequence@@#]]&,p];
Transpose[{element,p}]
]
makeMatrixByNakedSingle[ini_]:=Module[{mapini,singles},
mapini=makeMap[ini];
singles=findNakedSingle[mapini];
rules=Map[Apply[Rule,Reverse[#]]&,singles];
Fold[ReplacePart[#1,#2]&,ini,rules]
]
(* begin{Subsection} : coloring *)
plotMapGridsColoredByNakedSingle[ini_]:=Module[{mapini,delList,grids},
mapini=makeMap[ini];
delList=findNakedSingleColor[mapini];
grids=makeGridsColored[makeGrids[mapini],delList,"Yellow"];
plotGridsColored[ini,grids]
]
(* end{Subsection} *)
(* end{Section} *)
続く
次は、 Main を説明し、関数 findNakedSingle で答えが見つからない例を示します。