Non-Commutative Gaussian Elimination - The Program

Pensieve Header: Non-Commutative Gaussian Elimination - the program(s).

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}}];

σ_∘τ_ := 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}]

TagProperties["TheGenerators"]={PageWidth -> 9};
TagProperties["TheRun"]={PageWidth -> 12};
CellExport /@ {"TheGenerators", "TheProgram", "TheRun"}

43252003274489856000/(8!*3^8*12!*2^12)

Export["TGraph.png", 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]
]]

SetDirectory["C:/drorbn/AcademicPensieve/2013-01/NCGE"];

TagProperties[_] := {};
Options[CellExport] = {
PageWidth -> 6, CellFilter -> Identity, ExportFormat -> ".png", ExportOptions -> {}, Split -> False
};
CellExport[tag_String] := CellExport[tag, TagProperties[tag]];
CellExport[tag_String, OptionsPattern[]] := Module[
{cells, cell},
cells=OptionValue[CellFilter][Cases[
NotebookGet[EvaluationNotebook[]], c_Cell /; FreeQ[List@@c, Cell] && !FreeQ[c, CellTags->tag],
Infinity
]];
If[!OptionValue[Split],
If[Length[cells]≥1,
If[Length[cells]==1,
cells=Append[First[cells], PageWidth -> 72OptionValue[PageWidth]],
cells=Cell[CellGroup[cells], PageWidth -> 72OptionValue[PageWidth]]
];
Show[
Import[Export[tag<>OptionValue[ExportFormat],cells, Sequence@@OptionValue[ExportOptions]]],
ImageSize -> 120
]
],
k=0;
GraphicsRow[Table[
++k;
Show[
Import[Export[
tag<>"-"<>ToString[k]<>OptionValue[ExportFormat],
Append[cell, PageWidth -> 72OptionValue[PageWidth]],
Sequence@@OptionValue[ExportOptions]
]],
ImageSize -> 120
],
{cell, cells}
]]
]
];