FusionAtlasPaths={"c:\\scott\\projects\\fusionatlas\\code\\package\\","~/Documents/math papers/fusionatlas/code/package/","~/Documents/Math/fusionatlas/code/package/"};
$Path=$Path~Join~FusionAtlasPaths;
<<FusionAtlas`

t[k_]:=t[k,k]

t[n_,k_]:=t[n,k,k]

t[a_,b_,c_]:=trivalentBigraph[a,b,c]

Table[PositivityTest[t[a,2,b]],{a,1,10},{b,1,10}]//TableForm

Table[GHJTest[t[a,2,b]],{a,1,10},{b,1,10}]//TableForm

Table[AnnularTanglesTest[t[a,2,b]],{a,1,10},{b,1,10}]//TableForm

ListPlot[Table[NumericDimensionOfGenerator[t[k]],{k,1,20}],"PlotJoined"->True]

q[k_]:=q[k,k]

q[n_,k_]:=GradedBigraph@@(Join@@{Table[{{1}},{n}],{{{1},{1},{1}}},Table[IdentityMatrix[3],{k}]})

q[a_,b_,c_,d_]/;b≤c≤d∧b>0∧c>0∧d>0:=GradedBigraph@@(Table[{{1}},{a}]~Join~{{{1},{1},{1}}}~Join~Table[IdentityMatrix[3],{b-1}]~Join~Switch[{b==c,c==d},
{True,True},{},
{True,False},{{{1,0,0}}}~Join~Table[{{1}},{d-c-1}],
{False,True},{{{1,0,0},{0,1,0}}}~Join~Table[IdentityMatrix[2],{c-b-1}],
{False,False},{{{1,0,0},{0,1,0}}}~Join~Table[IdentityMatrix[2],{c-b-1}]~Join~{{{1,0}}}~Join~Table[{{1}},{d-c-1}]
])

q[2,3,4,4]

q[a_,b_,c_,d_]:=q[a,Sequence@@Sort[{b,c,d}]]

DisplayBigraph[q[10]]

ListPlot[Table[NumericDimensionOfGenerator[q[k]],{k,1,20}],"PlotJoined"->True]

DisplayBigraph[g=GradedBigraph[{{1}},{{1},{1}},{{1,0},{1,0}}]]

d[k_]:=AnBigraph[k]~Join~g~Join~(GradedBigraph@@Table[IdentityMatrix[2],{k}])

DisplayBigraph[d[10]]

ListPlot[Table[NumericDimensionOfGenerator[d[k]],{k,1,20}],"PlotJoined"->True]

NumericDimensionOfGenerator[t[20]]

NumericDimensionOfGenerator[d[20]]

NumericDimensionOfGenerator[q[20]]

N[(Sqrt[3+(Sqrt[2])])]

N[(Sqrt[3+(Sqrt[3])])]

N[(Sqrt[5])]

Table[NumericDimensionOfGenerator[t[k,40]],{k,1,10}]

Table[NumericDimensionOfGenerator[q[k,40]],{k,1,10}]

With[{k=10},Table[NumericDimensionOfGenerator[trivalentBigraph[a,b,c]],{a,1,k},{b,1,k},{c,1,k}]];//AbsoluteTiming

allowedSet={{1,2,1},{1,1,3}};

increasedSet=Flatten[IdentityMatrix[3]+#&/@allowedSet,1]

allowedSet=Cases[increasedSet,x_/;f[x]≤d]

allowedSet=MaximaOfPartialOrdering[allowedSet,And@@Thread[#1≤#2]&]

f=NumericDimensionOfGenerator[t@@#]&;

d=(Sqrt[3+(Sqrt[2])]);

Clear[test]

test[x_]:=test[x]=Max@@x≤15∧f[x]≤d

ExtendSet[set_]:=Sort[MaximaOfPartialOrdering[Select[Flatten[Transpose[#+Transpose[set]]&/@({ZeroVector[3]}~Join~IdentityMatrix[3]),1],test],And@@Thread[#1≤#2]&]]

FixedPoint[ExtendSet,{{1,1,1}}]/.(15->∞)

Union[Sort/@%]

f=NumericDimensionOfGenerator[q@@#]&;

d=(Sqrt[3+(Sqrt[3])]);

Clear[test]

test[x_]:=test[x]=Max@@x≤15∧f[x]≤d

ExtendSet[set_]:=Sort[MaximaOfPartialOrdering[Select[Flatten[Transpose[#+Transpose[set]]&/@({ZeroVector[4]}~Join~IdentityMatrix[4]),1],test],And@@Thread[#1≤#2]&]]

FixedPoint[ExtendSet,{{1,1,1,1}}]/.(15->∞)

Union[Sort/@%]

KnownObstructions[q[8,1,1,2]]

f=NumericDimensionOfGenerator[q@@#]&;

d=(Sqrt[5]);

Clear[test]

test[x_]:=test[x]=Max@@x≤15∧f[x]≤d

ExtendSet[set_]:=Sort[MaximaOfPartialOrdering[Select[Flatten[Transpose[#+Transpose[set]]&/@({ZeroVector[4]}~Join~IdentityMatrix[4]),1],test],And@@Thread[#1≤#2]&]]

FixedPoint[ExtendSet,{{1,1,1,1}}]/.(15->∞)

Union[Sort/@%]

MaximaOfPartialOrdering[list_List,f_]:=MaximaOfPartialOrdering[{},list,f]
MaximaOfPartialOrdering[maxima_List,{},f_]:=maxima
MaximaOfPartialOrdering[maxima_List,{first_,rest___},f_]:=Module[{},
If[Or@@(f[first,#]&/@maxima),
MaximaOfPartialOrdering[maxima,{rest},f],
MaximaOfPartialOrdering[{first}~Join~DeleteCases[maxima,c_/;f[c,first]],{rest},f]
]
]