15. Rubik's Cube: 解法のシナリオ ( Mathematica )

目次へ

部屋に乱雑な配置になったルービックキューブがあるとする。これを Mathematica で解くシナリオを考える。

ルービックキューブの配置の状態を色のリストとして入力する。
色リストからインデックスリストに変換する。
インデックスリストから巡回置換を求める。
巡回置換から手順を求める。
逆手順を求める。

この順序に沿って具体例を示す。その前にMathematica の準備を行う必要がある。読み込むパッケージについては次で説明しています。

0. Mathematica の準備

SetDirectory[NotebookDirectory[]];
<< PlotRubiksCube2.m 
Names["PlotRubiksCube`*"]
⇒ {"PlotCube", "PlotCube3D"}
<< Color2Index.m  
Names["Color2Index`*"] 
⇒ {"Color2Index"} 
<< RubiksGroup.m

1. ルービックキューブの配置の状態を色のリストとして入力する

cubicle の位置 1..48 の色を指定する。色の指定は orange, blue, green, white, yellow, red の頭の２文字を使用した。

colorConfig2 =
 {"gr", "or", "or", "wh", "or", "or", "or", "or", "wh", "ye", "bl",
  "re", "bl", "wh", "ye", "bl", "gr", "gr", "gr", "gr", "gr", "gr",
  "gr", "or", "wh", "wh", "wh", "wh", "or", "bl", "wh", "bl", "ye",
  "ye", "re", "bl", "bl", "re", "ye", "re", "re", "re", "ye", "bl",
  "re", "ye", "re", "ye"};

2. 色リストからインデックスリストに変換する

perm2 = Color2Index[colorConfig2]
⇒ {24, 2, 3, 29, 5, 6, 7, 8, 30, 36, 11, 44, 13, 32, 37, 16, 17, 18,
   19, 20, 21, 22, 23, 1, 25, 26, 27, 28, 4, 9, 31, 14, 33, 34, 43,
   10, 15, 46, 39, 48, 41, 42, 35, 12, 45, 38, 47, 40}
Show[Rasterize[PlotCube[perm2]], ImageSize -> 350]

3. インデックスリストから巡回置換を求める

cycle2 = FindPermutation[perm2]
⇒ Cycles[{{1,24},{4,29},{9,30},{10,36},{12,44},{14,32},{15,37},{35,43},
          {38,46},{40,48}}]

4. 巡回置換から手順を求める

base2 = Complement[Range[48], Join @@ cycle2];
p2 = GroupElementToWord[cube, cycle2, GroupActionBase -> base2]
⇒ {3, -4, -5, 1, 5, 4, -3, -1, -6, 1, 2, -3, -2, 3, -4, 6, 3, -6, 4,-3,
   2, 6, -3, 4, -2, -4, 3, 4, 2, -4, 3, -6, -3, -2, 1, -6, 4, -2,-6, 2,
  -4, -2, 6, 2, 6, 4, -6, -4, -1, 4, -3, 5, -2, -5, 3, -4, 2, 6, -2, -3,
  -1, 3, 1, 3, 1, 4, -6, -4, -6, -1, -6, -3, 6, 3, 1, -6, 1, -6, 5, -2,
   6, -5, 4, 4, -1, -1}
Length[p2]
⇒ 86

5. 逆手順を求める

p2Inverse = -1*Reverse[p2]
⇒ {1, 1, -4, -4, 5, -6, 2, -5, 6, -1, 6, -1, -3, -6, 3, 6, 1, 6, 4, 6,
  -4, -1, -3, -1, -3, 1, 3, 2, -6, -2, 4, -3, 5, 2, -5, 3, -4, 1, 4, 6,
  -4, -6, -2, -6, 2, 4, -2, 6, 2, -4, 6, -1, 2, 3, 6, -3, 4, -2, -4,
  -3, 4, 2, -4, 3, -6, -2, 3, -4, 6, -3, -6, 4, -3, 2, 3, -2, -1, 6, 1,
   3, -4, -5, -1, 5, 4, -3}
permP2Inv = Fold[rotate, perm2, p2Inverse /. ruleRotate];
permP2Inv == Range[48]
⇒ True

手動で回転して確認するために

manual = p2Inverse /. rulesReverse
⇒ {"f", "f", "l^-1", "l^-1", "u", "d^-1", "b", "u^-1", "d", "f^-1",
"d", "f^-1", "r^-1", "d^-1", "r", "d", "f", "d", "l", "d", "l^-1",
"f^-1", "r^-1", "f^-1", "r^-1", "f", "r", "b", "d^-1", "b^-1", "l",
"r^-1", "u", "b", "u^-1", "r", "l^-1", "f", "l", "d", "l^-1", "d^-1",
"b^-1", "d^-1", "b", "l", "b^-1", "d", "b", "l^-1", "d", "f^-1", "b",
"r", "d", "r^-1", "l", "b^-1", "l^-1", "r^-1", "l", "b", "l^-1", "r",
"d^-1", "b^-1", "r", "l^-1", "d", "r^-1", "d^-1", "l", "r^-1", "b",
"r", "b^-1", "f^-1", "d", "f", "r", "l^-1", "u^-1", "f^-1", "u", "l",
"r^-1"}
Length[manual]
⇒ 86

読みやすくするためにつぎのように表示する。

キューブを手で握り86回回転して完成した時は感動的だった。これは86手を間違わずに回転できたことを意味します。

まとめ

Mathematica で Rubik's Cube を解く手順は次である。

ルービックキューブの配置の状態を色のリストとして入力する。
色リストからインデックスリストに変換する。
インデックスリストから巡回置換を求める。
巡回置換から手順を求める。
逆手順を求める。