?PermutationProduct

PP[a_List] := a;
(*PP[a_List, b_List] := Table[b[[j]],{j,a}];*)
PP[a_List, b_List] := b[[a]];(*PP[a_List,b_List, rest__List] := PP[PP[a,b],rest];*)
PP[a_List, rest__List] := PP[a,PP@rest];

PP[{2,3,1},{2,1,3}]

PP[{2,3,1},{2,1,3},{3,2,1}]

{ian,huan,justin}[[2]]

{ian,huan,justin}[[{2,3,1}]]

?InversePermutation

Position[{huan,{justin,adam},ian}, justin]

IP[a_List] := Table[
Position[a, i][[1,1]],
{i,Length@a}
]

IP[{2,3,1}]

0{3,1,2}

IP[a_List] := (
t=0a;
Do[t[[a[[i]]]]=i, {i,Length@a}];
t
)

IP[{2,3,1}]

(*IP[a_List] := Ordering[a]*)

?PermutationSupport

PS[a_] := Join@@Position[a-Range[Length@a], Except[0],{1},Heads->False]

PS[{1,2,4,3,5}]

PS[a_] := Join@@Position[a-Range[Length@a],i_Integer /; i≠0]

PS[{1,2,4,3,5}]

PS[a_] := Select[a, #≠a[[#]]&]

PS[{1,2,4,3,5}]

Trace[IP[{2,3,1}]] //Column

?PermutationReplace

PermutationReplace[#, Cycles[{{1,2,3}}]]& /@{
1, lennart, lennart[1,3], {3,4}, lennart[{1,2},3]
}

PR[expr_Integer, a_List]:= If[1≤expr≤Length[a],a[[expr]], expr];
PR[head_[elements___], a_List] := PR[head,a]@@(PR[#,a]& /@ {elements});
PR[expr_,a_List]:= expr;

PR[#, {2,3,1}]& /@{
1, lennart, lennart[1,3], {3,4}, lennart[{1,2},3]
}

Sequence[1,2,3]

just[1,2,Sequence[3,4]]

sq[x_] := (x^2);
sq/@{1,2,3}

sq/@f[1,2,3]

Map[sq, {3,4,5}]

sq/@Sequence[1,2,3]

PR[expr_,a_List] := expr /. Table[i->a[[i]], {i,a}]

PR[#, {2,3,1}]& /@{
1, lennart, lennart[1,3], {3,4}, lennart[{1,2},3]
}

a={2,3,1};
Table[i->a[[i]], {i,Length@a}]

Range@Length@a -> a

Transpose[{{1,2,3},{4,5,6}}]

Transpose[Range@Length@a -> a]

Transpose[{Range@Length@a , a}]

Rule/@Transpose[{Range@Length@a , a}]

Rule@@@Transpose[{Range@Length@a , a}]

Thread[Range@Length@a -> a]

Thread[a -> a[[a]]]

PR[expr_,a_List] := expr /.Thread[a -> a[[a]]]

PR[#, {2,3,1}]& /@{
1, lennart, lennart[1,3], {3,4}, lennart[{1,2},3]
}

n=54;
(Subscript[g, 1])=Cycles[{{1,18,45,28},{2,27,44,19},{3,36,43,10},{46,52,54,48},{47,49,53,51}}];
(Subscript[g, 2])=Cycles[{{7,16,39,30},{8,25,38,21},{9,34,37,12},{13,15,33,31},{14,24,32,22}}];
(Subscript[g, 3])=Cycles[{{28,31,34,48},{29,32,35,47},{30,33,36,46},{37,39,45,43},{38,42,44,40}}];
(Subscript[g, 4])=Cycles[{{1,3,9,7},{2,6,8,4},{10,54,16,13},{11,53,17,14},{12,52,18,15}}];
(Subscript[g, 5])=Cycles[{{1,13,37,46},{4,22,40,49},{7,31,43,52},{10,12,30,28},{11,21,29,19}}];
(Subscript[g, 6])=Cycles[{{3,48,39,15},{6,51,42,24},{9,54,45,33},{16,18,36,34},{17,27,35,25}}];

σ_∘τ_ := PP[τ, σ];
Feed[Range[n]]:=1+1;
Feed[τ_]:=Module[{i,j,k,l},
i=Min[PS[τ]];
j=PR[i, τ];
If[Head[(Subscript[σ, i,j])]===List,
Feed[IP[(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])]===List,
Feed[(Subscript[σ, i,j])∘(Subscript[σ, k,l])]; Feed[(Subscript[σ, k,l])∘(Subscript[σ, i,j])]]
]]
]];
$RecursionLimit=∞;

Table[(Subscript[γ, α])=PermutationList[(Subscript[g, α]),n],{α,6}] // MatrixForm

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

Feed[(Subscript[γ, 1])]