(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



BeginPackage["FusionAtlas`FindAllBigraphs`",{"FusionAtlas`","FusionAtlas`Bigraphs`","FusionAtlas`CyclotomicTest`","FusionAtlas`KnapsackTest`","FusionAtlas`QuadraticTanglesTest`","FusionAtlas`dTest`","FusionAtlas`Debugging`","FusionAtlas`JavaOdometer`","FusionAtlas`RemoteInterface`","FusionAtlas`PackageData`"}~Join~If[$VersionNumber<6.0,{"NumberTheory`AlgebraicNumberFields`"},{}]];


AlgebraicIntegerTest::usage="AlgebraicIntegerTest[b] returns True if all the Perron-Frobenius dimensions of the graph b are algebraic integers";


PositivityTest::usage="PositivityTest[b] returns True if all the Perron-Frobenius dimensions of the graph b are more than or equal to 1";


GHJTest::usage="GHJTest[b] returns True if all the Perron-Frobenius dimensions of the graph b are more than two or of the form 2 Cos[Pi/n]";


BigraphConditions::usage="BigraphConditions is a set of triples:  an English name for a test, the Mathematica name for the test, and a description of the test";


KnownObstructions;FindAllObstructions;


AllBigraphs;
FindAllBigraphs::usage="FindAllBigraphs[{mdim,Mdim},r] produces a list of all bigraphs with rank less than or equal to r and dimension between mdim and Mdim. FindAllBigraphs[dim,r] produces a list of all bigraphs with rank less than or equal to r and dimension between 0 and dim (if dim is less than or equal to 2) or 2 and dim (if dim is more than 2).";


RequestAllBigraphs;


RequestMoreBigraphs;


Begin["`Private`"];


fastAlgebraicIntegerQ[\[Mu]_]:=fastAlgebraicIntegerQ[\[Mu]]=Module[{p,x,c,d},
p=MinimalPolynomial[\[Mu],x];
c=LCM@@(Denominator[CoefficientList[p,x]]);
d=GCD@@CoefficientList[c p,x];
Abs[Coefficient[c/d p,x,Exponent[p,x]]]==1
]


productAlgebraicIntegerQ[x_Times]:=(AlgebraicIntegerQ/@(And@@x))\[Or]AlgebraicIntegerQ[x]
productAlgebraicIntegerQ[x_]:=AlgebraicIntegerQ[x]


safeAlgebraicIntegerQ[x_]:=Module[{r1,t1,r2,t2},
{t1,r1}=fastAlgebraicIntegerQ[x]//AbsoluteTiming;
{t2,r2}=productAlgebraicIntegerQ[x]//AbsoluteTiming;
If[t1>t2,Print["Not so fast... ",t1," ",t2," ",t1/t2],Print["Fast!"]];
If[r1!=r2,Print["Argh! AlgebraicIntegerQ failure: ",x],r1]
]


AlgebraicIntegerTest[b_GradedBigraph] :=AlgebraicIntegerTest[b]=fastAlgebraicIntegerQ /@(And@@Flatten[DimensionsByDepth[b]])


PositivityTest[b_GradedBigraph]:=
#>1.-10.^-6&/@(And@@Flatten[NumericDimensionsByDepth[b]])


GHJQ[\[Delta]_]:=\[Delta]>=2\[Or]Abs[(\[Pi]/N[ArcCos[N[\[Delta]]/2]]-Round[N[\[Pi]/ArcCos[N[\[Delta]]/2]]])]<10^-3


GHJTest[g_GradedBigraph]:=
GHJQ/@(And@@Flatten[NumericDimensionsByDepth[g]])


BigraphConditions={
{"Positivity",PositivityTest,"All bimodule dimensions must be at least 1."},
{"GHJ", GHJTest, "Bimodule dimensions less than 2 must satisfy the GHJ condition."},
{"Annular Tangles",AnnularTanglesTest,"Dimensions of low weight spaces must be non-negative. See p.33 of Annular Structure of Subfactors."},
{"Parity",ParityTest,"If you start like Haagerup or dual Haagerup, the branch point must be at odd depth."},
{"HaagerupTypeBranch",HaagerupTypeBranchTest,"If you start like Haagerup for two steps past the branch, you must satisfy the identities on p.33 of Quadratic Tangles pre-preprint"},
{"Algebraic Integer",AlgebraicIntegerTest,"All bimodule dimensions must be algebraic integers."},{"Cyclotomic Integer",(CyclotomicTest[#,200])&,"The index must be a cyclotomic integer."},
{"d-Number",(DTest[#])&,"The global dimension of the even part must be an Ostrik d-number."}(*,
{"Knapsack",KnapsackTest,"It must be possible to write all products of dimensions as N-linear combinations of dimensions."}*)
};


KnownObstructions[g_GradedBigraph]:=KnownObstructions[g]=Module[{result={}},
Do[DebugPrint["Looking for obstructions: ",g," ",BigraphConditions[[k,1]]];If[!BigraphConditions[[k,2]][g],AppendTo[result,BigraphConditions[[k,3]]];Break[]],{k,1,Length[BigraphConditions]}];
result
]


FindAllObstructions[g_GradedBigraph]:=FindAllObstructions[g]=KnownObstructions[g]=Module[{result={}},
Do[If[!BigraphConditions[[k,2]][g],AppendTo[result,BigraphConditions[[k,3]]]],{k,1,Length[BigraphConditions]}];
result
]


Options[FindAllBigraphs]:={"Package"->False};


FindAllBigraphs[{minDimension_,dimension_},maximumRank_Integer]:=FindAllBigraphs[{minDimension,dimension},maximumRank,GradedBigraph[{{1}}]]
FindAllBigraphs[{minDimension_,dimension_},maximumRank_Integer,seed_GradedBigraph]:=FindAllBigraphs[{minDimension,dimension},maximumRank,seed]=
With[
{package="Package"/.Options[FindAllBigraphs]},
Module[{seeds,candidates,allowed,unknowns,canonicalForms,insideRange,batch,disallowed,lookup},
seeds={seed};
(*candidates=
Join@@(DeleteCases[FindBigraphExtensionsUpToRankAndDepthJava[dimension][#,maximumRank,maximumRank-1],x_/;DimensionAtMostQ[minDimension][x]]&/@seeds);*)
candidates=Join@@(FindBigraphExtensionsUpToRankAndDepthJava[dimension][#,maximumRank,maximumRank-1]&/@seeds);
disallowed={};
allowed={};
unknowns={};
While[Length[candidates]>0,
batch=Take[candidates,Min[1000,Length[candidates]]];
candidates=Drop[candidates,Min[1000,Length[candidates]]];
(*lookup canonical forms *)
canonicalForms=LookupCanonicalForms[batch];
If[canonicalForms=!=$Failed,
DebugPrint["Found ",Length[canonicalForms],"-->", Length[Union[Last/@canonicalForms]]," canonical forms."];
batch=Union[Complement[batch,First/@canonicalForms]~Join~(Last/@canonicalForms)];,
DebugPrint["Looking up canonical forms failed, probably due to a network error."];
];
lookup=LookupGraphs[batch];
If[lookup=!=$Failed,
DebugPrint["Found information about ",Length[lookup]," graphs in the database."];
insideRange=Cases[lookup,{graph_,_,_,dim_,_}/;(dim>minDimension-0.00001\[And]dim<dimension+0.00001\[And]!DimensionAtMostQ[minDimension][graph]\[And]DimensionAtMostQ[dimension][graph])];
DebugPrint["Of those, ",Length[insideRange]," are in the desired range."];
disallowed=disallowed~Join~Cases[insideRange,{g_,_,_,_,obstruction:Except[Null]}:>{g,{obstruction}}];
allowed=allowed~Join~Cases[insideRange,{g_,_,_,_,Null}:>g];
batch=Complement[batch,First/@lookup];
RequestObstructions[batch];
If[Length[batch]>0,DebugPrint["finished putting obstructions requests on the queue."];];,
DebugPrint["Graph lookup failed, probably due to a network error."];
];
unknowns=unknowns~Join~batch;
];
While[Length[unknowns]>0,
batch=Take[unknowns,Min[100,Length[unknowns]]];
unknowns=Drop[unknowns,Min[100,Length[unknowns]]];
DebugPrint["Processing ",Length[batch], " graphs locally."];
RecordObstructions[batch];
batch=Union[CanonicalizeBigraph/@batch];
DebugPrint["After canonicalizing, there are ",Length[batch]," graphs"];
batch=Cases[batch,g_/;DimensionAtMostQ[dimension][g]\[And]!DimensionAtMostQ[minDimension][g]];
DebugPrint["Of those, ",Length[batch]," are in the desired range."];
allowed=allowed~Join~Cases[batch,x_/;Length[KnownObstructions[x]]==0];
disallowed=disallowed~Join~Cases[batch,(x_/;Length[KnownObstructions[x]]>0):>{x,KnownObstructions[x]}];
DebugPrint["Finished working on local batch; looking for new data on the server."];
canonicalForms=LookupCanonicalForms[Take[unknowns,Min[1000,Length[unknowns]]]];
If[canonicalForms=!=$Failed,
DebugPrint["Found ",Length[canonicalForms]," new canonical forms."];
unknowns=Union[Complement[unknowns,First/@canonicalForms]~Join~(Last/@canonicalForms)];,
DebugPrint["Looking up canonical forms failed, probably due to a network error."];
];
lookup=LookupGraphs[Take[unknowns,Min[1000,Length[unknowns]]]];
If[lookup=!=$Failed,
DebugPrint["Found new information about ",Length[lookup]," graphs"];
insideRange=Cases[lookup,{graph_,_,_,dim_,_}/;(dim>minDimension-0.00001\[And]dim<dimension+0.00001\[And]!DimensionAtMostQ[minDimension][graph]\[And]DimensionAtMostQ[dimension][graph])];
disallowed=disallowed~Join~Cases[insideRange,{g_,_,_,_,obstruction:Except[Null]}:>{g,{obstruction}}];
allowed=allowed~Join~Cases[insideRange,{g_,_,_,_,Null}:>g];
unknowns=Complement[unknowns,First/@lookup];,
DebugPrint["Graph lookup failed, probably due to a network error."];
];
];
allowed=Union[GraphFromString/@allowed];
disallowed=Union[{GraphFromString[#[[1]]],#[[2]]}&/@disallowed];
If[package,
DebugPrint["Packaging data ..."];
PackageEverything[dimension];
DebugPrint["... finished packaging data."];
];
{"Allowed bigraphs"->allowed,"Disallowed bigraphs"->disallowed}
]]


FindAllBigraphs[dimension_?NumericQ,totalRank_Integer]:=FindAllBigraphs[{If[dimension>2,2,0],dimension},totalRank,GradedBigraph[{{1}}]]
FindAllBigraphs[dimension_?NumericQ,totalRank_Integer,seed_GradedBigraph]:=FindAllBigraphs[{If[dimension>2,2,0],dimension},totalRank,seed]


RequestAllBigraphs[{minDimension_,dimension_},maximumRank_Integer,k_Integer:1]:=RequestAllBigraphs[{minDimension,dimension},maximumRank,GradedBigraph[{{1}}],k];
RequestAllBigraphs[{minDimension_,dimension_},maximumRank_Integer,seed_GradedBigraph,k_Integer:1]:=
Module[{seeds,iterator,allowed={},disallowed=0,unknowns=0,count,canonicalForms,insideRange,batch,lookup},
seeds={seed};
(*candidates=
Join@@(DeleteCases[FindBigraphExtensionsUpToRankAndDepthJava[dimension][#,maximumRank,maximumRank-1],x_/;DimensionAtMostQ[minDimension][x]]&/@seeds);*)
iterator=FindBigraphExtensionsUpToRankAndDepthJavaIterator[dimension][seed,maximumRank,maximumRank-1];
While[iterator@hasNext[],
batch=iterator@next[];
canonicalForms=LookupCanonicalForms[batch];
If[canonicalForms=!=$Failed,
DebugPrint["Found ",Length[canonicalForms],"-->", Length[Union[Last/@canonicalForms]]," canonical forms."];
batch=Union[Complement[batch,First/@canonicalForms]~Join~(Last/@canonicalForms)];,
DebugPrint["Looking up canonical forms failed, probably due to a network error."];
];
lookup=LookupGraphs[batch];
If[lookup=!=$Failed,
DebugPrint["Found information about ",Length[lookup]," graphs in the database."];
count=Count[lookup,{__,Null}];
allowed=Union[allowed~Join~Cases[lookup,{g_,___,Null}:>g]];
disallowed+=Length[lookup]-count;
batch=Complement[batch,First/@lookup];,
DebugPrint["Graph lookup failed, probably due to a network error."];
];
unknowns+=Length[batch];
RequestObstructions[batch,k];
If[Length[batch]>0,DebugPrint["finished putting obstructions requests on the queue."];];
];
RecordRequestAllBigraphs[dimension,maximumRank,seed,Length[allowed],disallowed,unknowns];
If[unknowns>0,QueueExpression[RequestAllBigraphs[{minDimension,dimension},maximumRank,seed,2],2]];
{allowed,disallowed,unknowns}
]


RequestAllBigraphs[dimension_?NumericQ,totalRank_Integer,k_Integer:1]:=RequestAllBigraphs[{If[dimension>2,2,0],dimension},totalRank,GradedBigraph[{{1}}],k]
RequestAllBigraphs[dimension_?NumericQ,totalRank_Integer,seed_GradedBigraph,k_Integer:1]:=RequestAllBigraphs[{If[dimension>2,2,0],dimension},totalRank,seed,k]


End[];


EndPackage[];
