目次へ
前回の「8. 色リストから置換リストへの変換 」において、色指定( u, l, f, r, b, d ) にシンボルを使用している。その後、ストリング（文字列）で指定する方が理にかなっていることに気がついたので書き換えを行った。
その他、色の指定の仕方に "orange", "blue", "green", "white", "yellow", "red" または、
"or", "bl", "gr", "wh", "ye", "re" を使えるようにした。
パッケージ Color2Index を次に示す。ファイル名を Color2Index.m とする。
BeginPackage["Color2Index`"];
Color2Index::usage = "Color2Index[colorList] transforms colorList into indexList.
Elements of colorList is string.";
Begin["`Private`"];
singmaster2index[q0_List] :=
Module[{cornerSet, cornerAllR, ttCorner, rulesCorner, edgeSet,
edgeAllR, ttEdge, rulesEdge},
(* corner *)
cornerSet = {{{1,9,35},{"u","l","b"}},{{3,33,27},{"u","b","r"}},
{{6,17,11},{"u","f","l"}},{{8,25,19},{"u","r","f"}},
{{14,46,40},{"l","d","b"}},{{16,22,41},{"l","f","d"}},
{{24,30,43},{"f","r","d"}},{{32,38,48},{"r","b","d"}}};
cornerAllR =
Flatten[Function[x, NestList[Map[RotateRight, #] &, x, 2]] /@ (Reverse[#] & /@ cornerSet), 1];
ttCorner = Flatten[
Table[
Table[
Function[x, If[q0[[x[[1]]]] === cornerAllR[[i]][[1]],
Append[{x[[1]]}, cornerAllR[[i]][[2]]] ]]@cornerSet[[j]],
{i, 1, Length[cornerAllR]}] // DeleteCases[#, Null] &,
{j, 1, Length[cornerSet]}],
1];
rulesCorner = Flatten[Function[x, MapThread[#1 -> #2 &, x]] /@ ttCorner, 1];
(* edge *)
edgeSet = {{{2,34},{"u","b"}} ,{{4,10},{"u","l"}},{{5,26},{"u","r"}},
{{7,18},{"u","f"}},{{12,37},{"l","b"}},{{13,20},{"l","f"}},
{{15,44},{"l","d"}},{{21,28},{"f","r"}}, {{23,42},{"f","d"}},
{{29,36},{"r","b"}},{{31,45},{"r","d"}},{{39,47},{"b","d"}}};
edgeAllR = Flatten[Function[x, NestList[Map[RotateRight, #] &, x, 1]] /@ (Reverse[#] & /@ edgeSet), 1];
ttEdge = Flatten[
Table[
Table[
Function[x, If[q0[[x[[1]]]] === edgeAllR[[i]][[1]],
Append[{x[[1]]}, edgeAllR[[i]][[2]]] ]]@edgeSet[[j]],
{i, 1, Length[edgeAllR]}] // DeleteCases[#, Null] &,
{j, 1, Length[edgeSet]}],
1];
rulesEdge = Flatten[Function[x, MapThread[#1 -> #2 &, x]] /@ ttEdge, 1];
(* *)
ReplacePart[ReplacePart[q0, rulesCorner], rulesEdge]
]
(* *)
c2up[cq_List] := Which[
First[Or @@@ Outer[SameQ,{cq[[1]]},{"orange","blue","green","white","yellow","red"}]],
cq /. {"orange"->"u","blue"->"l","green"->"f","white"->"r","yellow"->"b","red"->"d"},
First[Or @@@ Outer[SameQ, {cq[[1]]}, {"or","bl","gr","wh","ye","re"}]],
cq /. {"or"->"u","bl"->"l","gr"->"f","wh"->"r","ye"->"b","re"->"d"},
First[Or @@@ Outer[SameQ, {cq[[1]]}, {"u","l","f","r","b","d"}]], cq,
True, Print["arg error"]
]
(* *)
Color2Index[q0_List] := singmaster2index[c2up[q0]]
End[];
EndPackage[];
使いかた
SetDirectory[NotebookDirectory[]]
<< Color2Index.m
Names["Color2Index`*"]
⇒ {Color2Index}
cqq= {"or", "or", "bl", "ye", "wh", "or", "gr", "re", "gr", "or", "gr", \
"wh", "wh", "ye", "bl", "bl", "wh", "or", "bl", "ye", "bl", "gr", \
"gr", "gr", "ye", "or", "or", "ye", "bl", "wh", "wh", "or", "ye", \
"bl", "bl", "gr", "gr", "ye", "ye", "wh", "re", "re", "re", "re", \
"re", "re", "re", "wh"};
Color2Index[cqq]
⇒ {6, 4, 9, 34, 26, 8, 18, 46, 17, 2, 19, 28, 29, 38, 15, 16, 25, 7, \
14, 36, 12, 22, 23, 24, 40, 5, 1, 37, 13, 30, 31, 3, 35, 10, 11, 20, \
21, 33, 39, 32, 41, 42, 43, 44, 45, 48, 47, 27}
