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

Families11={{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{1,0}}],DualData[{1},{1},{1,2}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{0,1},{0,1}},{{1,0,0},{1,0,0},{0,1,0},{0,0,1}}],DualData[{1},{1},{1,2},{3,4,1,2}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{0,0,1},{1,0,0}},{{1,0}}],DualData[{1},{1},{1,3,2},{1}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{1,0,0},{0,0,1}},{{0,1}}],DualData[{1},{1},{1,3,2},{1}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{1,0,0},{0,0,1}},{{0,1}}],DualData[{1},{1},{1,3,2},{1}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{0,0,1},{1,0,0}},{{1,0}}],DualData[{1},{1},{1,3,2},{1}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{0,1,0},{0,0,1}},{{0,1}}],DualData[{1},{1},{1,2},{2,1}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{0,1},{0,1}},{{1,0,0},{0,1,0}},{{1,0}}],DualData[{1},{1},{1,2},{2,1}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{0,0,1},{1,0,0},{1,0,0}},{{1,0,0},{1,0,0},{0,1,0}},{{0,1,0}}],DualData[{1},{1},{1,3,2},{1,3,2}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{1,0,0},{1,0,0},{0,0,1}},{{0,1,0},{0,0,1},{0,0,1}},{{0,1,0}}],DualData[{1},{1},{1,3,2},{2,1,3}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{1,0,0},{1,0,0},{0,0,1}},{{0,1,0},{0,0,1},{0,0,1}},{{0,1,0}}],DualData[{1},{1},{1,3,2},{2,1,3}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{0,0,1},{1,0,0},{1,0,0}},{{1,0,0},{1,0,0},{0,1,0}},{{0,1,0}}],DualData[{1},{1},{1,3,2},{1,3,2}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{0,1,0},{0,0,1},{0,0,1}},{{0,1,0},{1,0,0}},{{0,1}},{{1}}],DualData[{1},{1},{1,2},{2,1,3},{1}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{0,1},{0,1}},{{1,0,0},{0,1,0},{0,0,1}},{{1,0,0},{0,0,1}},{{1,0},{0,1}},{{1,0}},{{1}}],DualData[{1},{1},{1,2},{2,1,3},{2,1},{1}]]},{BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{1,0},{0,1}},{{1,0,0},{0,1,0},{0,0,1}},{{1,0,0},{0,0,1}},{{1,0},{0,1}},{{0,1}},{{1}}],DualData[{1},{1},{1,2},{1,3,2},{2,1},{1}]],BigraphWithDuals[GradedBigraph[{{1}},{{1}},{{1}},{{1},{1}},{{1,0},{0,1},{0,1}},{{1,0,0},{1,0,0},{0,1,0}},{{0,0,1},{0,1,0}},{{1,0}},{{1}}],DualData[{1},{1},{1,2},{1,3,2},{1}]]}};

Map[DisplayBigraph,Families11,{2}]

qI[n_][q_]:=(((q^n)-(q^(-n)))/(q-(q^(-1))))

W[k_,q_,ω_]:=(q^k)+(q^(-k))-ω-(ω^(-1))

DepthOfBranchPoint[HaagerupBigraph]+1

DisplayBigraph[HaagerupBigraph]

BranchFactor[HaagerupBigraph]

BranchFactor[DualHaagerupBigraph]

RelativeBranchFactor[DualHaagerupWithDuals,HaagerupWithDuals,1][d,n,q]

A[g_GradedBigraph]:=Module[{n,d1,d2,r,q},
n=DepthOfBranchPoint[g]+1;
{d1,d2}=ReducedDimensionsByDepth[g][[n+1]];
r=Max[d1/d2,d2/d1];
q=RootReduce[q/.Solve[DimensionOfGenerator[g]==q+(q^(-1)),q][[-1]]];
RootReduce[((1-r)/(Sqrt[r (((q^(n+1))-(q^(-n-1)))/(q-(q^(-1))))]))]
]

