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

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])

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

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;

rule22to13and31 = IIi[{2,2},{x_,y_}] :>(-IIi[{1,3},{x,y}]- IIi[{3,1},{x,y}] - IIi[{1,3},{y,x}]);

rule13to31 = IIi[{1,3},{x_,y_}]:>(- IIi[{3,1},{x,x/y}] + IIi[{4},{x}]);

rule31to22 = IIi[{3,1},{x_,y_} ] :>(- (1/2)(IIi[{2,2},{x,y}]- IIi[{2,2},{y,x}]));

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

(* cr[{a,b,c,d}]/cr[{a,b,c,e}] == cr[{a,b,e,d}] *)

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

outInitial = htoI@htoInfcr@hcrsimp[Expand[reduce[4]]];

outI31 = outInitial/.rule22to13and31/.rule13to31//Expand;

outI31simp = outI31/.crratiosimp;

outI22= outI31/.rule31to22//Expand;

outI22simp = outI22/.crratiosimp;

outi31i4 = 2*outI31simp/.crinfsimp/.{a[i_]:>{a,b,c,d,e,f}[[i+1]]}/.Except[IIi[{4}, {___}],IIi[{___}, {___}]]:>0//Expand//Select[#, Position[#, a]≠{}&]&

outi31i31 = 2*outI31simp/.crinfsimp/.{a[i_]:>{a,b,c,d,e,f}[[i+1]]}/.Except[IIi[{3,1}, {___}],IIi[{___}, {___}]]:>0//Expand//Select[#, Position[#, a]≠{}&]&

Format[IIi[{4}, args_List], TeXForm] := TeXVerbatim["[" <>ToString[myTeXList[args]]<> "]"]
Format[IIi[{3,1}, args_List], TeXForm] := TeXVerbatim["[" <>ToString[myTeXList[args]]<> "]"]

outi31i4//TeXForm//ToString//Print

outi31i31//TeXForm//ToString//Print

outi22i4  = 2*outI22simp/.crinfsimp/.{a[i_]:>{a,b,c,d,e,f}[[i+1]]}/.Except[IIi[{4}, {___}],IIi[{___}, {___}]]:>0//Expand//Select[#, Position[#, a]≠{}&]&

outi22i22 = 4*outI22simp/.crinfsimp/.{a[i_]:>{a,b,c,d,e,f}[[i+1]]}/.Except[IIi[{2,2}, {___}],IIi[{___}, {___}]]:>0//Expand//Select[#, Position[#, a]≠{}&]&

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

outi22i4//TeXForm//ToString//Print

outi22i22//TeXForm//ToString//Print

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

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

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

rule13to31/.RuleDelayed[a_,b_]:>a==b/.Pattern->(#&)//TeXForm

rule22to13and31/.RuleDelayed[a_,b_]:>a==b/.Pattern->(#&)//TeXForm

rule31to22/.RuleDelayed[a_,b_]:>a==b/.Pattern->(#&)//TeXForm