FusionAtlasPaths={"~/projects/fusionatlas/code/package/"};
$Path=$Path~Join~FusionAtlasPaths;
<<FusionAtlas`

SetDebugMode[True]

DisplayBigraph/@({g1,g2}=GraphFromString/@{"bwd1v1v1v1p1v1x0p0x1v1x0p1x0p0x1p0x1v0x1x0x0p0x0x1x0v1x0p0x1v1x0p0x1duals1v1v1x2v1x3x2x4v1x2","bwd1v1v1v1p1v1x0p1x0v1x0p0x1v0x1p1x0v1x0p0x1v0x1p1x0duals1v1v1x2v1x2v2x1"})

DisplayBigraph[g=g1[[1]]]

c=5;

r=1;λ=-1;

RelativeDimensionsByDepth[g1,g2,1][d,0,q]

Clear[LopsidedDimension]

LopsidedDimension[_GradedBigraph,Vertex[d_,k_]]:=Together[If[OddQ[d],(1/(q+(q^(-1)))),1]RelativeDimensionsByDepth[g1,g2][d,0,q][[1,d+1,k]]]

n=DepthOfBranchPoint[g]+1;

gc=Append[Truncate[g,c],IdentityMatrix[RankAtDepth[g,c]]]

gc=Truncate[g,c+1]

kernel=FusionAtlas`GraphPlanarAlgebra`Private`VariableGPAElement[gc,False,{n,n},f];

conditions=Flatten[GPACoefficients[CapAt[#,1]]~Join~GPACoefficients[CapAt[#,2]]&/@NestList[RotateTwoClicks,kernel,n-1],1]~Join~GPACoefficients[RotateTwoClicks[kernel]-λ kernel]

Length[conditions]

FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[Truncate[g,c]]

maxDepthOfPathsBetween[v1_,v2_]:=Max[Cases[#,Vertex[d_,_]:>d]&/@FusionAtlas`GraphPlanarAlgebra`Private`GraphPathsBetween[g1[[1]],n,v1,v2]]

Outer[maxDepthOfPathsBetween,FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[gc],FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[gc]]

Flatten[Outer[List,FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[Truncate[g,c]],FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[Truncate[g,c]]],1]

allowedPairs=Cases[Flatten[Outer[List,FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[Truncate[g,c]],FusionAtlas`GraphPlanarAlgebra`Private`EvenVertices[Truncate[g,c]]],1],{v1_,v2_}/;maxDepthOfPathsBetween[v1,v2]≤c]

allowedPairs=DeleteCases[allowedPairs,{___,Vertex[0,1],___}]

allowedPaths=Flatten[Outer[Function[{p1,p2},p1~Join~Reverse[Take[p2,{2,-2}]]],#,#,1]&/@(FusionAtlas`GraphPlanarAlgebra`Private`GraphPathsBetween[g,n,#[[1]],#[[2]]]&/@allowedPairs),2];

Length[allowedPaths]

relativeConditions=Cases[conditions,c_/;Length[Complement[Union[Cases[c,_f,∞]],f/@allowedPaths]]==0]

Length[relativeConditions]

variables=Union[Cases[relativeConditions,_f,∞]];

Length[variables]

lastVariables=Cases[variables,f[{Vertex[2,1],_,_,_,Vertex[4,_],_,Vertex[3,1],_,Vertex[4,_],_,Vertex[3,1],_,Vertex[4,_],__}]]

variables=Complement[variables,lastVariables];

Length[variables]

solution=Solve[relativeConditions==0,variables~Join~lastVariables,variables][[1]]/.(a_f->b_):>(a->Collect[b,_f,Together]);

solution

lastVariables/.solution

matrices=(Cases[GPAMatrix[kernel][[-1]],Alternatives@@(#->_&/@allowedPairs)]/.solution);

remainingVariables=Union[Cases[matrices,_f,∞]]

as=Table[a[i],{i,1,Length[remainingVariables]}]

matrices=matrices/.Thread[remainingVariables->Table[a[i],{i,1,Length[remainingVariables]}]];

matrices=Collect[matrices,_a,Together];

matrices/.(i:{__Vertex}->m_):>{i,MatrixForm[m]}

Solve[Cases[matrices,({Vertex[0,1],Vertex[n,1]}->{{x_}}):>x][[1]]==1,as]

power[k_]:=matrices/.{i:{__Vertex},m_}:>{i,MatrixPower[m,k]}

Clear[moment]

slice[v1_,v2_]:=Flatten[Position[FusionAtlas`GraphPlanarAlgebra`Private`GraphPathsBetween[g,n,v1,v2],{_,_,Vertex[1,1],__}]]

w[0][v1_,v2_]:=((LopsidedDimension[g,v2])/(LopsidedDimension[g,v1]))

w[1][v1_,v2_]:=((LopsidedDimension[g,v1]LopsidedDimension[g,v2])/((LopsidedDimension[g,Vertex[1,1]])^2))

DimensionOfGenerator[g]=q+(q^(-1));

JonesWenzlIdempotent[g,2,False];JonesWenzlIdempotent[g,2,False]=.;JonesWenzlIdempotent[g,2,False]=(JonesWenzlIdempotent[g,2,False]/.ToNumberField[x_,_]:>x);
JonesWenzlIdempotent[g,3,False];JonesWenzlIdempotent[g,3,False]=.;JonesWenzlIdempotent[g,3,False]=(JonesWenzlIdempotent[g,3,False]/.ToNumberField[x_,_]:>x);
JonesWenzlIdempotent[g,4,False];JonesWenzlIdempotent[g,4,False]=.;JonesWenzlIdempotent[g,4,False]=(JonesWenzlIdempotent[g,4,False]/.ToNumberField[x_,_]:>x);

JWmatrices=Simplify[(Cases[JonesWenzlIdempotent[g,4,False][[-1]],Alternatives@@((#->_)&/@allowedPairs)])];

JWmatrices/.(i:{__Vertex}->m_):>{i,MatrixForm[m]}

eqs=Union[Together[Flatten[Table[matrices[[i,2]].matrices[[i,2]]-JWmatrices[[i,2]],{i,1,Length[matrices]}]]]]

Take[eqs,5]

Solve[eqs[[2]]==0,as]

eqs=Union[Together[eqs/.a[1]->-((-1-(q^2)-2 (q^4)-2 (q^6)-2 (q^8)-(q^10)-(q^12))/(2 (q^2) (((1+(q^2)+(q^4)))^2)))]];

Length[eqs]

eqs=SortBy[eqs,Length[Union[Cases[#,_a,∞]]]&];

Take[eqs,10]

PowerExpand[FullSimplify[Solve[eqs[[2]]==0,as]]]

eqs=Union[Together[eqs/.a[2]->-((I (1+(q^10)))/(2 (Sqrt[1+(q^4)]) (Sqrt[1-(q^2)+(q^4)]) (((1+(q^2)+(q^4)))^(3/2))))]];

eqs=SortBy[eqs,Length[Union[Cases[#,_a,∞]]]&];

Collect[eqs[[2]],a[3],Simplify]

Simplify[Solve[eqs[[2]]==0,a[3]]]

eqs=Union[Together[eqs/.%[[1]]]];

FullSimplify[eqs[[2]]]

NSolve[(1-(q^2)-(q^4)-(q^6)+(q^8))==0,q]

Plot[eqs[[2]],{q,1,6}]

NSolve[eqs[[2]]==0,q]

(q+(q^(-1)))/.q->1.31228190787614`

N@DimensionOfGenerator[HaagerupBigraph]

qFromd[DimensionOfGenerator[HaagerupBigraph]]