Clear[qInteger]
qInteger[n_]:=qInteger[n]=Function[{q},Evaluate[Expand[Together[(((q^n)-(q^(-n)))/(q-(q^(-1))))]]]]

qInteger[7][q]

Clear[t]

t[multiplicities_]:=t[multiplicities]=Union[RootReduce[qInteger[2]/@Cases[q/.Solve[Plus@@(#[[2]]qInteger[#[[1]]+1][q]&/@multiplicities)==0,{q}],Q_/;((Im[Q]==0∧Q>=1)(*∨Abs[Q]==1*))]]]

t[{{3,2},{7,-1}}]

t[{{6,1},{0,1},{4,-1},{2,-1}}]

t[{{1,1},{3,1},{5,1},{7,-1}}]

N[%]

Clear[ts]

ts[max_,range_]:=ts[max,range,range]
ts[max_,range_,maxRange_]:=SortBy[DeleteCases[{#,t[#],N[t[#]]}&/@Flatten[Table[Table[{k,i[k]},{k,Mod[max,2],max,2}],Evaluate[Sequence@@(Table[{i[k],-range,range},{k,Mod[max,2],max-2,2}]~Join~{{i[max],1,maxRange}})]],Ceiling[(max-1)/2]],{_,{},{}}],#[[3]]&]

ts[6,2,1]

ts[6,3,1]

ts[7,1]

ts[8,1]

ts[9,1]

FusionAtlasPaths={"c:\\scott\\projects\\fusionatlas\\code\\package\\","~/Documents/math papers/fusionatlas/code/package/","~/Documents/Math/fusionatlas/code/package/"};
$Path=$Path~Join~FusionAtlasPaths;
<<FusionAtlas`

f[g_GradedBigraph,(1|2),-1]:=0
f[g_GradedBigraph,n:(1|2),0]:=V[n,0,1]

f[g_GradedBigraph,n:(1|2),k_Integer]/;k>0:=(f[g,n,k-1]/.V[n,d_,l_]:>If[d>0,(Transpose[g[[d]]].UnitVector[RankAtDepth[g,d],l]).Table[V[n,d-1,j],{j,1,RankAtDepth[g,d-1]}],0]+If[d<GraphDepth[g],(g[[d+1]].UnitVector[RankAtDepth[g,d],l]).Table[V[n,d+1,j],{j,1,RankAtDepth[g,d+1]}],0])-f[g,n,k-2]

f[DnBigraph[6],1,1]

f[DnBigraph[6],1,2]

f[DnBigraph[6],1,3]

f[DnBigraph[6],1,4]

f[DnBigraph[6],1,5]

TLEquation[g_GradedGraph,k_Integer,l_Integer]:=t[f[g,k],f[g,l]]==Sum[f[g,j],{j,Abs[k-l],k+l,2}]

TLEquations[g_GradedGraph]:=Union[Flatten[Table[TLEquation[g,k,l],{k,0,GraphDepth[g]},{l,0,GraphDepth[g]}],1]]

TLEquation[g1_GradedBigraph,g2_GradedBigraph,n_Integer,k_Integer,l_Integer]:=
Module[{g},
g[1]=g1;g[2]=g2;
t[f[g[n],n,k],f[g[Mod[n+k+1,2]+1],Mod[n+k+1,2]+1,l]]==Sum[f[g[n],n,j],{j,Abs[k-l],k+l,2}]
]

TLEquations[g1_GradedBigraph,g2_GradedBigraph]:=With[{depth=Max[GraphDepth[g1],GraphDepth[g2]]},Union[Flatten[Table[TLEquation[g1,g2,n,k,l],{n,1,2},{k,0,depth},{l,0,depth}],2]]
]

TLEquations[DnBigraph[6],DnBigraph[6]]

TLEquation[DnBigraph[6],2,3]

fc[g_GradedBigraph,k_]:=f[g,1,k]/.V[1,d_,n_]:>UnitVector[GraphRank[g],Sum[RankAtDepth[g,l],{l,0,d-1}]+n]

NullSpace[Transpose[Table[fc[HaagerupBigraph,k],{k,0,6}]]]

NullSpace[Transpose[Table[fc[HaagerupBigraph,k],{k,0,7}]]]

relation[g_GradedBigraph]:=Module[{nullspace,j=0},
While[(nullspace=NullSpace[Transpose[Table[fc[g,k],{k,0,j}]]])=={},j++];
nullspace
]

relation[HaagerupBigraph]

relation[DnBigraph[16]]

relation[EnBigraph[8]]

Transpose[Table[fc[EnBigraph[8],k],{k,0,15}]].{0,0,0,0,0,0,0,0,0,0,0,0,0,-1,0,1}

relation[DnBigraph[6]]

relation[DnBigraph[16]]

relation[EnBigraph[8]]

IzumiStarBigraph[p_]/;p≥2:=GradedBigraph@@(Table[{{1}},{3}]~Join~{Table[{1},{p-1}]}~Join~Table[IdentityMatrix[p-1],{2}])

NumericDimensionOfGenerator[IzumiStarBigraph[3]]

NumericDimensionOfGenerator[IzumiStarBigraph[5]]

relation[IzumiStarBigraph[5]]

ExtendedDnBigraph[4]=GradedBigraph[{{1}},{{1},{1},{1}}];

ExtendedDnBigraph[n_]/;n>4:=GradedBigraph@@({{{1}},{{1},{1}},{{1,0}}}~Join~Table[{{1}},{n-6}]~Join~{{{1},{1}}})

DisplayBigraph[ExtendedDnBigraph[6]]

relation[ExtendedDnBigraph[6]]

relation[ExtendedDnBigraph[7]]

relation[ExtendedDnBigraph[8]]

relation[ExtendedDnBigraph[9]]

HexagonBigraph[n_]:=AnBigraph[n-5]~Join~GradedBigraph[{{1},{1}},IdentityMatrix[2],{{1,1}}]

DualHexagonBigraph[n_]:=AnBigraph[n-5]~Join~GradedBigraph[{{1},{1}},{{1,0},{1,0}},IdentityMatrix[2]]

DisplayBigraph[HexagonBigraph[11]]

DisplayBigraph[DualHexagonBigraph[11]]

relation[HexagonBigraph[11]]

relation[DualHexagonBigraph[11]]

HaagerupAsaedaBigraph=trivalentBigraph[5,2,2]~Join~GradedBigraph[{{1,0},{1,0},{0,1}},{{0,0,1}},{{1}}];

DisplayBigraph[HaagerupAsaedaBigraph]

DualHaagerupAsaedaBigraph=dualHaagerupFamilyBigraph[5]~Join~GradedBigraph[{{1,0}},{{1}}]

DisplayBigraph[DualHaagerupAsaedaBigraph]

relation[HaagerupAsaedaBigraph]

relation[DualHaagerupAsaedaBigraph]

ExtendedEnBigraph[6]:=trivalentBigraph[2,2,2]
ExtendedEnBigraph[7]:=trivalentBigraph[3,1,3]
ExtendedEnBigraph[8]:=trivalentBigraph[5,1,2]

relation/@Table[ExtendedEnBigraph[k],{k,6,8}]

graphs=FindBigraphExtensionsUpToRank[3][HaagerupBigraph,12]

DisplayBigraph/@graphs

{DisplayBigraph[#],relation[#],Length[relation[#][[1]]]-2-GraphDepth[#]}&/@graphs

{Length[relation[#][[1]]]-2-GraphDepth[#]}&/@Table[DnBigraph[k],{k,4,8}]~Join~Table[EnBigraph[k],{k,6,8}]~Join~Table[ExtendedDnBigraph[k],{k,4,8}]~Join~Table[ExtendedEnBigraph[k],{k,6,8}]~Join~{HaagerupBigraph,HaagerupAsaedaBigraph,HexagonBigraph[11]}

StableLowWeightSpaceDimensions[g_GradedBigraph]/;DimensionOfGenerator[g]>2:=Table[DimensionOfLowWeightSpace[g][k],{k,0,GraphDepth[g]}]

StableLowWeightSpaceDimensions[g_GradedBigraph]/;DimensionOfGenerator[g]≤2:=Table[DimensionOfLowWeightSpace[g][k],{k,0,1}]

StableLowWeightSpaceDimensions[HaagerupAsaedaBigraph]

relation[HaagerupAsaedaBigraph]