Solving the 3x5 torus puzzle

Pensieve Header: Solving the 3x5 torus puzzle, with care for lengths and meanings.

n=15; $RecursionLimit = 2^16;
Feed[M[Range[n],__]]:={};
CycPerm[c___] := Range[n] /. Thread[{c} -> RotateRight[{c}]];

CycPerm[1,2,3]

gens = {
M[CycPerm[1,2,3,4,5], {r1}, 1],
M[CycPerm[6,7,8,9,10], {r2}, 1],
M[CycPerm[11,12,13,14,15], {r3}, 1],
M[CycPerm[1,6,11], {c1}, 1],
M[CycPerm[2,7,12], {c2}, 1],
M[CycPerm[3,8,13], {c3}, 1],
M[CycPerm[4,9,14], {c4}, 1],
M[CycPerm[5,10,15], {c5}, 1]
};
gens = {
M[CycPerm[1,4,7,10,13], {r1}, 1],
M[CycPerm[2,5,8,11,14], {r2}, 1],
M[CycPerm[3,6,9,12,15], {r3}, 1],
M[CycPerm[1,2,3], {c1}, 1],
M[CycPerm[4,5,6], {c2}, 1],
M[CycPerm[7,8,9], {c3}, 1],
M[CycPerm[10,11,12], {c4}, 1],
M[CycPerm[13,14,15], {c5}, 1]
}

Program 5

Clear[s, M, T];  TC=0;
M/:M[a1_,{w1___}, m1_]**M[a2_,{w2___}, m2_]:=M[a1[[a2]],{w1,w2}, m1+m2];
M /: Inverse[M[a_, w_, m_]] := M[Ordering[a], -Reverse[w], m];
Feed[M[Range[n],__]]:={};
Feed[M[a_,{w___}, m_]] := Module[
{i, j,sij,k,l,skl},
For[i=1, a[[i]]==i, ++i]; j=a[[i]];
If[Head[sij=s[i,j]]===Integer,
(* then *) If[m ≥ T[sij][[3]],
Feed[Inverse[ReplacePart[T[sij], {sij}, 2]]**M[a,{w},m]],
T[s[i,j]=++TC] = M[a,{w},m];
Feed[Inverse[M[a,{w},m]]**ReplacePart[T[sij], {sij}, 2]]
],
(* else *) T[s[i,j]=++TC] = M[a,{w},m];
Do[
If[Head[skl=s[k,l]]==Integer,
Feed[ReplacePart[T[sij]**T[skl], {sij, skl}, 2]];
Feed[ReplacePart[T[skl]**T[sij], {skl, sij}, 2]]
],
{k,n},{l,n}
]
]
];
Images[i_] := Prepend[Select[Range[n], Head[s[i,#]]===Integer&], i];
MoveCount[i_,i_] := 0;
MoveCount[i_,j_] := T[s[i,j]][[3]];
TMC[] := Sum[Total[MoveCount[i,#]& /@ Images[i]], {i, n}];
Optimize[] := Timing[
Do[
If[Head[sij=s[i,j]]==Integer, Do[
If[Head[skl=s[k,l]]==Integer,
Feed[ReplacePart[T[sij]**T[skl], {sij, skl}, 2]]
],{k,n},{l,n}]],
{i,n}, {j,n}];
TMC[]
];

g=0;
Print[Timing[
(++g; Feed[#]; Feed[Inverse[#]]; Product[Length[Images[i]],{i,n}])& /@ gens
]];
Print[tmc=TMC[]];
While[
Last[opt= Optimize[]] ≠ tmc,
tmc=Last[opt];
Print[opt]
]

15!/2

The Worst Case Scenario

Table[MoveCount[i,#]& /@ Images[i], {i, n}] // ColumnForm

Sum[Max[MoveCount[i,#]& /@ Images[i]], {i, n}]

TC