FusionAtlasPaths={"~/projects/fusionatlas/code/package/","~/Documents/research/fusionatlas/package/","C:\\Documents and Settings\\James Tener\\My Documents\\Research\\fusionatlas\\package\\"};
$Path=$Path~Join~FusionAtlasPaths;
<<FusionAtlas`

DisplayBigraph[HaagerupAsaedaWithDuals]

Alphas=RelativeDimensionsByDepth[HaagerupAsaedaWithDuals,DualHaagerupAsaedaWithDuals,0][d,n,q][[1,7]]

Alpha1=(q^n-q^(-n))(q^5-q^(-5))/(q^6-q^(-6))/(q-q^(-1))

Together[Alpha1]

Factor[Alphas]

TeXForm[Factor[Alphas]]

Difference=Together[Alphas[[2]]-Alphas[[1]]]

Compare=(q^n-q^(-n))/(q^6-q^(-6))

Together[Compare]

Compare==Difference

TeXForm[Difference]

Together[Factor[D[Difference,q]]]

NSolve[(D[Difference,q]/.{n->3})==0]

Dimension[n_]:=DimensionOfGenerator[Translate[HaagerupAsaedaBigraph,n]]

NDimension[n_]:=N[Dimension[n]]

AHq[n_]:=qFromd[Dimension[n]]

NAHq[n_]:=N[qFromd[Dimension[n]]]

RootReduce[Difference/.{q->qFromd[Dimension[0]],n->0}]

NSolve[1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20)]

N[qFromd[Dimension[0]]]

N[1/(1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))/.{q->AHq[0]}]

N[qFromd[DimensionOfGenerator[HaagerupAsaedaBigraph]]]

Plot[(((q^(10-n)) (-1+(q^(2+2 n))))/((-1+(q^2)) (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))))/.{n->0},{q,1.442,1.443}]
N[qFromd[DimensionOfGenerator[Translate[HaagerupAsaedaBigraph,0]]]]

(((q^(10-n)) (-1+(q^(2+2 n))))/((-1+(q^2)) (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))))/.{n->0}

RootReduce[((q^10)/(1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20)))/.{q->qFromd[Sqrt[(5+Sqrt[17])/2]]}]

note that (((q^(10-n)) (-1+(q^(2+2 n))))/((-1+(q^2)) (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))))= (((q^(10-n)) (1+q^2+q^4+\cdots+ q^(2n)))/( (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))))\geq ((q^(8+n)+q^(10+n))/( (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))))

Plot[((q^(9)+q^(11))/( (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20)))),{q,1.445,1.448}]

N[qFromd[DimensionOfGenerator[Translate[HaagerupAsaedaBigraph,10]]]]

((q^(9)+q^(11))/( (1-(q^4)-3 (q^6)-4 (q^8)-5 (q^10)-4 (q^12)-3 (q^14)-(q^16)+(q^20))))/.{q->1.448}

This kills translates of Asaeda-Haagerup for n\geq 1.

Clear[qI]

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

2qI[q,6]-1-2qI[q,5]

1+2qI[q,5]

qI[q,7]qI[q,5]

RootReduce[Together[(1+2qI[q,5])]/.{q->qHA}]

RootReduce[Together[qI[q,7]]/.{q->qHA}]

RootReduce[Together[(1-(qI[q,2]-((1+2qI[q,5])/qI[q,6]))(1+2qI[q,5])/qI[q,6])qI[q,6]^2]/.{q->qHA}]

Together[(1-(qI[q,2]-((1+2qI[q,5])/qI[q,6]))(1+2qI[q,5])/qI[q,6])qI[q,6]^2]

Plot[((-1+4 (q^6)+5 (q^8)+9 (q^10)+5 (q^12)+4 (q^14)-(q^20))/(q^10)),{q,1.44,1.46}]

Ones=RootReduce[Solve[((-1+4 (q^6)+5 (q^8)+9 (q^10)+5 (q^12)+4 (q^14)-(q^20))/(q^10))==1,q]]

N[Ones]

RootReduce[(Root[1-((#1)^2)-2 ((#1)^4)-((#1)^6)+((#1)^8)&,4])+(Root[1-((#1)^2)-2 ((#1)^4)-((#1)^6)+((#1)^8)&,4])^(-1)]

2-5 ((#1)^2)+((#1)^4)&[x]

MinimalPolynomial[(Sqrt[(1/2) (5+(Sqrt[17]))]),x]

Zeroes=RootReduce[Solve[((-1+4 (q^6)+5 (q^8)+9 (q^10)+5 (q^12)+4 (q^14)-(q^20))/(q^10))==0,q]]

N[Zeroes]

N[qHA]

Foot[g_GradedBigraph,m_,n_]:=GradedBigraph @@ (Table[{{1}},{i,1,m}]~Join~{{{1},{1}},{{1,0}}}~Join~Table[{{1}},{i,1,n}]~Join~(List @@ g))

Foot[HaagerupAsaedaBigraph,2,3]

DisplayBigraph[Foot[HaagerupAsaedaBigraph,6,3]]

Root[-1-((#1)^2)-2 ((#1)^4)-((#1)^6)-((#1)^8)+((#1)^10)&,2]<qFromd[DimensionOfGenerator[Foot[HaagerupAsaedaBigraph,5,8]]]

dFromEquation=RootReduce[Root[-1-((#1)^2)-2 ((#1)^4)-((#1)^6)-((#1)^8)+((#1)^10)&,2]+Root[-1-((#1)^2)-2 ((#1)^4)-((#1)^6)-((#1)^8)+((#1)^10)&,2]^(-1)]
N[dFromEquation]

2.138175330992156`

