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`

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

OcneanuDisplay[FSM[[1]],FSM[[2]]]

DisplayBigraph[FSM]

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

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

DimDepth6=(((q^(-6-n)) (-1+(q^4)+2 (q^6)+2 (q^8)+3 (q^10)+2 (q^12)+(q^14)-(q^(10+2 n))-2 (q^(12+2 n))-3 (q^(14+2 n))-2 (q^(16+2 n))-2 (q^(18+2 n))-(q^(20+2 n))+(q^(24+2 n))))/((((1+(q^2)))^3) (-2+3 (q^2)-3 (q^4)+2 (q^6))))

DimDepth5AB=(((q^(-5-n)) (-1-(q^6)+(q^10)-(q^(10+2 n))+(q^(14+2 n))+(q^(20+2 n))))/((((1+(q^2)))^2) (-2+3 (q^2)-3 (q^4)+2 (q^6))))

DimDepth5BA= (((q^(-5-n)) (-1-(q^2)+(q^4)+(q^8)+(q^10)-(q^(10+2 n))-(q^(12+2 n))-(q^(16+2 n))+(q^(18+2 n))+(q^(20+2 n))))/((((1+(q^2)))^2) (-2+3 (q^2)-3 (q^4)+2 (q^6))))

Restraint=Factor[DimDepth4 DimDepth6-DimDepth5AB DimDepth5BA]

Restraint0=Factor[(DimDepth4 DimDepth6-DimDepth5AB DimDepth5BA)/.{n->0}]

Restraint0=Factor[(DimDepth4 DimDepth6-DimDepth5AB DimDepth5BA)/.{n->2}]

Plot[Restraint/.{n->0},{q,1.6,1.7}]

NSolve[Restraint/.{n->0},q]

Plot[Restraint/.{n->2},{q,1.6,1.7}]

NSolve[Restraint/.{n->2},q]

N[qFromd[DimensionOfGenerator[FSM[[1]]]]]

A priori, q >1.59.

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

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

Plot[Evaluate[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,4,q]],{q,1.5057,1.5082},AxesOrigin->{Automatic,0}]

FSMInequality[1]=1-2 (q^2)-(q^4)+3 (q^8)+2 (q^10)+(q^12)-4 (q^(4+2 n))-12 (q^(6+2 n))-9 (q^(8+2 n))+4 (q^(12+2 n))+12 (q^(14+2 n))+18 (q^(16+2 n))+4 (q^(18+2 n))-4 (q^(20+2 n))-9 (q^(24+2 n))-12 (q^(26+2 n))-4 (q^(28+2 n))+8 (q^(14+4 n))+24 (q^(16+4 n))+18 (q^(18+4 n))-2 (q^(20+4 n))-18 (q^(24+4 n))-36 (q^(26+4 n))-18 (q^(28+4 n))-2 (q^(32+4 n))+18 (q^(34+4 n))+24 (q^(36+4 n))+8 (q^(38+4 n))-4 (q^(24+6 n))-12 (q^(26+6 n))-9 (q^(28+6 n))-4 (q^(32+6 n))+4 (q^(34+6 n))+18 (q^(36+6 n))+12 (q^(38+6 n))+4 (q^(40+6 n))-9 (q^(44+6 n))-12 (q^(46+6 n))-4 (q^(48+6 n))+(q^(40+8 n))+2 (q^(42+8 n))+3 (q^(44+8 n))-(q^(48+8 n))-2 (q^(50+8 n))+(q^(52+8 n));

Show FSMInequality > 0 whenever n ≥ 4 and q ≥ 1.59.

Factor[FSMInequality[1]]

FSMInequality[1,1]=-1+(q^2)+(q^4)+(q^6)+2 (q^(2+n))+3 (q^(4+n))-3 (q^(12+n))-2 (q^(14+n))-(q^(10+2 n))-(q^(12+2 n))-(q^(14+2 n))+(q^(16+2 n));

FSMInequality[1,2]=-1+(q^2)+(q^4)+(q^6)-2 (q^(2+n))-3 (q^(4+n))+3 (q^(12+n))+2 (q^(14+n))-(q^(10+2 n))-(q^(12+2 n))-(q^(14+2 n))+(q^(16+2 n));

Chop[NSolve[-(q^10)-(q^12)-(q^14)+(q^16) ==0]]

This shows  FSMInequality[1,2] >0 for allowed q. We will show FSMInequality[1,1] > 0 when n ≥ 4 for allowed q. This will prove FSMInequality[1] > 0 for n≥4.

If q>1, -1+(q^2)+(q^4)+(q^6)+2 (q^(2+n))+3 (q^(4+n))>0.  So we want to show

-3 (q^(12+n))-2 (q^(14+n))-(q^(10+2 n))-(q^(12+2 n))-(q^(14+2 n))+(q^(16+2 n)) >0;

Since n ≥ 4, q≥0, we find

-3 (q^(12+n))-2 (q^(14+n))-(q^(10+2 n))-(q^(12+2 n))-(q^(14+2 n))+(q^(16+2 n))≥ 
-3 (q^(8+2n))-2 (q^(10+2n))-(q^(10+2 n))-(q^(12+2 n))-(q^(14+2 n))+(q^(16+2 n))== (q^(8+2 n)) (-3-3 (q^2)-(q^4)-(q^6)+(q^8));

So we really want to show

(-3-3 (q^2)-(q^4)-(q^6)+(q^8))≥0;

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

The largest root is less than 1.59. We are through.

For the translation by 0 case, we have omega = 1,-1, i. we calculate the possible q values, then run tests to get rid of them.

possibleValueOfqForFSM[0,1]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,0,q]==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}]

ToString[RootReduce[(Sqrt[Root[1-3 #1-3 ((#1)^2)-4 ((#1)^3)-3 ((#1)^4)-3 ((#1)^5)+((#1)^6)&,2]])][[1]][x],TeXForm]

N[q/.possibleValueOfqForFSM[0,1]]

ToString[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,1],x],TeXForm]

Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,1],x],x]

FactorInteger[Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,1],x],x]]

FusionAtlas`CyclotomicTest`Private`FactorPowersModp[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,1],x][[1]],5,x]

