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

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}]]};

Map[DisplayBigraph,Crab]

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

A priori, we have q>1.45.

RelativeBranchFactor[Crab[[1]],Crab[[2]],1][d,n,q]

PositiveOmegaInequality[Crab[[1]],Crab[[2]],1][d,n,q]

Plot[Evaluate[PositiveOmegaInequality[Crab[[1]],Crab[[2]],1][d,0,q]],{q,1.5154,1.516},PlotRange->All,AxesOrigin->{Automatic,0}]

CrabInequality[1]=-1+2 (q^2)+(q^4)-3 (q^8)-2 (q^10)-(q^12)+(q^(8+2 n))+4 (q^(10+2 n))-(q^(12+2 n))-2 (q^(14+2 n))-(q^(16+2 n))+4 (q^(18+2 n))+5 (q^(20+2 n))+2 (q^(22+2 n))-2 (q^(18+4 n))-5 (q^(20+4 n))-4 (q^(22+4 n))+(q^(24+4 n))+2 (q^(26+4 n))+(q^(28+4 n))-4 (q^(30+4 n))-(q^(32+4 n))+(q^(28+6 n))+2 (q^(30+6 n))+3 (q^(32+6 n))-(q^(36+6 n))-2 (q^(38+6 n))+(q^(40+6 n));

When is CrabInequality ≤ 0?

Factor[CrabInequality[1]]

CrabInequality[1,1]=1-(q^2)-(q^4)-(q^6)-(q^(4+n))-(q^(6+n))-(q^(8+n))+(q^(10+n));

CrabInequality[1,2]=-1+(q^2)+(q^4)+(q^6)-(q^(4+n))-(q^(6+n))-(q^(8+n))+(q^(10+n));

Chop[NSolve[-(q^4)-(q^6)-(q^8)+(q^10) ==0]]

This shows crabInequality[1,2]>0 for allowed q.  When is CrabInequality[1,1]≤0? We may assume n=0, as increasing n only increases CrabInequality[1,1].

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

N[3+Sqrt[3]]

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

RootReduce[1-(q^2)-(q^4)-(q^6)-(q^4)-(q^6)-(q^8)+(q^10)/.q->qFromd[Sqrt[3+Sqrt[3]]]]

The largest root of 1-(q^2)-(q^4)-(q^6)-(q^4)-(q^6)-(q^8)+(q^10) is the q such that (q+q^(-1))^2=3+Sqrt[3].

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

Map[DisplayBigraph,RemainingCrabPossibilities]

N[qFromd[DimensionOfGenerator[RemainingCrabPossibilities[[1,1]]]]]

N[qFromd[DimensionOfGenerator[RemainingCrabPossibilities[[2,1]]]]]

N[qFromd[DimensionOfGenerator[RemainingCrabPossibilities[[3,1]]]]]

Plot[1-(q^2)-(q^4)-(q^6)-(q^6)-(q^8)-(q^10)+(q^12),{q,1.48,1.52},PlotRange->All,AxesOrigin->{Automatic,0}]

CrabInequality[1,1]=1-(q^2)-(q^4)-(q^6)-(q^(4+n))-(q^(6+n))-(q^(8+n))+(q^(10+n));

We show CrabInequality[1,1] is positive when n≥ 2 and  q≥ 1.48.
1-(q^2)-(q^4)-(q^6)-(q^(4+n))-(q^(6+n))-(q^(8+n))+(q^(10+n)) ≥ 1-(q^2)-(q^4)-(q^6)-(q^6)-(q^8)-(q^10)+(q^12)
as this number only increases as n gets bigger.

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

The largest root is smaller than 1.48. We are finished.

AlgebraicIntegerQ /@ Flatten[DimensionsByDepth[RemainingCrabPossibilities[[1,1,1]]]]

ToString[MinimalPolynomial[DimensionsByDepth[RemainingCrabPossibilities[[1,1,1]]][[5,1]],x],TeXForm]

AlgebraicIntegerQ /@ Flatten[DimensionsByDepth[RemainingCrabPossibilities[[2,1,1]]]]

ToString[MinimalPolynomial[DimensionsByDepth[RemainingCrabPossibilities[[2,1,1]]][[5,1]],x],TeXForm]

AlgebraicIntegerQ /@ Flatten[DimensionsByDepth[RemainingCrabPossibilities[[3,1,1]]]]

ToString[MinimalPolynomial[DimensionsByDepth[RemainingCrabPossibilities[[3,1,1]]][[5,1]],x],TeXForm]

OcneanuDisplay[Crab[[1]],Crab[[2]]]

RelativeDimensionsByDepth[Crab[[1]],Crab[[2]],1][d,n,q]

CrabDimDepth4=(((q^(-4-n)) (-1+(q^(12+2 n))))/(-1+(q^4)))

CrabDimDepth6=(((q^(-4-n)) (-1+(q^4)+(q^6)-(q^(10+2 n))-(q^(12+2 n))+(q^(16+2 n))))/((-1+(q^2)) (((1+(q^2)))^3)))

CrabDimDepth5AB=(((q^(-5-n)) (-1+(q^4)+(q^6)-(q^(10+2 n))-(q^(12+2 n))+(q^(16+2 n))))/((-1+(q^2)) (((1+(q^2)))^2)))

CrabDimDepth5BA=(((q^(-3-n)) (-1+(q^(12+2 n))))/((-1+(q^2)) (((1+(q^2)))^2)))

CrabRestraint=Factor[CrabDimDepth4 CrabDimDepth6 - CrabDimDepth5AB CrabDimDepth5BA]