Arrow Diagrams and gl(N) - Testing

Joint project of Louis Leung and Dror Bar - Natan.

Testing

Place[{ar}, {1,3}]

Place[{ar,ar}, {1,2,3,4}]

{Place[{ar,ar, ar,ar}, {1,2,3,4,5,6,7,8}] // Length, 8!/4!}

Place[{R6T}, {1,2,3}]

Place[{ar, R6T}, {1,2,3,4,5}]

Place[{R6T, ar}, {1,2,3,4,5}]

Place[{R6T, ar,ar}, {1,2,3,4,5,6,7}]

R[Diag[R6T[1,2,3],ar[4,5],ar[6,7]]]

diag = Diag[ar[1,2],ar[1.5`,3],ar[4,5],ar[6,7]]

indices = Union@@ (List @@ diag /. ar -> List)

Thread[indices -> Range[Length[indices]]]

NormalizeDiag[Diag[ar[1,2],ar[1.5`,3],ar[4,5],ar[6,7]]]

?Append

k=7;
Table[ar, {k}]~Append~R6T

Permutations[%]

diags=Diagrams[4ar]

rels=R /@ Diagrams[R6T+2ar]

DimAArrow[1]

DimAArrow[2]

DimAArrow[3]

DimAArrow[4] // Timing

a>b && b>a // FullForm

Expand[((a<b )+1/2(e<f))*(b<c)*(a>c)]

diag=Diag[ar[5,4],ar[6,3],ar[7,1],ar[8,2]]

p=Times @@ (diag /. ar[i_,j_] :>eq[i,j-1]eq[i-1, j](lt[i-1, i]+heq[i-1,i]));
While[!FreeQ[p, eq],
p = (p 
/. Cases[p, eq[i_, j_]:> (i->j), Infinity, 1]
/. {
eq[i_,i_] -> 1,
lt[i_, i_] ->0
}
)
]

p

ineqs=Expand[p /. heq[i_, j_] :> heq[i,j]/2] /.  {e_heq^_ :> e}

l=Length[indices=Union@@ Cases[ineqs, (lt|heq)[i_, j_] :> {i, j}, Infinity]]

indices

ineqs=ineqs /. {
e_heq :> (e /. Thread[indices -> Range[l]]),
e_lt :> (e /. Thread[indices -> Range[l]])
}

ineq = heq[1,1] heq[2,1] lt[3,2]

While[!FreeQ[ineq, heq],
ineq = (ineq 
/. Cases[ineq, heq[i_, j_]:> (i->j), Infinity, 1]
/. {
heq[i_,i_] -> 1,
lt[i_, i_] ->0
}
)
]

ineq

OrderTypes[1] = {{1}};
OrderTypes[l_List] := Module[{nl, snl},
(
snl=Union[nl = Append[l, #]];
nl /. Thread[snl -> Range[Length[snl]]]
)& /@ Range[1/2, 1/2+Max[l], 1/2]
];
OrderTypes[n_Integer] := OrderTypes[n] = Join @@ (OrderTypes /@ OrderTypes[n-1])

OrderTypes[{2,1,3}]

OrderTypes[2]

OrderTypes[3]

OrderTypes[4]

OrderTypes[6]

l

ineqs

OrderTypes[l]

((ineqs /. {
heq[i_, j_] :> If[#[[i]]==#[[j]], 1, 0],
lt[i_,j_] :> If[#[[i]]<#[[j]], 1, 0]
} 
)* n^Max[#]
)& /@ OrderTypes[l]

n

Expand[
(R /@ Diagrams[R6T+2ar]) /. diag_Diag :> Wgl[diag]
]

Position[%, ((7 n)/64)]

Diagrams[R6T+1ar][[63]]

Diag[ar[3,5],R6T[1,4,2]] // R

Wgl /@ Cases[Diag[ar[3,5],R6T[1,4,2]] // R, _Diag, Infinity]

Cases[Diag[ar[3,5],R6T[1,4,2]] // R, _Diag, Infinity]

(R /@ Diagrams[R6T+0ar])[[1]]

Wgl /@ {Diag[ar[1,2],ar[3,4]], Diag[ar[1,3],ar[2,4]], Diag[ar[1,4],ar[2,3]]}

Wgl /@ Diagrams[1ar]

WglE[diag_Diag] := Wgl[Join[Diag[ar[-1,0]], diag]]

WglEE[diag_Diag] := Wgl[Join[Diag[ar[-3,-2],ar[-1,0]], diag]]

WglE /@ Diagrams[1ar]

k

Wgl /@ Diagrams[3ar]

Expand[
(R /@ Diagrams[R6T+2ar]) /. diag_Diag :> Wgl[diag]
]

WglEE /@ Diagrams[2ar]

mat={
Coefficient[Wgl[#], n],
Coefficient[Wgl[#], n^3],
Coefficient[WglE[#], n^2],
Coefficient[WglE[#], n^4],
Coefficient[WglEE[#], n],
Coefficient[WglEE[#], n^3],
Coefficient[WglEE[#], n^5]
}& /@ Diagrams[2ar]

MatrixRank[mat]

diag=Diag[ar[5,4],ar[6,3],ar[7,1],ar[8,2]]

p=diag /. ar[i_,j_] :>Sequence[eq[i,j-1],eq[i-1, j],ltheq[i-1, i]]

While[!FreeQ[p, eq],
p=(p 
/. Cases[p, eq[i_, j_]:> (i->j), Infinity, 1]
/. {
eq[i_,i_] -> Sequence[]
}
)
];p

diag=Diagrams[2ar][[4]]

Wgl[diag]

Sum[
Wgl[diag],
{k,1,n}
]

WglOld[diag]

p=Append[
diag /. ar[i_,j_] :>Sequence[eq[i,j-1],eq[i-1, j],ltheq[i-1, i]],
s[0]
]

While[!FreeQ[p, eq],
p=(p 
/. Cases[p, eq[i_, j_]:> (i->j), Infinity, 1]
/. {
eq[i_,i_] -> Sequence[]
}
)
]; p

Wgl[Diag[ar[2,1],ar[4,3]]]

(k-1)^2+Binomial[k-1,1]+1/4 // Expand

l=Length[indices=Union@@ Cases[{p}, ltheq[i_, j_] :> {i, j}, Infinity]];
ineqs= p /. Thread[indices -> Range[l]]

{i0} = Cases[ineqs, s[i_] :> i, {1}, 1]

ineqs = DeleteCases[ineqs, _s]

l

OrderTypes[3]

v=Wgl /@ Diagrams[2ar]

MatrixRank[Table[
v /. {n->Random[], k-> Random[]},
{50}
]]

RankWgl[m_] := Module[{v, n, k},
v=Wgl[n,k,#]& /@ Diagrams[m*ar];
MatrixRank[Table[
v /. {n->Random[], k-> Random[]},
{Length[v]}
]]
]

RankWgl[4]

Wgl[Diag[ar[1,2],ar[4,6],ar[5,3]]]

Wgl[Diag[ar[1,2],ar[4,6],ar[5,3]]][n,k]