FusionAtlas`CyclotomicTest`Private`PolynomialCyclotomicTest[MinimalPolynomial[RootReduce[((q/.possibleValueOfqForFSM[0,1])+(q/.possibleValueOfqForFSM[0,1])^(-1))^2][[1]],x],200,x]

possibleValueOfqForFSM[0,-1]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,0,q]+4==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}][[1]]

ToString[MinimalPolynomial[q/.possibleValueOfqForFSM[0,-1],x],TeXForm]

N[q/.possibleValueOfqForFSM[0,-1]]

possibleValueOfqForFSM[0,i]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,0,q]+2==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}]

ToString[RootReduce[√Root[1+#1-2 ((#1)^2)-17 ((#1)^3)-46 ((#1)^4)-91 ((#1)^5)-144 ((#1)^6)-197 ((#1)^7)-233 ((#1)^8)-246 ((#1)^9)-233 ((#1)^10)-197 ((#1)^11)-144 ((#1)^12)-91 ((#1)^13)-46 ((#1)^14)-17 ((#1)^15)-2 ((#1)^16)+((#1)^17)+((#1)^18)&,2]][[1]][x],TeXForm]

N[q/.possibleValueOfqForFSM[0,i]]

ToString[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,i],x],TeXForm]

Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,i],x],x]

FactorInteger[Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,i],x],x]]

FusionAtlas`CyclotomicTest`Private`FactorPowersModp[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[0,i],x][[1]],7,x]

