Solving 2x2x2

Pensieve Header: Solving the 2x2x2 Rubik’s Cube.

n=24; 
(Subscript[g, 1])=Cycles[{{1,2,3,4},{5,7,9,11},{6,8,10,12}}];
(Subscript[g, 2])=Cycles[{{13,14,6,5},{21,15,2,12},{22,7,1,20}}];
(Subscript[g, 3])=Cycles[{{7,15,16,8},{6,22,17,3},{14,23,9,2}}];(Subscript[g, 4])=Cycles[{{10,9,17,18},{4,8,23,19},{3,16,24,11}}];
(Subscript[g, 5])=Cycles[{{20,12,11,19},{13,1,10,24},{5,4,18,21}}];
(Subscript[g, 6])=Cycles[{{24,23,22,21},{18,16,14,20},{17,15,13,19}}];

σ_∘τ_ := PermutationProduct[τ, σ];
Feed[Cycles[{}]]:=Null;
Feed[τ_]:=Module[{i,j,k,l},
i=Min[PermutationSupport[τ]];
j=PermutationReplace[i, τ];
If[Head[(Subscript[σ, i,j])]===Cycles,
Feed[InversePermutation[(Subscript[σ, i,j])]∘τ],
(*Else*) (Subscript[σ, i,j])=τ;
For[k=1, k<n, ++k,
For[l=k+1, l≤n, ++l,
If[Head[(Subscript[σ, k,l])]===Cycles,
Feed[(Subscript[σ, i,j])∘(Subscript[σ, k,l])]; Feed[(Subscript[σ, k,l])∘(Subscript[σ, i,j])]]
]]
]];
$RecursionLimit=∞;

Table[Feed[(Subscript[g, α])];(∏_(i=1)^n)(1+Count[Range[n], j_ /; Head[(Subscript[σ, i,j])]==Cycles]), {α, 6}]

24!

8!(3^8)

8!(3^8)/88179840

88179840/24

ImageCrop[ 
Rasterize[Graphics[{
EdgeForm[Thin],
Table[
If[Head[(Subscript[σ, i,j])]===Cycles || i==j,
{Red, Rectangle[{i-1,n-j},{i,n-j+1}]},
{Yellow, Rectangle[{i-1,n-j},{i,n-j+1}]}
], {i,n}, {j,i,n}
]
}, AspectRatio -> 1/GoldenRatio, ImageSize -> 720], RasterSize -> 720]
]