Needs["TeXUtilities`"]

Format[a[i_], TraditionalForm] := Subscript[a, i]
Format[Inf, TeXForm] := TeXCommand["infty"]

myFold[f_, l_List] := Fold[f, l[[1]],l[[2;;All]]]

myTeXList[l_List] := TeXForm[TeXVerbatim[myFold[#1 <> ", " <> #2&, ToString[TeXForm[#]]&/@l]]]

Format[cri[l_List] , TeXForm] := TeXVerbatim[myFold[#1 <> " " <> #2&, ToString[TeXForm[#]]&/@l]]

Format[IIi[inds_List, args_List], TeXForm] := TeXVerbatim["I_{" <>ToString[myTeXList[inds]]<> "}(" <>ToString[myTeXList[args]]<> ")"]

Format[Blah[a_, b_IIi], TeXForm]/;NumberQ[a]==True := TeXVerbatim[ToString[TeXForm[a]] <> " " <> ToString[TeXForm[b]]]

(* -------- *)

shuffleLists[s1_,s2_]:=Module[{ss,sr,s1l,s2l,p,pp,tp,pres},{ss,sr}={Join[s1,s2],Range@((s1l=Length@s1)+(s2l=Length@s2))};
p=Permutations[Join[ConstantArray[1,s1l],ConstantArray[0,s2l]]];
pp=(Accumulate@Transpose[p]//Transpose) p;
tp=Clip[p,{1,0},{1,0}];
pres=pp+Clip[(Accumulate@Transpose[tp]//Transpose) tp+s1l,{s1l+1,Max[sr]},{0,0}];
ss[[#]]&/@pres]

A[hin:H[a0_, alist_List, x_, alast_], i_, iset_List] := Module[{anewlist}, (
anewlist = Table[If[MemberQ[iset,k], alist[[i]], alist[[k]]], {k, 1, Length[alist]}];
Return[H[a0, anewlist, x, alast]];
)];

B[hin:H[a0_, alist_List, x_, alast_], i_] := Module[{range, sets}, (
range = Range[1, Length[alist]]//DeleteCases[#, i]&;
sets = Join[{i}, #]&/@Subsets[range, {1,Infinity}];
Return[Sum[(-1)^Length[s] A[hin, i, s], {s, sets}]];
)];

leadingReduce[hin:H[a0_,alist_List, x_, alast_], y_] := Module[{leading,rest, resttail, resthead,anewlists}, (
leading = TakeWhile[alist, #===y&];
rest = Drop[alist, Length[leading]];
If[rest == {},
Return[0];
];

resttail = Drop[rest, 1];
resthead = rest[[1]];
anewlists = Join[{resthead}, #]&/@shuffleLists[leading, resttail];
Return[(-1)^Length[leading]Sum[H[a0, l, x, alast], {l, anewlists}]];
)];

leadingReduce[a_Plus, y_] := leadingReduce[#, y]&/@a;
leadingReduce[lambda_ hin_H, y_]/;NumberQ[lambda]:= lambda leadingReduce[hin, y]

boundReduce[hin:H[a0_,alist_List, x_,alast_], y_] := Module[{}, (
If[alist[[1]] =!= y,
Return[H[y,alist, x,alast] - H[y,alist, x,a0]],
Return[hin]
]
)];

boundReduce[a_Plus, y_] := boundReduce[#, y]&/@a;
boundReduce[lambda_ hin_H, y_]/;NumberQ[lambda]:= lambda boundReduce[hin, y]
boundReduce[0, y_] := 0;

Breduce[hin:H[a0_, alist_List, x_, alast_], i_] := Module[{range, sets}, (
range = Range[1, Length[alist]]//DeleteCases[#, i]&;
sets = Join[{i}, #]&/@Subsets[range, {1,Infinity}];
Return[Sum[(-1)^Length[s]boundReduce[leadingReduce[A[hin, i, s], alist[[i]]], alist[[i]]], {s, sets}]];
)];

Drel[hin:H[a0_, alist_List, x_, alast_], i_] := Breduce[hin,i];

Dtranspose[hin:H[a0_, alist_List, x_, alast_], i_, j_] := Module[{alist0, ai, aj, alist1, alist2}, (
alist0 = alist;
ai = alist[[i]];
aj = alist[[j]];

alist1 = alist;
alist1[[i]] = x;
alist2 = alist1;
alist2[[j]] = ai;

Return[Drel[H[a0, alist0, x, alast], i] - Drel[H[a0, alist1, ai, alast], j] + Drel[H[a0, alist2, aj, alast], i]];
)];

Asymb[n_, i_, j_]/;1≤i&&i<j&&j≤n := H[a[0], {Sequence@@#[[1;;i-1]], a[1], Sequence@@#[[i;;j-2]], a[2], Sequence@@#[[j-1;;All]]}&@Table[a[k],{k, 3, n}], x, a[n+1]]

Asymb[n_, i_]/;1≤i&&i≤n := H[a[0], {Sequence@@#[[1;;i-1]], a[1], Sequence@@#[[i;;All]]}&@Table[a[k],{k, 2, n}], x, a[n+1]]

R[n_,im_,j_,i_,j_]/;i - im==1 := Dtranspose[Asymb[n,im,j], im,i];
R[n_, 1, j_, 1, jp_]/;jp - j == 1 := Dtranspose[Asymb[n,1,j], j,jp];

c[n_, im_,j_,i_,j_] /;i-im==1 := If[OddQ[i-j],1,0];
c[n_, 1,j_,1,j2_]/;j2-j==1 := (-1)^(j)(Floor[n/2] - Floor[j/2])

R[n_,i_]:= Dtranspose[Asymb[n,i],i,i+1]

reduce[n_] := 1/Floor[n/2] * (-Sum[c[n,i-1,j,i,j]R[n,i-1,j,i,j], {i, 2, n}, {j, i+1, n}] + Sum[c[n,1,j,1,j+1]R[n,1,j,1,j+1], {j, 2, n-1}])

reduceSimp[n_]/;OddQ[n] := Sum[-R[n,i], {i, 2, n,2}]

htoInfcr[hin:H[0, alist_List, Infinity, 1], var_:x] := H[0, alist/.var->Inf, Infinity, 1];
htoInfcr[lambda_ hin_H, var_:x]/;NumberQ[lambda] := lambda htoInfcr[hin, var];
htoInfcr[a_Plus, var_:x] :=  htoInfcr[#, var]&/@a;

htoI[hin:H[0, alist_, Infinity, 1]] := Module[{pos, ind,arg},(
pos = Complement[Range[1,Length[alist]], Position[alist, el_/;el===0,1][[All,1]]];
arg = alist[[pos]];
pos = Join[pos, {Length[alist]+1}];
ind = Differences[pos];
Return[IIi[ind,arg]]
)];
htoI[lambda_ hin_H]/;NumberQ[lambda] := lambda htoI[hin];
htoI[a_Plus] :=  htoI[#]&/@a;

crorbit[{a_,b_,c_,d_}] := Sort[{{a,b,c,d},{b,a,d,c},{c,d,a,b},{d,c,b,a}}]
crorbitunsort[{a_,b_,c_,d_}] := {{d,c,b,a},{c,d,a,b},{b,a,d,c},{a,b,c,d},}
canonicalcr[l:{a_,b_,c_,d_}] := crorbit[l][[1]]

cri[l:{a_,b_,c_,d_}]/;canonicalcr[l] =!= l := cri@canonicalcr[l]

cri[{a_,b_,c_,d_}] /; a==c||b==d:=0

hcrsimp[hin:H[a0_, alist_List, x_, alast_]] := Module[{},(
Return[H[0, cri[{alast, #, x, a0}]&/@alist,Infinity, 1]]
)];
hcrsimp[lambda_ hin_H]/;NumberQ[lambda] := lambda hcrsimp[hin];
hcrsimp[a_Plus] :=  hcrsimp[#]&/@a;

crIsSpl[r1_List, r2_List]:= Module[{}, (
Return[Or@@(Count[r1 - #,0]==3&/@crorbit[r2])]
)];

makecrRatio[r1_List, r2_List] := Module[{pos,r1new,r2new}, (
pos = Position[(Count[r1 - #,0]==3&/@crorbit[r2]), True, {1}][[1,1]];
r2new = crorbit[r2][[pos]];
pos = Position[#===0&/@(r1 - r2new), False, {1}][[1,1]];
r1new = crorbitunsort[r1][[pos]];
r2new = crorbitunsort[r2new][[pos]];
Return[{r1new[[1]],r1new[[2]],r2new[[4]],r1new[[4]]}];
)];

crratiosimp = cri[r1:{a_,b_,c_,d_}]/cri[r2:{p_,q_,r_,s_}]/;crIsSpl[r1,r2]:>cri[makecrRatio[r1,r2]];

crinf[{Inf,b_,c_,d_}]:=cri[{d,c,b}]
crinf[{a_,Inf,c_,d_}]:=cri[{c,d,a}]
crinf[{a_,b_,Inf,d_}]:=cri[{b,a,d}]
crinf[{a_,b_,c_,Inf}]:=cri[{a,b,c}]

crinfsimp = cri[r1:{a_,b_,c_,d_}]/;Position[r1, Inf]≠{} :>crinf[r1];

indices[expr_] := If[Head[expr]===IIi, Return[expr[[1]]], Cases[expr, IIi[ind_,arg_]:>ind][[1]]];

in = htoI@htoInfcr@hcrsimp[Asymb[5,1,2]]/.{a[i_]:>{a,b,c,d,e,f,g}[[i+1]]}

outBig = (htoI@htoInfcr@hcrsimp@Expand@reduce[5])/.crinfsimp

out = (htoI@htoInfcr@hcrsimp@Expand@reduceSimp[5])/.crinfsimp

outlower = Select[out, Position[#, a[0]]≠{}&];

outBiglower = Select[outBig, Position[#, a[0]]≠{}&];

outlowerGath = Plus@@@((List@@outlower)//GatherBy[#, indices[#]&]&);
outlowerGath//ColumnForm
Fold[#1<>" \\\\ \n" <> #2&,
"",
{"$ I_"<>ToString[indices[#[[1]]]] <> " $ & " <> ToString[Length[#]]}&/@outlowerGath
]

Length[outlower]

(TeXForm/@outlowerGath/.{a[i_]:>{a,b,c,d,e,f,g}[[i+1]]})//ColumnForm

Length[outBiglower]

outBiglowerGath = Plus@@@((List@@outBiglower)//GatherBy[#, indices[#]&]&);
outBiglowerGath//ColumnForm
Fold[#1<>" \\\\ \n" <> #2&,
"",
{"$ I_"<>ToString[indices[#[[1]]]] <> " $ & " <> ToString[Length[#]]}&/@outBiglowerGath
]

" \\\\ \n$ I_{5} $ & 37 \\\\ \n$ I_{1, 4} $ & 29 \\\\ \n$ I_{2, 3} $ & 39 \\\\ \n$ I_{3, 2} $ & 41 \\\\ \n$ I_{4, 1} $ & 34 \\\\ \n$ I_{1, 1, 3} $ & 14 \\\\ \n$ I_{1, 2, 2} $ & 22 \\\\ \n$ I_{1, 3, 1} $ & 21 \\\\ \n$ I_{2, 1, 2} $ & 22 \\\\ \n$ I_{2, 2, 1} $ & 26 \\\\ \n$ I_{3, 1, 1} $ & 22"

outBiglowerGath

(TeXForm/@(2*outBiglowerGath//Expand/.{a[i_]:>{a,b,c,d,e,f,g}[[i+1]]}))//ColumnForm

(* ------- *)

cri2[{a_,b_,c_,d_}] /; a==c||b==d:=0

Format[cri2[l_List] , TeXForm] := TeXVerbatim[myFold[#1 <> " " <> #2&, ToString[TeXForm[#]]&/@l]]

iToCCR[hin:IIi[ind_List, arg_List]] := Module[{},(
If[Length[Union[arg[[All,1,1;;3]]]]==1,
Return[IIi[ind, {cri2[Join[arg[[1,1,1;;3]],arg[[All,1,4]]]]}]],
Return[IIi[ind, arg]]]
)];
iToCCR[lambda_ hin_IIi]/;NumberQ[lambda] := lambda iToCCR[hin];
iToCCR[a_Plus] :=  iToCCR[#]&/@a;

hcrsimp2[hin:H[a0_, alist_List, x_, alast_]] := Module[{},(
Return[H[0, cri2[{x, a0, alast, #}]&/@alist,Infinity, 1]]
)];
hcrsimp2[lambda_ hin_H]/;NumberQ[lambda] := lambda hcrsimp2[hin];
hcrsimp2[a_Plus] :=  hcrsimp2[#]&/@a;

out2 = (iToCCR@htoI@htoInfcr@hcrsimp2@Expand@reduceSimp[5])/.crinfsimp

out2

out2lower = Select[out2, Position[#, a[0]]≠{}&];

out2lowerGath = Plus@@@((List@@out2lower)//GatherBy[#, indices[#]&]&);
out2lowerGath//ColumnForm
Fold[#1<>" \\\\ \n" <> #2&,
"",
{"I_"<>ToString[indices[#[[1]]]] <> " & " <> ToString[Length[#]]}&/@out2lowerGath
]

Format[IIi[ind_List, args_List], TeXForm] := TeXVerbatim["[" <>ToString[myTeXList[args]]<> "]_{"<> ToString[myTeXList[ind]]<>"}"]

Fold[
#1 <> " \n " <> #2&,
"",
(ToString[TeXForm[#]]&/@(out2lowerGath/.{a[i_]:>{a,b,c,d,e,f,g}[[i+1]]}))
]

out2lower/.{a[i_]:>{a,b,c,d,e,f,g}[[i+1]]}

rule41to32 = IIi[{4,1},{cri2[{a_,b_,c_,d_,e_}]}]:>-(1/3 IIi[{3,2},{cri2[{a,b,c,d,e}]}]+1/3 IIi[{3,2},{cri2[{a,b,c,e,d}]}]);
rule14to32 = IIi[{1,4},{cri2[{a_,b_,c_,d_,e_}]}]:>-(4 IIi[{5},{cri2[{a,b,c,e}]}]+IIi[{5},{cri2[{a,b,d,e}]}]+1/3 IIi[{3,2},{cri2[{a,b,d,c,e}]}]+1/3 IIi[{3,2},{cri2[{a,b,d,e,c}]}]);
rule23to32 = IIi[{2,3},{cri2[{a_,b_,c_,d_,e_}]}]:>-(-IIi[{5},{cri2[{a,b,c,d}]}]+IIi[{3,2},{cri2[{b,a,d,c,e}]}]);

rule221to311 = IIi[{2,2,1},{cri2[{a_,b_,c_,d_,e_,f_}]}]:>-(+IIi[{3,1,1},{cri2[{a,b,c,d,e,f}]}]+IIi[{3,1,1},{cri2[{a,b,c,d,f,e}]}]+IIi[{3,1,1},{cri2[{a,b,c,f,d,e}]}]+IIi[{3,1,1},{cri2[{a,b,c,f,e,d}]}]);
rule131to311 = IIi[{1,3,1},{cri2[{a_,b_,c_,d_,e_,f_}]}]:>IIi[{3,1,1},{cri2[{a,b,c,f,e,d}]}];

rule113to311 = IIi[{1,1,3},{cri2[{a_,b_,d_,c_,f_,e_}]}]:>IIi[{3,1,1},{cri2[{a,b,c,d,e,f}]}]-(1/3)*(-IIi[{3,2},{cri2[{a,b,d,f,e}]}]-IIi[{3,2},{cri2[{a,b,f,c,e}]}]-IIi[{3,2},{cri2[{a,b,f,d,e}]}]-IIi[{3,2},{cri2[{a,b,f,e,d}]}]-IIi[{3,2},{cri2[{b,a,e,f,d}]}]+IIi[{3,2},{cri2[{b,a,f,e,c}]}]+IIi[{3,2},{cri2[{b,a,f,e,d}]}])+(16/3 IIi[{5},{cri2[{a,b,e,d}]}]-4/3 IIi[{5},{cri2[{a,b,f,d}]}]+7/3 IIi[{5},{cri2[{a,b,f,e}]}]+2 IIi[{5},{cri2[{a,b,c,e}]}]-4/3 IIi[{5},{cri2[{a,b,c,f}]}]);

rule122to311 =IIi[{1,2,2},{cri2[{a_,b_,c_,d_,e_,f_}]}]:>-IIi[{3,1,1},{cri2[{a,b,c,f,e,d}]}]-IIi[{3,1,1},{cri2[{a,b,d,c,e,f}]}]-IIi[{3,1,1},{cri2[{a,b,d,c,f,e}]}]-IIi[{3,1,1},{cri2[{a,b,d,e,c,f}]}]-2 IIi[{3,2},{cri2[{a,b,c,e,f}]}]+IIi[{3,2},{cri2[{a,b,c,f,e}]}]-2 IIi[{3,2},{cri2[{a,b,e,c,f}]}]-IIi[{3,2},{cri2[{a,b,e,f,d}]}]-IIi[{3,2},{cri2[{a,b,f,e,d}]}]-12 IIi[{5},{cri2[{a,b,c,f}]}]-6 IIi[{5},{cri2[{a,b,d,e}]}]-6 IIi[{5},{cri2[{a,b,d,f}]}]-6 IIi[{5},{cri2[{a,b,e,f}]}];

rule212to311 = IIi[{2,1,2},{cri2[{a_,b_,c_,d_,e_,f_}]}]:>IIi[{3,1,1},{cri2[{a,b,c,d,f,e}]}]+IIi[{3,1,1},{cri2[{a,b,c,f,d,e}]}]+IIi[{3,1,1},{cri2[{a,b,c,f,e,d}]}]+IIi[{3,1,1},{cri2[{a,b,d,c,e,f}]}]+IIi[{3,1,1},{cri2[{a,b,d,e,c,f}]}]+IIi[{3,1,1},{cri2[{a,b,e,d,c,f}]}]+IIi[{3,2},{cri2[{a,b,c,d,f}]}]+2 IIi[{3,2},{cri2[{a,b,c,e,f}]}]-IIi[{3,2},{cri2[{a,b,c,f,d}]}]-IIi[{3,2},{cri2[{a,b,c,f,e}]}]+IIi[{3,2},{cri2[{a,b,d,c,f}]}]+IIi[{3,2},{cri2[{a,b,d,e,f}]}]+2 IIi[{3,2},{cri2[{a,b,e,c,f}]}]+IIi[{3,2},{cri2[{a,b,e,d,f}]}]-IIi[{3,2},{cri2[{a,b,e,f,c}]}]+12 IIi[{5},{cri2[{a,b,c,f}]}]+6 IIi[{5},{cri2[{a,b,d,f}]}]+12 IIi[{5},{cri2[{a,b,e,f}]}];

outas32and311 = out2lower/.{a[i_]:>{a,b,c,d,e,f,g}[[i+1]]}/.{rule221to311,rule212to311,rule122to311,rule113to311,rule131to311,rule41to32,rule14to32,rule23to32}//Expand

full = outas32and311 - (outas32and311/.{a->g})

outas32and311Gath = Plus@@@((List@@outas32and311)//GatherBy[#, indices[#]&]&);
outas32and311Gath//ColumnForm
Fold[#1<>" \\\\ \n" <> #2&,
"",
{"I_"<>ToString[indices[#[[1]]]] <> " & " <> ToString[Length[#]]}&/@outas32and311Gath
]

Format[IIi[inds_List, args_List], TeXForm] := TeXVerbatim["[" <>ToString[myTeXList[args]]<> "]"]

3*Plus@@Cases[outas32and311Gath[[1]], c_Rational x_IIi:>c x]//Expand

Plus@@Cases[outas32and311Gath[[1]], (c_:1) x_IIi/;Head[c]=!=Rational:>c x]

3*Plus@@Cases[outas32and311Gath[[2]], c_Rational x_IIi:>c x]//Expand

Plus@@Cases[outas32and311Gath[[2]], (c_:1) x_IIi/;Head[c]=!=Rational:>c x]

outas32and311Gath[[3]]

(* ----------------------- *)

crorbit[a_,b_,c_,d_] := Sort[{{a,b,c,d},{b,a,d,c},{c,d,a,b},{d,c,b,a}}][[1]]

i311to32rule = IIi[{3,1,1}, {cri2[{a_,b_,c_,d_,e_,f_}]}]:>(1/3)*(IIi[{3,2},{cri2[{a,b,c,d,e}]}]+IIi[{3,2},{cri2[{a,b,c,d,f}]}]+IIi[{3,2},{cri2[{a,b,c,e,d}]}]+IIi[{3,2},{cri2[{a,b,c,f,d}]}]-IIi[{3,2},{cri2[{a,c,b,d,f}]}]-IIi[{3,2},{cri2[{a,c,b,f,d}]}]-IIi[{3,2},{cri2[{a,d,b,e,f}]}]-IIi[{3,2},{cri2[{a,d,b,f,e}]}]+IIi[{3,2},{cri2[{b,a,f,c,e}]}]+IIi[{3,2},{cri2[{b,a,f,e,c}]}]-IIi[{3,2},{cri2[{b,f,a,c,e}]}]-IIi[{3,2},{cri2[{b,f,a,e,c}]}]++IIi[{3,2},{cri2[{a,b,c,e}],cri2[{a,c,b,d}]}]+IIi[{3,2},{cri2[{a,b,c,e}],cri2[{a,d,b,c}]}]+IIi[{3,2},{cri2[{a,b,c,f}],cri2[{a,d,c,b}]}]-IIi[{3,2},{cri2[{a,b,d,f}],cri2[{a,e,b,f}]}]-IIi[{3,2},{cri2[{a,b,e,f}],cri2[{a,d,e,b}]}]-IIi[{3,2},{cri2[{a,b,e,f}],cri2[{a,e,d,b}]}]+IIi[{3,2},{cri2[{a,c,b,d}],cri2[{a,b,c,e}]}]+IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,b,c,e}]}]-IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,b,f,c}]}]+IIi[{3,2},{cri2[{a,d,b,e}],cri2[{a,b,f,e}]}]-IIi[{3,2},{cri2[{a,d,b,f}],cri2[{a,e,b,d}]}]+IIi[{3,2},{cri2[{a,e,b,d}],cri2[{a,b,f,e}]}]-IIi[{3,2},{cri2[{a,e,b,d}],cri2[{a,d,b,f}]}]-IIi[{3,2},{cri2[{a,e,b,f}],cri2[{a,b,d,f}]}]++IIi[{3,2},{cri2[{a,b,c,d}],cri2[{a,b,f,e}]}]-IIi[{3,2},{cri2[{a,b,e,f}],cri2[{a,b,d,c}]}]-IIi[{3,2},{cri2[{a,b,e,f}],cri2[{a,d,b,c}]}]+IIi[{3,2},{cri2[{a,c,b,d}],cri2[{a,e,c,f}]}]-IIi[{3,2},{cri2[{a,c,b,d}],cri2[{b,c,e,f}]}]-IIi[{3,2},{cri2[{a,c,b,d}],cri2[{b,e,c,f}]}]-IIi[{3,2},{cri2[{a,c,d,f}],cri2[{a,d,b,e}]}]-IIi[{3,2},{cri2[{a,c,d,f}],cri2[{a,e,b,d}]}]+IIi[{3,2},{cri2[{a,c,d,f}],cri2[{a,e,b,f}]}]-IIi[{3,2},{cri2[{a,c,e,f}],cri2[{a,d,b,c}]}]+IIi[{3,2},{cri2[{a,c,e,f}],cri2[{a,d,b,e}]}]+IIi[{3,2},{cri2[{a,c,e,f}],cri2[{a,e,b,d}]}]-IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,b,e,f}]}]-IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,c,e,f}]}]-IIi[{3,2},{cri2[{a,d,b,e}],cri2[{a,c,d,f}]}]+IIi[{3,2},{cri2[{a,d,b,e}],cri2[{a,c,e,f}]}]-IIi[{3,2},{cri2[{a,e,b,d}],cri2[{a,c,d,f}]}]+IIi[{3,2},{cri2[{a,e,b,d}],cri2[{a,c,e,f}]}]+IIi[{3,2},{cri2[{a,e,b,f}],cri2[{a,c,d,f}]}]+IIi[{3,2},{cri2[{a,e,c,f}],cri2[{a,c,b,d}]}]+IIi[{3,2},{cri2[{a,f,b,e}],cri2[{b,c,d,f}]}]+IIi[{3,2},{cri2[{b,c,d,f}],cri2[{a,f,b,e}]}]-IIi[{3,2},{cri2[{b,c,e,f}],cri2[{a,c,b,d}]}]-IIi[{3,2},{cri2[{b,e,c,f}],cri2[{a,c,b,d}]}]);

i311to32rule2 = IIi[{3,1,1}, {cri2[{a_,b_,c_,d_,e_,f_}]}]:>(1/3)*(2 IIi[{3,2},{cri2[{a,b,c,d,e}]}]-IIi[{3,2},{cri2[{a,b,c,e,d}]}]-IIi[{3,2},{cri2[{a,c,b,d,f}]}]-IIi[{3,2},{cri2[{a,c,b,f,d}]}]+IIi[{3,2},{cri2[{b,f,a,d,e}]}]+IIi[{3,2},{cri2[{b,f,a,e,c}]}]+IIi[{3,2},{cri2[{b,f,a,e,d}]}]-1/2 IIi[{3,2},{cri2[{a,b,c,e}],cri2[{a,c,b,d}]}]+1/2 IIi[{3,2},{cri2[{a,b,e,c}],cri2[{a,c,b,d}]}]+IIi[{3,2},{cri2[{a,b,f,e}],cri2[{a,f,b,d}]}]-1/2 IIi[{3,2},{cri2[{a,c,b,d}],cri2[{a,b,c,e}]}]+1/2 IIi[{3,2},{cri2[{a,c,b,d}],cri2[{a,b,e,c}]}]+IIi[{3,2},{cri2[{a,e,b,f}],cri2[{a,f,b,c}]}]+IIi[{3,2},{cri2[{a,f,b,c}],cri2[{a,e,b,f}]}]+IIi[{3,2},{cri2[{a,f,b,d}],cri2[{a,b,f,e}]}]-1/2 IIi[{3,2},{cri2[{a,b,d,e}],cri2[{b,f,d,c}]}]+1/2 IIi[{3,2},{cri2[{a,b,d,e}],cri2[{b,f,e,c}]}]-1/2 IIi[{3,2},{cri2[{a,b,e,d}],cri2[{b,f,d,c}]}]+1/2 IIi[{3,2},{cri2[{a,b,e,d}],cri2[{b,f,e,c}]}]-IIi[{3,2},{cri2[{a,c,b,d}],cri2[{a,e,f,b}]}]+IIi[{3,2},{cri2[{a,c,b,d}],cri2[{b,f,e,c}]}]-IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,e,f,b}]}]-IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,f,e,b}]}]+IIi[{3,2},{cri2[{a,d,b,c}],cri2[{a,f,e,c}]}]-IIi[{3,2},{cri2[{a,d,c,f}],cri2[{a,e,f,b}]}]-IIi[{3,2},{cri2[{a,d,c,f}],cri2[{a,f,e,b}]}]+IIi[{3,2},{cri2[{a,e,b,f}],cri2[{a,d,c,b}]}]-IIi[{3,2},{cri2[{a,e,b,f}],cri2[{b,c,d,f}]}]-IIi[{3,2},{cri2[{a,e,f,b}],cri2[{a,d,c,f}]}]+IIi[{3,2},{cri2[{a,f,b,e}],cri2[{a,d,c,b}]}]-IIi[{3,2},{cri2[{a,f,c,e}],cri2[{a,d,c,b}]}]-IIi[{3,2},{cri2[{a,f,e,b}],cri2[{a,d,c,f}]}]-IIi[{3,2},{cri2[{b,c,d,f}],cri2[{a,e,b,f}]}]-1/2 IIi[{3,2},{cri2[{b,f,d,c}],cri2[{a,b,d,e}]}]-1/2 IIi[{3,2},{cri2[{b,f,d,c}],cri2[{a,b,e,d}]}]+1/2 IIi[{3,2},{cri2[{b,f,e,c}],cri2[{a,b,d,e}]}]+1/2 IIi[{3,2},{cri2[{b,f,e,c}],cri2[{a,b,e,d}]}]+IIi[{3,2},{cri2[{b,f,e,c}],cri2[{a,c,b,d}]}]);

outas32only = outas32and311/.i311to32rule/.cri2[{a_,b_,c_,d_}] :> cri2[crorbit[a,b,c,d]]//Expand;

outas32onlyGath = GatherBy[List@@outas32only, indices]

outas32only32terms = Plus@@outas32onlyGath[[2]];

outas32only32terms//Length

args[expr_] := If[Head[expr]===IIi, Return[expr[[2]]], Cases[expr, IIi[ind_,arg_]:>arg][[1]]]/.cri2->Identity;

args2[expr_] := If[Length[args[expr]]==1, {args[expr][[1,{1,2,3,4}]],args[expr][[1,{1,2,3,5}]]}, args[expr]]

outas32only32termsGATH = GatherBy[List@@outas32only32terms, {Count[Flatten[args2[#]], Inf],If[Length[args[#]]==1, $ccr, If[Length@Union[Join@@args[#]] == 5, $5cr, $6cr]]}&]

({Count[Flatten[args2[#[[1]]]], Inf],If[Length[args[#[[1]]]]==1, $ccr, If[Length@Union[Join@@args[#[[1]]]] == 5, $5cr, $6cr]], #}&/@outas32only32termsGATH)//ColumnForm//Print

Length/@outas32only32termsGATH

Plus@@%

outas32only32terms//Length