ルービックキューブの配置の番号付けと色については参考文献 1, 2 と 3 を参考に決め、展開図を次に示す。
小面にこのように番号を付けると、この配置は Mathematica のリスト Range[48] で表現できる。このリストを8個ずつ分割すると、最初の8個は up に属し、2番目の8個は left に属する等々。この対応は面の表現リストに対応している。
face = {"up", "left", "front", "right", "back", "down"};
面の色は次のように決めた。
faceColor = { Orange, Blue, Green, White, Yellow, Red };
配置リストを入力として展開図を描く関数 plotCube
Grid 関数を使って 関数 plotCube を作った。コードを次に示す。
(* 補助関数 *)
statusForPlot[status_, face_] :=
Module[{blanks, aa, bb, cc, up, leftFrontRightBack, down},
blanks = Table["", {3}];
aa = Partition[status, 8];
bb = MapThread[Insert[#1, #2, 5] &, {aa, face}];
cc = Partition[#, 3] & /@ bb;
up = Table[Join[blanks, cc[[1, i]], blanks, blanks], {i, 1, 3}];
leftFrontRightBack = Table[Join[cc[[2, j]], cc[[3, j]], cc[[4, j]], cc[[5, j]]], {j, 1, 3}];
down = Table[Join[blanks, cc[[6, i]], blanks, blanks], {i, 1, 3}];
Join[up, leftFrontRightBack, down]
]
(* function plotCube *)
plotCube[status_] := Module[{face,
upFrame = Flatten[Table[{{i, i}, {j, j}} -> True, {i, 1, 3}, {j, 4, 6}], 1],
leftFrame = Flatten[Table[{{i, i}, {j, j}} -> True, {i, 4, 6}, {j, 1, 3}], 1],
frontFrame = Flatten[Table[{{i, i}, {j, j}} -> True, {i, 4, 6}, {j, 4, 6}], 1],
rightFrame = Flatten[Table[{{i, i}, {j, j}} -> True, {i, 4, 6}, {j, 7, 9}], 1],
backFrame = Flatten[Table[{{i, i}, {j, j}} -> True, {i, 4, 6}, {j, 10, 12}], 1],
downFrame = Flatten[Table[{{i, i}, {j, j}} -> True, {i, 7, 9}, {j, 4, 6}], 1],
faceColor, upColor, leftColor, frontColor, rightColor, backColor, downColor, ss},
(* -- *)
face = Style[#, Red, Bold, 18] & /@ {"U", "L", "F", "R", "B", "D"};
(* -- *)
ss = statusForPlot[status, face];
(* color *)
faceColor = {{2, 5} -> Lighter[Orange, 0.2], {5, 2} -> Lighter[Blue, 0.5], {5, 5} -> Darker[Green, 0.3],
{5, 8} -> White, {5, 11} -> Yellow, {8, 5} -> Lighter[Red, 0.4]};
(* -- *)
upColor = Map[# -> Lighter[Orange, 0.2] &, Flatten[Position[ss, #] & /@ Range[8], 1]];
leftColor = Map[# -> Lighter[Blue, 0.5] &, Flatten[Position[ss, #] & /@ Range[9, 16], 1]];
frontColor = Map[# -> Darker[Green, 0.3] &, Flatten[Position[ss, #] & /@ Range[17, 24], 1]];
rightColor = Map[# -> White &, Flatten[Position[ss, #] & /@ Range[25, 32], 1]];
backColor = Map[# -> Lighter[Yellow, 0.1] &, Flatten[Position[ss, #] & /@ Range[33, 40], 1]];
downColor = Map[# -> Lighter[Red, 0.4] &, Flatten[Position[ss, #] & /@ Range[41, 48], 1]];
(* -- *)
Grid[ss, ItemSize -> {1.5, 1.5},
Frame -> {None, None, Join[upFrame, leftFrame, frontFrame, rightFrame, backFrame, downFrame]},
Spacings -> {1.5, 2},
Background -> {None, None, Join[faceColor, upColor, leftColor, frontColor, rightColor, backColor, downColor]} ]
]
上に示した展開図は次で描いた。
p0 = Range[48]; plotCube[p0]
Grid の使い方は Mathematica 9 ドキュメントセンターに書いてあります。