QuadraticTanglesTest package

Introduction

---text goes here---

Implementation

Start of package

Specify package dependencies:

BeginPackage["FusionAtlas`QuadraticTanglesTest`",{"FusionAtlas`","FusionAtlas`Bigraphs`"}];

Usage messages

ParityTest::usage="";

HaagerupTypeBranchTest::usage="HaagerupTypeBranchTest[g] checks if g satisfies the condition on p.33 of the pre-preprint of Quadratic Tangles";

Internals

Begin["`Private`"];

This used to be called MaximallySuperTransitiveQ until we realized we didn't know what that meant.  

This condition on the low weight space should be equivalent to "for two steps past the branch point, it looks like Haagerup or dual Haagerup"

HaagerupTypeBranchingQ[b_GradedBigraph]:=
HasSimpleBranchQ[b]∧(DimensionOfLowWeightSpace[b][DepthOfBranchPoint[b]+2]==0)

ParityTest[b_GradedBigraph]:=
DimensionOfGenerator[b]≤2∨Not[HaagerupTypeBranchingQ[b]]∨OddQ[DepthOfBranchPoint[b]]

HaagerupTypePrincipalQ[b_GradedBigraph]:=
HaagerupTypeBranchingQ[b]∧(((List@@b)[[DepthOfBranchPoint[b]+2]])=={{1,0},{0,1}})

HaagerupTypeDualQ[b_GradedBigraph]:=
HaagerupTypeBranchingQ[b]∧(((List@@b)[[DepthOfBranchPoint[b]+2]])=={{1,0},{1,0}})

QRule[b_GradedBigraph,q_]:=N[Solve[q^2+1 ==q*DimensionOfGenerator[b], q][[2]][[1]]]

Quantum[n_, b_GradedBigraph] :=Module[{q}, 
((q^n-q^{-n})/(q-q^{-1})/.(QRule[b,q]))[[1]]]

AlmostOneQ[x_]:=(Abs[x-1]<0.00001)

HaagerupTypeBranchTest[b_GradedBigraph]:=DimensionOfGenerator[b]≤2∨
Not[HaagerupTypePrincipalQ[b]] ∨
(Module[{n=DepthOfBranchPoint[b]+1, larger=Max[NumericDimensionsByDepth[b][[DepthOfBranchPoint[b]+2]][[1]],NumericDimensionsByDepth[b][[DepthOfBranchPoint[b]+2]][[2]]],smaller=Min[NumericDimensionsByDepth[b][[DepthOfBranchPoint[b]+2]][[1]],NumericDimensionsByDepth[b][[DepthOfBranchPoint[b]+2]][[2]]]},
Or @@(AlmostOneQ/@Flatten[(w^{n}/.Solve[(larger/smaller)*w+(larger/smaller)^{-1}*w-2*w-(2w+w^2+1)/(Quantum[n+2,b]*Quantum[n,b])==0,w]) ])
])

End

End[];

End of package

EndPackage[];