FusionAtlas`CyclotomicTest`Private`PolynomialCyclotomicTest[MinimalPolynomial[RootReduce[((q/.possibleValueOfqForFSM[0,i])+(q/.possibleValueOfqForFSM[0,i])^(-1))^2][[1]],x],200,x]

Rule out translations by 2

N[qFromd[DimensionOfGenerator[Translate[FSM[[1]],2]]]]

possibleValueOfqForFSM[2,1]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,2,q]==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}]

ToString[RootReduce[(Sqrt[Root[1-#1-2 ((#1)^2)-5 ((#1)^3)-2 ((#1)^4)-5 ((#1)^5)-2 ((#1)^6)-((#1)^7)+((#1)^8)&,2]])][[1]][x],TeXForm]

N[q/.possibleValueOfqForFSM[2,1]]

ToString[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,1],x],TeXForm]

Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,1],x],x]

FactorInteger[Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,1],x],x]]

FusionAtlas`CyclotomicTest`Private`FactorPowersModp[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,1],x][[1]],3,x]

FusionAtlas`CyclotomicTest`Private`PolynomialCyclotomicTest[MinimalPolynomial[RootReduce[((q/.possibleValueOfqForFSM[2,1])+(q/.possibleValueOfqForFSM[2,1])^(-1))^2][[1]],x],200,x]

possibleValueOfqForFSM[2,-1]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,2,q]+4==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}][[1]]

ToString[RootReduce[(Sqrt[Root[1-#1-2 ((#1)^3)-2 ((#1)^5)-((#1)^7)+((#1)^8)&,2]])][[1]][x],TeXForm]

N[q/.possibleValueOfqForFSM[2,-1]]

possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,2,q]+1==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}]

ToString[RootReduce[√Root[1-((#1)^2)-4 ((#1)^3)-6 ((#1)^4)-19 ((#1)^5)-38 ((#1)^6)-67 ((#1)^7)-98 ((#1)^8)-139 ((#1)^9)-178 ((#1)^10)-218 ((#1)^11)-238 ((#1)^12)-246 ((#1)^13)-238 ((#1)^14)-218 ((#1)^15)-178 ((#1)^16)-139 ((#1)^17)-98 ((#1)^18)-67 ((#1)^19)-38 ((#1)^20)-19 ((#1)^21)-6 ((#1)^22)-4 ((#1)^23)-((#1)^24)+((#1)^26)&,2]][[1]][x],TeXForm]

N[q/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2]]

ToString[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2],x],TeXForm]

Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2],x],x]

FactorInteger[Discriminant[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2],x],x]]

FusionAtlas`CyclotomicTest`Private`FactorPowersModp[MinimalPolynomial[(q+q^(-1))^2/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2],x][[1]],5,x]

FusionAtlas`CyclotomicTest`Private`PolynomialCyclotomicTest[MinimalPolynomial[RootReduce[((q/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2])+(q/.possibleValueOfqForFSM[2,(1+i(3)^(1/2))/2])^(-1))^2][[1]],x],200,x]

possibleValueOfqForFSM[2,(-1+i(3)^(1/2))/2]=DeleteCases[Solve[PositiveOmegaInequality[FSM[[1]],FSM[[2]],1][d,2,q]+3==0],{___,q->x_/;Im[x]≠0∨!(x>1),___}]

ToString[RootReduce[√Root[1-((#1)^2)-4 ((#1)^3)-4 ((#1)^4)-9 ((#1)^5)-14 ((#1)^6)-21 ((#1)^7)-24 ((#1)^8)-29 ((#1)^9)-36 ((#1)^10)-42 ((#1)^11)-44 ((#1)^12)-42 ((#1)^13)-44 ((#1)^14)-42 ((#1)^15)-36 ((#1)^16)-29 ((#1)^17)-24 ((#1)^18)-21 ((#1)^19)-14 ((#1)^20)-9 ((#1)^21)-4 ((#1)^22)-4 ((#1)^23)-((#1)^24)+((#1)^26)&,2]][[1]][x],TeXForm]

N[q/.possibleValueOfqForFSM[2,(-1+i(3)^(1/2))/2]]