flirtatiouslala
Member
- Joined
- May 12, 2013
- Messages
- 5
i'm trying to figure out what's happening in Kociemba's mathematica solver. but is kinda hard. does anyone have pseudocode for that?
(***************************************************************************************************************)
(* Generate tables with the pure permutations of the 18 possible moves, orientations are ignored *)
(* Needed for the transition from phase1 to phase2 *)
(***************************************************************************************************************)
cMovePerms = Module[ {f},
f[move_] :=
NestList[multSequence[move, #] &, move, 2];
Flatten [f /@ {cU, cR, cF, cD, cL, cB}, 2][[1 ;; 35 ;; 2]]
];
eMovePerms = Module[ {f},
f[move_] :=
NestList[multSequence[move, #] &, move, 2];
Flatten [f /@ {eU, eR, eF, eD, eL, eB}, 2][[1 ;; 35 ;; 2]]
];
(***************************************************************************************************************)
(* Functions and their inverses for the phase1 and phase2 coordinates *)
(***************************************************************************************************************)
(* phase1 coordinates: *)
(* The position of the FR, FL, BL and BR edges *)
slice[p_] := 494-(RankKSubset[Sort[Take[InversePermutation[p],-4]],Range[12]]);
invSlice[n_] :=
Module[ {s,r,i,x},
s =
UnrankKSubset[494-n,4,Range[12]];
r =
{0,0,0,0,0,0,0,0,0,0,0,0};
Do[r[[s[]]] = 8+i ,{i,4}];
x = 1;
Do[If[ r[]==0,
r[] = x++
],{i,12}];
r
]
(* The flip of the 12 edges *)
flip[o_]:= FromDigits[Mod[Most[o],2],2]
invFlip[n_]:=Module[{d},d=IntegerDigits[n+2048,2];Rest[Append[d,Mod[Total[d]+1,2]]]]
(* The twist of thee 8 corners *)
twist[o_]:= FromDigits[Mod[Most[o],3],3]
invTwist[n_]:=Module[{d},d=IntegerDigits[n+2187,3];Rest[Append[d,Mod[4-Total[d],3]]]]
(* phase2 coordinates: *)
(* The permutation of the 8 corners *)
corner[p_] :=
RankPermutation[p];
invCorner[n_] :=
UnrankPermutation[n,8]
(* The permutation of the edges UR, UF, UL, UB, DR, DF, DL, DB in the U and D face. *)
edge8[p_] :=
Module[ {t},
t = Take[p,8];
If[ PermutationQ[t],
RankPermutation[t],
-1
]
]
invEdge8[n_] :=
Join[UnrankPermutation[n,8],{9,10,11,12}]
(* The permutation of the edges FR, FL, BL and BR in the slice between the U and D face. *)
edge4[p_] :=
Module[ {t},
t = Take[p,-4]-8;
If[ PermutationQ[t],
RankPermutation[t],
-1
]
]
invEdge4[n_] :=
Join[Range[8],UnrankPermutation[n,4]+8]
(***************************************************************************************************************)
(* The movetables store how the coordinates are mapped by the 18 moves. In the phase2 tables, this mapping is *)
(* undefined for the moves R, R', F, F', L, L', B and B' which are no phase2 moves and the entries are -1 here *)
(***************************************************************************************************************)
moveTable[name_,cornerQ_,permQ_,coord_,invCoord_,size_] :=
Module[ {f,d,cubies,j,t},
SetDirectory[NotebookDirectory[]];
If[ FileExistsQ[name],
Print["Loading ",name," Table"];
t = Get[name],
Print["Building ",name," Table"];
cubies = If[ cornerQ,
8,
12
];
d = If[ permQ,
Array[0 &, cubies],
Array[# &, cubies]
];
f[move_,i_] :=
If[ permQ,
coord /@ Flatten[Rest[NestList[multSequence[#, move] &, {invCoord,d}, 3]],
1][[1 ;; 5 ;; 2]],
coord /@ Flatten[Rest[NestList[multSequence[#, move] &, {d, invCoord}, 3]],
1][[2 ;; 6 ;; 2]]
];
t = Table[If[ Mod[j,1000]==0,
Print[j,"/",size]
];
If[ cornerQ,
Join[f[cU,j],f[cR,j],f[cF,j],f[cD,j],f[cL,j],f[cB,j]],
Join[f[eU,j],f[eR,j],f[eF,j],f[eD,j],f[eL,j],f[eB,j]]
],{j,0,size-1}];
Put[t,name];
ResetDirectory[];
t
]
]
flipMove = moveTable["flipMove",False,False,flip,invFlip,2048];
twistMove = moveTable["twistMove",True,False,twist,invTwist,2187];
sliceMove = moveTable["sliceMove",False,True,slice,invSlice,495];
cornerMove = moveTable["cornerMove",True,True,corner,invCorner,40320];
edge4Move = moveTable["edge4Move",False,True,edge4,invEdge4,24];
edge8Move = moveTable["edge8Move",False,True,edge8,invEdge8,40320];
(***************************************************************************************************************)
(* The phase1 pruning tables store the minimum distances to reach a phase2 position for all possible *)
(* (slice,flip) and (slice,twist) coordinate pairs. The phase2 pruning tables store the minimum distances to *)
(* reach the solved cube position for all possible (edge4,edge8) and (edge4,corner) coordinate pair. *)
(***************************************************************************************************************)
prunTable[name_,move1_,size1_,move2_,size2_] :=
Module[ {i,m,depth,count,p},
SetDirectory[NotebookDirectory[]];
If[ FileExistsQ[name],
Print["Loading ",name," Table"];
p = Get[name],
p = ConstantArray[-1,size1*size2];
p[[0+1]] = 0;
count = 1;
depth = 0;
Print["Building ",name," Table"];
Print[depth," ", count];
While [count<size1*size2,
Do[
If[ p[[i+1]]==depth,
m = move1[[Quotient[i,size2]+1]]*size2+move2[[Mod[i,size2]+1]];(*list of 18 values, invalid values <0*)
(If[#>=0 && p[[#+1]]==-1,
count++;
p[[#+1]] = depth+1
]) & /@ m;
]
,{i,0,size1*size2-1}];
depth++;
Print[depth," ", count];
];
Put[p,name]
];
ResetDirectory[];
p
]
(* phase1 *)
sliceflipPrun = prunTable["sliceflipPrun",sliceMove,495,flipMove,2048];
slicetwistPrun = prunTable["slicetwistPrun",sliceMove,495,twistMove,2187];
(* phase2 *)
edge4edge8Prun = prunTable["edge4edge8Prun",edge4Move,24,edge8Move,40320];
edge4cornerPrun = prunTable["edge4cornerPrun",edge4Move,24,cornerMove,40320];
solveCube[c_,min_] :=
Module[ {i},
Print[c];
If[ !PermutationQ[c[[1,1]]] ||!PermutationQ[c[[2,1]]] || Signature[c[[1,1]]]*Signature[c[[2,1]]]!=1
|| Mod[Total[c[[1,2]]],3]!=0 || Mod[Total[c[[2,2]]],2]!=0,
Print["Cube not solvable!"],
If[ c[[1]]==cId && c[[2]]==eId,
Print["(0f)"],
solver1 = ConstantArray[0,21];
startPerm = {c[[1,1]],c[[2,1]]};
maxLength = min;
currLength = 100;
phase1ExitQ = False;
Do [phase1search[flip[c[[2,2]]],twist[c[[1,2]]],slice[c[[2,1]]],i],{i,20}]
(* never more than 20 moves *)
]
]
]
solveCube[c_]:= solveCube[c,30]
phase1search[flip_,twist_,slice_,togo_] :=
Module[ {i,fl,tw,sl,sliceflipdist,slicetwistdist,m},
If[ !phase1ExitQ,
If[ togo==0,
phase2start[],
Do[If[ validPairQ[i,solver1[[togo+1]]],
fl = flipMove[[flip+1,i]];
tw = twistMove[[twist+1,i]];
sl = sliceMove[[slice+1,i]];
sliceflipdist = sliceflipPrun[[2048*sl+fl+1]];
slicetwistdist = slicetwistPrun[[2187*sl+tw+1]];
m = Max[sliceflipdist,slicetwistdist];
If[ m<togo && (togo>5|| m!=0 || togo==1),
solver1[[togo]] = i;
phase1search[fl,tw,sl,togo-1]
]
],{i,18}]
]
]
];
phase2start[] :=
Module[ {cperm,eperm,s,c,e4,e8,i,l},
s = Reverse[Select[solver1, # > 0 &]];
cperm = Fold[Table[#1[[#2[]]], {i, 8}] &, startPerm[[1]],
cMovePerms[]];
eperm = Fold[Table[#1[[#2[]]], {i, 12}] &,startPerm[[2]],
eMovePerms[]];
c = corner[cperm];
e4 = edge4[eperm];
e8 = edge8[eperm];
solver2 = ConstantArray[0,19];
If[ c==0&&e4==0&&e8==0,
printSolver;
phase1ExitQ = True,(* optimal solution found *)
l = Length; (* phase1 length *)
phase2ExitQ = False;
Do [ If [i<currLength-l ,phase2search[c,e4,e8,i]],{i,15}](* 15 moves in phase 2 is enough *)
]
]
phase2search[corner_,edge4_,edge8_,togo_] :=
Module[ {i,c,e4,e8,edge4cornerdist,edge4edge8dist,m},
If[ !phase2ExitQ,
If[ togo==0,
printSolver;
currLength = Length[Select[solver1, # > 0 &]]+Length[Select[solver2, # > 0 &]];
If [currLength<=maxLength,phase1ExitQ =True];
solver2 = ConstantArray[0,19];
phase2ExitQ = True,
Do[If[ Count[{4,6,7,9,13,15,16},i]==0 &&validPairQ[i,solver2[[togo+1]]]&&(solver2[[togo+1]]!=0 || validPairQ[i,solver1[[1]]]),
c = cornerMove[[corner+1,i]];
e4 = edge4Move[[edge4+1,i]];
e8 = edge8Move[[edge8+1,i]];
edge4cornerdist = edge4cornerPrun[[40320*e4+c+1]];
edge4edge8dist = edge4edge8Prun[[40320*e4+e8+1]];
m = Max[edge4cornerdist,edge4edge8dist];
If[ m<togo,
solver2[[togo]] = i;
phase2search[c,e4,e8,togo-1]
]
],{i,17}]
]
]
]
(* Generate tables with the pure permutations of the 18 possible moves, orientations are ignored *)
(* Needed for the transition from phase1 to phase2 *)
(***************************************************************************************************************)
cMovePerms = Module[ {f},
f[move_] :=
NestList[multSequence[move, #] &, move, 2];
Flatten [f /@ {cU, cR, cF, cD, cL, cB}, 2][[1 ;; 35 ;; 2]]
];
eMovePerms = Module[ {f},
f[move_] :=
NestList[multSequence[move, #] &, move, 2];
Flatten [f /@ {eU, eR, eF, eD, eL, eB}, 2][[1 ;; 35 ;; 2]]
];
(***************************************************************************************************************)
(* Functions and their inverses for the phase1 and phase2 coordinates *)
(***************************************************************************************************************)
(* phase1 coordinates: *)
(* The position of the FR, FL, BL and BR edges *)
slice[p_] := 494-(RankKSubset[Sort[Take[InversePermutation[p],-4]],Range[12]]);
invSlice[n_] :=
Module[ {s,r,i,x},
s =
UnrankKSubset[494-n,4,Range[12]];
r =
{0,0,0,0,0,0,0,0,0,0,0,0};
Do[r[[s[]]] = 8+i ,{i,4}];
x = 1;
Do[If[ r[]==0,
r[] = x++
],{i,12}];
r
]
(* The flip of the 12 edges *)
flip[o_]:= FromDigits[Mod[Most[o],2],2]
invFlip[n_]:=Module[{d},d=IntegerDigits[n+2048,2];Rest[Append[d,Mod[Total[d]+1,2]]]]
(* The twist of thee 8 corners *)
twist[o_]:= FromDigits[Mod[Most[o],3],3]
invTwist[n_]:=Module[{d},d=IntegerDigits[n+2187,3];Rest[Append[d,Mod[4-Total[d],3]]]]
(* phase2 coordinates: *)
(* The permutation of the 8 corners *)
corner[p_] :=
RankPermutation[p];
invCorner[n_] :=
UnrankPermutation[n,8]
(* The permutation of the edges UR, UF, UL, UB, DR, DF, DL, DB in the U and D face. *)
edge8[p_] :=
Module[ {t},
t = Take[p,8];
If[ PermutationQ[t],
RankPermutation[t],
-1
]
]
invEdge8[n_] :=
Join[UnrankPermutation[n,8],{9,10,11,12}]
(* The permutation of the edges FR, FL, BL and BR in the slice between the U and D face. *)
edge4[p_] :=
Module[ {t},
t = Take[p,-4]-8;
If[ PermutationQ[t],
RankPermutation[t],
-1
]
]
invEdge4[n_] :=
Join[Range[8],UnrankPermutation[n,4]+8]
(***************************************************************************************************************)
(* The movetables store how the coordinates are mapped by the 18 moves. In the phase2 tables, this mapping is *)
(* undefined for the moves R, R', F, F', L, L', B and B' which are no phase2 moves and the entries are -1 here *)
(***************************************************************************************************************)
moveTable[name_,cornerQ_,permQ_,coord_,invCoord_,size_] :=
Module[ {f,d,cubies,j,t},
SetDirectory[NotebookDirectory[]];
If[ FileExistsQ[name],
Print["Loading ",name," Table"];
t = Get[name],
Print["Building ",name," Table"];
cubies = If[ cornerQ,
8,
12
];
d = If[ permQ,
Array[0 &, cubies],
Array[# &, cubies]
];
f[move_,i_] :=
If[ permQ,
coord /@ Flatten[Rest[NestList[multSequence[#, move] &, {invCoord,d}, 3]],
1][[1 ;; 5 ;; 2]],
coord /@ Flatten[Rest[NestList[multSequence[#, move] &, {d, invCoord}, 3]],
1][[2 ;; 6 ;; 2]]
];
t = Table[If[ Mod[j,1000]==0,
Print[j,"/",size]
];
If[ cornerQ,
Join[f[cU,j],f[cR,j],f[cF,j],f[cD,j],f[cL,j],f[cB,j]],
Join[f[eU,j],f[eR,j],f[eF,j],f[eD,j],f[eL,j],f[eB,j]]
],{j,0,size-1}];
Put[t,name];
ResetDirectory[];
t
]
]
flipMove = moveTable["flipMove",False,False,flip,invFlip,2048];
twistMove = moveTable["twistMove",True,False,twist,invTwist,2187];
sliceMove = moveTable["sliceMove",False,True,slice,invSlice,495];
cornerMove = moveTable["cornerMove",True,True,corner,invCorner,40320];
edge4Move = moveTable["edge4Move",False,True,edge4,invEdge4,24];
edge8Move = moveTable["edge8Move",False,True,edge8,invEdge8,40320];
(***************************************************************************************************************)
(* The phase1 pruning tables store the minimum distances to reach a phase2 position for all possible *)
(* (slice,flip) and (slice,twist) coordinate pairs. The phase2 pruning tables store the minimum distances to *)
(* reach the solved cube position for all possible (edge4,edge8) and (edge4,corner) coordinate pair. *)
(***************************************************************************************************************)
prunTable[name_,move1_,size1_,move2_,size2_] :=
Module[ {i,m,depth,count,p},
SetDirectory[NotebookDirectory[]];
If[ FileExistsQ[name],
Print["Loading ",name," Table"];
p = Get[name],
p = ConstantArray[-1,size1*size2];
p[[0+1]] = 0;
count = 1;
depth = 0;
Print["Building ",name," Table"];
Print[depth," ", count];
While [count<size1*size2,
Do[
If[ p[[i+1]]==depth,
m = move1[[Quotient[i,size2]+1]]*size2+move2[[Mod[i,size2]+1]];(*list of 18 values, invalid values <0*)
(If[#>=0 && p[[#+1]]==-1,
count++;
p[[#+1]] = depth+1
]) & /@ m;
]
,{i,0,size1*size2-1}];
depth++;
Print[depth," ", count];
];
Put[p,name]
];
ResetDirectory[];
p
]
(* phase1 *)
sliceflipPrun = prunTable["sliceflipPrun",sliceMove,495,flipMove,2048];
slicetwistPrun = prunTable["slicetwistPrun",sliceMove,495,twistMove,2187];
(* phase2 *)
edge4edge8Prun = prunTable["edge4edge8Prun",edge4Move,24,edge8Move,40320];
edge4cornerPrun = prunTable["edge4cornerPrun",edge4Move,24,cornerMove,40320];
solveCube[c_,min_] :=
Module[ {i},
Print[c];
If[ !PermutationQ[c[[1,1]]] ||!PermutationQ[c[[2,1]]] || Signature[c[[1,1]]]*Signature[c[[2,1]]]!=1
|| Mod[Total[c[[1,2]]],3]!=0 || Mod[Total[c[[2,2]]],2]!=0,
Print["Cube not solvable!"],
If[ c[[1]]==cId && c[[2]]==eId,
Print["(0f)"],
solver1 = ConstantArray[0,21];
startPerm = {c[[1,1]],c[[2,1]]};
maxLength = min;
currLength = 100;
phase1ExitQ = False;
Do [phase1search[flip[c[[2,2]]],twist[c[[1,2]]],slice[c[[2,1]]],i],{i,20}]
(* never more than 20 moves *)
]
]
]
solveCube[c_]:= solveCube[c,30]
phase1search[flip_,twist_,slice_,togo_] :=
Module[ {i,fl,tw,sl,sliceflipdist,slicetwistdist,m},
If[ !phase1ExitQ,
If[ togo==0,
phase2start[],
Do[If[ validPairQ[i,solver1[[togo+1]]],
fl = flipMove[[flip+1,i]];
tw = twistMove[[twist+1,i]];
sl = sliceMove[[slice+1,i]];
sliceflipdist = sliceflipPrun[[2048*sl+fl+1]];
slicetwistdist = slicetwistPrun[[2187*sl+tw+1]];
m = Max[sliceflipdist,slicetwistdist];
If[ m<togo && (togo>5|| m!=0 || togo==1),
solver1[[togo]] = i;
phase1search[fl,tw,sl,togo-1]
]
],{i,18}]
]
]
];
phase2start[] :=
Module[ {cperm,eperm,s,c,e4,e8,i,l},
s = Reverse[Select[solver1, # > 0 &]];
cperm = Fold[Table[#1[[#2[]]], {i, 8}] &, startPerm[[1]],
cMovePerms[
eperm = Fold[Table[#1[[#2[]]], {i, 12}] &,startPerm[[2]],
eMovePerms[
c = corner[cperm];
e4 = edge4[eperm];
e8 = edge8[eperm];
solver2 = ConstantArray[0,19];
If[ c==0&&e4==0&&e8==0,
printSolver;
phase1ExitQ = True,(* optimal solution found *)
l = Length
phase2ExitQ = False;
Do [ If [i<currLength-l ,phase2search[c,e4,e8,i]],{i,15}](* 15 moves in phase 2 is enough *)
]
]
phase2search[corner_,edge4_,edge8_,togo_] :=
Module[ {i,c,e4,e8,edge4cornerdist,edge4edge8dist,m},
If[ !phase2ExitQ,
If[ togo==0,
printSolver;
currLength = Length[Select[solver1, # > 0 &]]+Length[Select[solver2, # > 0 &]];
If [currLength<=maxLength,phase1ExitQ =True];
solver2 = ConstantArray[0,19];
phase2ExitQ = True,
Do[If[ Count[{4,6,7,9,13,15,16},i]==0 &&validPairQ[i,solver2[[togo+1]]]&&(solver2[[togo+1]]!=0 || validPairQ[i,solver1[[1]]]),
c = cornerMove[[corner+1,i]];
e4 = edge4Move[[edge4+1,i]];
e8 = edge8Move[[edge8+1,i]];
edge4cornerdist = edge4cornerPrun[[40320*e4+c+1]];
edge4edge8dist = edge4edge8Prun[[40320*e4+e8+1]];
m = Max[edge4cornerdist,edge4edge8dist];
If[ m<togo,
solver2[[togo]] = i;
phase2search[c,e4,e8,togo-1]
]
],{i,17}]
]
]
]
Last edited by a moderator: