目次へ
Analyzing Rubik's Cube with GAP , Martin Schönert,1993
GAPを用いたRubik's Cube 解法表示シフトについて 田崎 拓馬、藤本 光史 著 について、理解を深めるため Mathematica を使って翻訳を試みた。
各面の表示を次のようにし、GAP で実行し、キューブの図を描き、解法手順の確認を行った。
GAP のコード
% 2 Rubik's Cube と群
gap> f := (17,19,24,22)(18,21,23,20)( 6,25,43,16)( 7,28,42,13)( 8,30,41,11);;
gap> b := (33,35,40,38)(34,37,39,36)( 3, 9,46,32)( 2,12,47,29)( 1,14,48,27);;
gap> r := (25,27,32,30)(26,29,31,28)( 3,38,43,19)( 5,36,45,21)( 8,33,48,24);;
gap> l := ( 9,11,16,14)(10,13,15,12)( 1,17,41,40)( 4,20,44,37)( 6,22,46,35);;
gap> u := ( 1, 3, 8, 6)( 2, 5, 7, 4)( 9,33,25,17)(10,34,26,18)(11,35,27,19);;
gap> d := (41,43,48,46)(42,45,47,44)(14,22,30,38)(15,23,31,39)(16,24,32,40);;
gap> cube := Group(f,b,r,l,u,d);
%
gap> Size(cube);
43252003274489856000
%
% 3 Rubik's Cube 問題を GAP で解く
% 3.1 位数問題 -- 一連の操作を何回行うと元に戻るか
gap> Order(b*f^-1*l^-1*r^-1);
12
%
% 3.2 メンバーシップ問題 -- 与えられた模様は実現可能か
gap> (8,19,25)(24,30,43) in cube;
true
gap> (8,19,25)(24,43,30) in cube;
false
%
% 3.3 生成元の積で表す問題 -- Rubik's cube の完成手順を求める
gap> GetWordOfElements:= function ( G, GenName, x )
> local gen, F, hom;
> F := FreeGroup( GenName );
> gen := GeneratorsOfGroup( G );
> hom := GroupHomomorphismByImages( F, G, GeneratorsOfGroup( F ), gen );
> return PreImagesRepresentative( hom, x );
> end;
function( G, GenName, x ) ... end
%
gap> p:= GetWordOfElements(cube,["f","b","r","l","u","d"],(8,19,25)(24,30,43));
f*u*l*f*l^-1*f^-1*u^-1*f^-1*r^-1*f^-1*d^-1*f*d*r*f^2*r*f*r^-1*u*f^-1*u^-1*f*r*f^-1*r^-1*f*u^-1*r*u*r^-1*f
%
gap> p^-1;
f^-1*r*u^-1*r^-1*u*f^-1*r*f*r^-1*f^-1*u*f*u^-1*r*f^-1*r^-1*f^-2*r^-1*d^-1*f^-1*d*f*r*f*u*f*l*f^-1*l^-1*u^-1*f^-1
gap> quit;
Mathematica のコードを使ってチェックした項目
- (8,19,25)(24,30,43) で表される状態の配置図
- 手順 p で得られる配置図
- 手順 p^-1 で完成図が得られるか？
Mathematica の準備
(* Mathematica code *)
SetDirectory[NotebookDirectory[]];
<< PlotRubiksCube2.m
Names["PlotRubiksCube`*"]
⇒ {"PlotCube", "PlotCube3D"}
(* *)
rotate[p_, rot_] := p[[#]] & /@ Permute[Range[48], rot]
(* *)
rotF = Cycles[{{17,19,24,22},{18,21,23,20},{6,25,43,16},{7,28,42,13},{8,30,41,11}}];
rotB = Cycles[{{33,35,40,38},{34,37,39,36},{3,9,46,32},{2,12,47,29},{1,14,48,27}}];
rotL = Cycles[{{9,11,16,14},{10,13,15,12},{1,17,41,40},{4,20,44,37},{6,22,46,35}}];
rotR = Cycles[{{25,27,32,30},{26,29,31,28},{3,38,43,19},{5,36,45,21},{8,33,48,24}}];
rotU = Cycles[{{1,3,8,6},{2,5,7,4},{9,33,25,17},{10,34,26,18},{11,35,27,19}}];
rotD = Cycles[{{41,43,48,46},{42,45,47,44},{14,22,30,38},{15,23,31,39},{16,24,32,40}}];
cube = PermutationGroup[{rotF, rotB, rotR, rotL, rotU, rotD}];
(* *)
rotSet = {rotF, rotB, rotR, rotL, rotU, rotD};
ruleRotate = {1 -> rotSet[[1]], 2 -> rotSet[[2]], 3 -> rotSet[[3]],
4 -> rotSet[[4]], 5 -> rotSet[[5]], 6 -> rotSet[[6]],
-1 -> InversePermutation[rotSet[[1]]], -2 -> InversePermutation[rotSet[[2]]],
-3 -> InversePermutation[rotSet[[3]]], -4 -> InversePermutation[rotSet[[4]]],
-5 -> InversePermutation[rotSet[[5]]], -6 -> InversePermutation[rotSet[[6]]]};
rule = {"f"->1,"b"->2,"r"->3,"l"->4,"u"->5,"d"->6,"f^-1"->-1,
"b^-1"->-2,"r^-1"->-3,"l^-1"->-4,"u^-1"->-5,"d^-1"->-6};
rule2 = {"f^2"->{1, 1},"r^2"->{3, 3},"f^-2"->{-1, -1},"r^-2"->{-3, -3}};
(8,19,25)(24,30,43) で表される状態の配置
PlotCube3D[Permute[Range[48], Cycles[{{8,19,25},{24,30,43}}]]]
手順 p で得られる配置図
p = "f*r*f^2*r^-1*f^-1*r*f^-1*r^-1*f*u*f*u^-1*f*u*f^2*u^-1*r*f^-2*r^-\
1*f^-1*r*f^-1*u*f*u^-1*f^-1*r^-1*u*l*f^-1*l^-1*u^-1*r^-1*f*r";
pList = StringSplit[p, "*"]
⇒ {"f","r","f^2","r^-1","f^-1","r","f^-1","r^-1","f","u","f", \
"u^-1","f","u","f^2","u^-1","r","f^-2","r^-1","f^-1","r", \
"f^-1","u","f","u^-1","f^-1","r^-1","u","l","f^-1","l^-1", \
"u^-1","r^-1","f","r"}
pListMMA = pList /. rule /. rule2 // Flatten
⇒ {1,3,1,1,-3,-1,3,-1,-3,1,5,1,-5,1,5,1,1,-5,3,-1, \
-1,-3,-1,3,-1,5,1,-5,-1,-3,5,4,-1,-4,-5,-3,1,3}
p0 = Range[48];
psi = Fold[rotate, p0, pListMMA /. ruleRotate];
PlotCube3D[psi]手順 p^-1 で完成図が得られるか
pInv = "f^-1*r*u^-1*r^-1*u*f^-1*r*f*r^-1*f^-1*u*f*u^-1*r*f^-1*r^-1*f^-\
2*r^-1*d^-1*f^-1*d*f*r*f*u*f*l*f^-1*l^-1*u^-1*f^-1";
pInvList = StringSplit[pInv, "*"]
⇒ {"f^-1","r","u^-1","r^-1","u","f^-1","r","f","r^-1","f^-1", \
"u","f","u^-1","r","f^-1","r^-1","f^-2","r^-1","d^-1", \
"f^-1","d","f","r","f","u","f","l","f^-1","l^-1","u^-1","f^-1"}
pInvList2 = pInvList /. rule /. rule2 // Flatten
⇒ {-1,3,-5,-3,5,-1,3,1,-3,-1,5,1,-5,3,-1,-3,-1,-1,-3, \
-6,-1,6,1,3,1,5,1,4,-1,-4,-5,-1}
psi00 = Fold[rotate, psi, pInvList2 /. ruleRotate];
PlotCube3D[psi00]
まとめ
- GAP の結果を Mathematica を使って配置図を描くことができた。
- GAP で求めた手順 p^-1 が解法手順になっていることを確認できた。