X[g1_GradedBigraph,g2_GradedBigraph,σ_]:=Module[
{n,α,β,q,W0,ω=(σ^2)},
n=DepthOfBranchPoint[g1]+1;
α=A[g1];
β=A[g2];
q=RootReduce[q/.Solve[DimensionOfGenerator[g1]==q+(q^(-1)),q][[-1]]];
W0=W[2n+2,q,ω];
RootReduce[(1/(qI[n][q]))-(1/W0)(((α^2)+(β^2))qI[2n+2][q]+(((-1))^(n+1))2α β(σ+(σ^(-1)))qI[n+1][q])-(1/(qI[n+2][q]))]
]

Y[g1_GradedBigraph,g2_GradedBigraph,σ_]:=Module[
{n,α,β,q,W0,ω=(σ^2)},
n=DepthOfBranchPoint[g1]+1;
α=A[g1];
β=A[g2];
q=RootReduce[q/.Solve[DimensionOfGenerator[g1]==q+(q^(-1)),q][[-1]]];
W0=W[2n+2,q,ω];
RootReduce[(σ^3)α β +(((((-1))^(n-1))(ω^2))/(qI[n+1][q]qI[n][q]))-(1/W0)((((-1))^n)ω((α^2)+(β^2))(ω qI[n][q]+qI[n+2][q])-2α β σ(ω qI[2n+1][q]+1))-(((((-1))^n)ω)/(qI[n+2][q]qI[n+1][q]))]
]

RelativeA[g1_BigraphWithDuals,g2_BigraphWithDuals,t:(0|1)]:=
Function[{d,n,q},
Evaluate[ Module[{m,r},m=n+DepthOfBranchPoint[g1]+1;
r=RelativeBranchFactor[g1,g2,t][d,n,q];
RootReduce[((1-r)/(Sqrt[r (((q^(m+1))-(q^(-m-1)))/(q-(q^(-1))))]))]
]]]

RootReduce[RelativeX[HaagerupAsaedaWithDuals,DualHaagerupAsaedaWithDuals,0][d,0,qFromd[DimensionOfGenerator[HaagerupAsaedaBigraph]],1]]

X[HaagerupAsaedaBigraph,DualHaagerupAsaedaBigraph,1]

RootReduce[RelativeY[HaagerupAsaedaWithDuals,DualHaagerupAsaedaWithDuals,0][d,0,qFromd[DimensionOfGenerator[HaagerupAsaedaBigraph]],1]]

Y[HaagerupAsaedaBigraph,DualHaagerupAsaedaBigraph,1]

RelativeX[g1_BigraphWithDuals,g2_BigraphWithDuals,t:(0|1)]:=
Function[{d,n,q,σ},
Evaluate[Module[
{m,α,β,W0,ω=(σ^2)},
m=n+DepthOfBranchPoint[g1]+1;
α=RelativeA[g1,g2,t][d,n,q];
β=RelativeA[g2,g1,t][d,n,q];
W0=W[2m+2,q,ω];
RootReduce[(1/(qI[m][q]))-(1/W0)(((α^2)+(β^2))qI[2m+2][q]+(((-1))^(m+1))2α β(σ+(σ^(-1)))qI[m+1][q])-(1/(qI[m+2][q]))]
]]]

X1=RelativeX[HaagerupWithDuals,DualHaagerupWithDuals,0][d,n,q,σ]

RelativeY[g1_BigraphWithDuals,g2_BigraphWithDuals,t:(0|1)]:=
Function[{d,n,q,σ},
Evaluate[Module[
{m,α,β,W0,ω=(σ^2)},
m=n+DepthOfBranchPoint[g1]+1;
α=RelativeA[g1,g2,t][d,n,q];
β=RelativeA[g2,g1,t][d,n,q];
W0=W[2m+2,q,ω];
RootReduce[(σ^3)α β +(((((-1))^(m-1))(ω^2))/(qI[m+1][q]qI[m][q]))-(1/W0)((((-1))^m)ω((α^2)+(β^2))(ω qI[m][q]+qI[m+2][q])-2α β σ(ω qI[2m+1][q]+1))-(((((-1))^m)ω)/(qI[m+2][q]qI[m+1][q]))]
]]]

Y1=RelativeY[HaagerupWithDuals,DualHaagerupWithDuals,0][d,n,q,σ]

Simplify[X1-Y1]

QuadraticTestFor11Families[g1_BigraphWithDuals,g2_BigraphWithDuals,t:(0|1)]:=
Function[{d,n,q,σ},
Evaluate[Together[ RelativeX[g1,g2,t][d,n,q,σ]-RelativeY[g1,g2,t][d,n,q,σ]]]]

