SetDirectory["C:/drorbn/AcademicPensieve/Projects/Arrow_Diagrams_and_gl(N)"];
<< "Arrow_Diagrams_and_gl(N).m"

diag=Diag[ar[1,3],ar[4,2]]

t1= List@@Expand[(Times @@ diag) /. ar[p_,q_] :> 
LTAt[p,q] + 1/2(EQAt[p,q] - CAt[p]+CAt[q]-CAt[])
]

dirs=-(1/4) CAt[4] EQAt[1,3]

coeff= dirs /. (_CAt|_EQAt|_LTAt)-> 1;
k=0;
w= Table[1, {2Length[diag]}];
ltpairs = {};
dirs /. {
LTAt[p_,q_] :> (
w[[p]] = e[i=++k, j=++k];
w[[q]] = e[j,i];
AppendTo[ltpairs, {i,j}];
),
EQAt[p_, q_] :> (w[[p]] = w[[q]] = e[i=++k, i];),
CAt[p_] :> (
w[[p]] = e[i=++k, i];
coeff *= h[i];
),
CAt[] :> (coeff *= h[++k]^2;)
};
w = DeleteCases[w, 1];
{coeff, k, ltpairs, w}

OrderTypes[k, ltpairs]

ot={2,1}

coeff /. h[i_] :> h[ot[[i]]]

W@@w /. e[i_, j_] :> alpha[ot[[i]], ot[[j]]]

combfact = Binomial[n, Max[ot]]

Clear[UGLnBiAlg];
UGLnBiAlg[diag_Diag] := UGLnBiAlg[diag] = Module[
{allterms, s, LTAt, EQAt, CAt, m1, m2, dirs, coeff, k, ltpairs, w, allots},
allterms= List@@Expand[(Times @@ diag) /. ar[p_,q_] :> 
LTAt[p,q] + 1/2(EQAt[p,q] - CAt[p]+CAt[q]-CAt[])
];
s=Sum[
dirs=allterms[[m1]];
coeff= dirs /. (_CAt|_EQAt|_LTAt)-> 1;
k=0;
w= Table[1, {2Length[diag]}];
ltpairs = {};
dirs /. {
LTAt[p_,q_] :> (
w[[p]] = e[i=++k, j=++k];
w[[q]] = e[j,i];
AppendTo[ltpairs, {i,j}];
),
EQAt[p_, q_] :> (w[[p]] = w[[q]] = e[i=++k, i];),
CAt[p_] :> (
w[[p]] = e[i=++k, i];
coeff *= h[i];
),
CAt[] :> (coeff *= h[++k]^2;)
};
w = DeleteCases[w, 1];
allots = OrderTypes[k, ltpairs];
Sum[
ot=allots[[m2]];
Times[
(* Binomial[n, Max[ot]], *)
n^Max[ot],
coeff /. h[i_] :> h[ot[[i]]],
W@@w /. e[i_, j_] :> alpha[ot[[i]], ot[[j]]]
],
{m2, Length[allots]}
], {m1, Length[allterms]}
];
CanonicalForm[Expand[s]]
];
UGLnBiAlg[expr_] := Expand[expr /. diag_Diag :> UGLnBiAlg[diag]];

diag

UGLnBiAlg[diag]

rels=R/@Diagrams[R6T]

UGLnBiAlg[rels]

Print[# -> Short[UGLnBiAlg[#],3]]& /@ Diagrams[3ar]

rels3=R/@Diagrams[R6T+1ar];
Expand[UGLnBiAlg[rels3]]

vs = UGLnBiAlg /@ Diagrams[3ar]

MonomialsIn[expr_] /; !MemberQ[{List, Plus, Times}, Head[expr]] := {expr};
MonomialsIn[p_Times] := {Replace[p, c_?NumberQ  :> 1, {1}]};
MonomialsIn[l_List] := Union @@ (MonomialsIn /@ l);
MonomialsIn[s_Plus] := MonomialsIn[List @@ s];

ts=MonomialsIn[vs]

rule=Dispatch[Thread[ts -> Array[b, {Length[ts]}]]]

mat = SparseArray[
Join @@ Table[
v=vs[[i]];
Table[
t=v[[j]];
c=t/. {_h->1, _RW->1, n->1};
{i, Replace[t/c, rule] /. b[k_] :>k} -> c,
{j, Length[v]}
],
{i,Length[vs]}
],
{Length[vs1], Length[ts]}
]

MatrixRank[mat]