foo=DimensionOfGenerator[Foot[HaagerupAsaedaBigraph,8,100]];
N[foo]
foo>dFromEquation

2.138175330992156`

DisplayBigraph[Translate[HaagerupAsaedaBigraph,3]]

DimensionOfGenerator[Translate[HaagerupAsaedaBigraph,0]]

N[DimensionOfGenerator[Translate[HaagerupAsaedaBigraph,0]]]

2.135779205069857`

N[DimensionOfGenerator[Translate[HaagerupAsaedaBigraph,100]]]

2.138175330992156`

DisplayBigraph[Foot[HaagerupAsaedaBigraph,1,20]]
N[DimensionOfGenerator[Foot[HaagerupAsaedaBigraph,1,100]]]

2.138175330992156`

Try to kill Asaeda-Haagerup using quadratic tangles:

r=Together[(qI[q,5]+1)/qI[q,5]]

NAHq[0]

Positive Omega Inequality:

Factor[(Together[r+r^(-1)]-2)qI[q,n]qI[q,n+2]-4]

TeXForm[Factor[(Together[r+r^(-1)]-2)qI[q,n]qI[q,n+2]-4]]

All terms are positive except possibly (-(q^4)+2 (q^n)+(q^(4+n))-(q^(6+n))-2 (q^(10+n))+(q^(6+2 n))) and  (1-q+(q^2)-(q^3)+(q^4))

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

Plot[1-q+(q^2)-(q^3)+(q^4),{q,1.44,1.46}]

The term  (1-q+(q^2)-(q^3)+(q^4))  is always positive.

NSolve[2+(q^4)-(q^6)-2 (q^10)+(q^(6+ 7)) ==0]

Plot[2+(q^4)-(q^6)-2 (q^10)+(q^(6+ 7)),{q,1.44,1.46}]

This means that for n ≥ 7, we have  2+(q^4)-(q^6)-2 (q^10)+(q^(6+ n)) ≥ 0, so

-(q^4)+2 (q^n)+(q^(4+n))-(q^(6+n))-2 (q^(10+n))+(q^(6+2 n)) = -(q^4)+(2+(q^4)-(q^6)-2 (q^10)+(q^(6+ n))) (q^n)  ≥ -(q^4)+2+(q^4)-(q^6)-2 (q^10)+(q^(6+n))
Now require n≥7 to get -(q^4)+2+(q^4)-(q^6)-2 (q^10)+(q^(6+ n)) ≥ -(q^4)+2+(q^4)-(q^6)-2 (q^10)+(q^13)

TeXForm[2+(q^4)-(q^6)-2 (q^10)+(q^12)]

Plot[-(q^4)+2+(q^4)-(q^6)-2 (q^10)+(q^13),{q,1.44,1.46}]

NSolve[-(q^4)+2+(q^4)-(q^6)-2 (q^10)+(q^13)==0]

For n≥6, we have that Positive Omega Inequality is positive, so translations of Asaeda-Haagerup cannot occur for translations ≥6.

Table[CyclotomicTest[Translate[HaagerupAsaedaBigraph,i]],{i,1,6}]

This rules out translation by 1-6.

Alternate Crab argument:

p=Together[(qI[q,n+4]-qI[q,n+2]-qI[q,n]-qI[q,n-2])/(qI[q,2]^3)]

Plot[p/.{n->6},{q,1.453,1.47}]

N[qFromd[Sqrt[3+Sqrt[3]]]]

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

N[qFromd[DimensionOfGenerator[Crab[[1]]]]]