RootReduce[QuadraticTestFor11Families[HaagerupAsaedaWithDuals,DualHaagerupAsaedaWithDuals,0][d,0,q,1]/.q->qFromd[DimensionOfGenerator[HaagerupAsaedaBigraph]]]

RootReduce[X[HaagerupAsaedaWithDuals[[1]],DualHaagerupAsaedaWithDuals[[1]],1]-Y[HaagerupAsaedaWithDuals[[1]],DualHaagerupAsaedaWithDuals[[1]],1]]

foo=Simplify[X[HaagerupAsaedaWithDuals[[1]],DualHaagerupAsaedaWithDuals[[1]],σ]-Y[HaagerupAsaedaWithDuals[[1]],DualHaagerupAsaedaWithDuals[[1]],σ]]/.σ->1

N[foo]

QuadraticTestFor11Families[HaagerupAsaedaWithDuals,DualHaagerupAsaedaWithDuals,0][d,0,q,σ]

bar=Simplify[QuadraticTestFor11Families[HaagerupAsaedaWithDuals,DualHaagerupAsaedaWithDuals,0][d,0,q,σ]/.q->qFromd[DimensionOfGenerator[HaagerupAsaedaWithDuals[[1]]]]]

N[bar/.σ->1]

Plot[Evaluate[Abs[bar/.σ->Exp[I θ]]],{θ,0,2π}]

baz=Collect[QuadraticTestFor11Families[Families11[[1,1]],Families11[[1,2]],0][d,n,q,σ],σ]

Plot[Evaluate[{Log[Log[Abs[Numerator[baz]]]/.{n->0,σ->Exp[I π]}]}],{q,1.63,1.64},PlotRange->{0,1}]

ContourPlot[Evaluate[{Abs[Numerator[baz]/.{n->0,σ->Exp[I θ]}]}],{q,1,2.5},{θ,0,2 π},PlotRange->{0,2}]

FindRoot[{Re[Numerator[baz]]/.{n->0,σ->Exp[I θ]},Im[Numerator[baz]]/.{n->0,σ->Exp[I θ]}},{{q,1.5},{θ,2}},WorkingPrecision->30]

FindRoot[{Re[Numerator[baz]]/.{n->2,σ->Exp[I θ]},Im[Numerator[baz]]/.{n->2,σ->Exp[I θ]}},{{q,1.5},{θ,2}},WorkingPrecision->30]

FindRoot[{Re[Numerator[baz]]/.{n->20,σ->Exp[I θ]},Im[Numerator[baz]]/.{n->20,σ->Exp[I θ]}},{{q,1.5},{θ,2}},WorkingPrecision->30]

(((q+(q^(-1))))^2)/.q->1.4472082888923075002784656517015193558808372967303378920614`30.

N@qFromd[DimensionOfGenerator[Families11[[1,1,1]]]]

FindRoot[{Re[Numerator[baz]]/.{n->0,σ->Exp[I π]}},{{q,1.9}},WorkingPrecision->30]

Numerator[baz]/.{n->0,σ->Exp[I π]}/.{q->1.6397326905898778420570777645983375456784106962721325064828`30.}

Numerator[baz]/.{n->0,σ->Exp[I π]}/.{q->1.63}

Numerator[baz]/.{n->0,σ->Exp[I π]}/.{q->1.64}

(((q+(q^(-1))))^2)/.q->1.6397326905898778420570777645983375456784106962721325064828`30.

ContourPlot[Evaluate[{Re[Numerator[baz]/.{n->0,σ->Exp[I θ]}]==0,Im[Numerator[baz]/.{n->0,σ->Exp[I θ]}]==0}],{q,1,2.5},{θ,0,2 π}]

ContourPlot[Evaluate[{Re[Numerator[baz]/.{n->10,σ->Exp[I θ]}]==0,Im[Numerator[baz]/.{n->10,σ->Exp[I θ]}]==0}],{q,1,2.5},{θ,0,2 π}]

(((q+(q^(-1))))^2)/.q->1.5

ContourPlot[Evaluate[Im[Numerator[baz]/.{n->0,σ->Exp[I θ]}]==0],{q,1,2.5},{θ,0,2 π}]

.