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

SetDebugMode[True];

ListPlot[Table[NumericDimensionOfGenerator[AnBigraph[k]~Join~GradedBigraph[{{1},{1}},{{1,0},{0,1}}]],{k,2,30}],"PlotJoined"->True]

ListPlot[Table[NumericDimensionOfGenerator[AnBigraph[k]~Join~GradedBigraph[{{1}},{{1},{1},{1}},IdentityMatrix[3]]],{k,2,30}],"PlotJoined"->True]

ListPlot[Table[NumericDimensionOfGenerator[AnBigraph[k]~Join~GradedBigraph[(({{1}, {1}})),(({{1, 0}, {1, 0}, {0, 1}}))]],{k,2,30}],"PlotJoined"->True]

Clear[LimitingDimension]

LimitingDimension[g_GradedBigraph]:=LimitingDimension[g]=NumericDimensionOfGenerator[AnBigraph[40]~Join~g]

branches1={GradedBigraph[{{2}}],GradedBigraph[(({{1}, {1}}))],GradedBigraph[(({{1}, {1}, {1}}))],GradedBigraph[(({{1}, {1}, {1}, {1}}))]};

branches2={GradedBigraph[(({{1}, {1}})),(({{1, 0}}))],GradedBigraph[(({{1}, {1}})),(({{1, 0}, {0, 1}}))],GradedBigraph[(({{1}, {1}, {1}})),IdentityMatrix[3]],GradedBigraph[(({{1}, {1}})),(({{1, 0}, {1, 0}, {0, 1}}))],GradedBigraph[(({{1}, {1}})),(({{1, 0}, {1, 0}}))],GradedBigraph[(({{1}, {1}})),(({{1, 0}, {1, 0}, {1, 0}, {0, 1}}))],GradedBigraph[(({{1}, {1}})),(({{1, 0}, {1, 0}, {1, 0}}))],GradedBigraph[(({{1}, {1}})),(({{1, 0}, {1, 0}, {0, 1}, {0, 1}}))]};

SortBy[{DisplayBigraph[AnBigraph[10]~Join~#],LimitingDimension[#]}&/@branches1,#[[2]]&]//TableForm

HighlySupertransitiveSeeds[d_,depth_]:=With[{k=30},Union[CanonicalizeBigraph/@(#/.GradedBigraph[{{1}}..,z0:Except[{{1}}],z1___]:>GradedBigraph[{{1}},{{1}},{{1}},{{1}},{{1}},z0,z1]&/@Cases[DeleteCases[(GraphFromString/@FindBigraphExtensionsUpToRankAndDepthJava[d][AnBigraph[k],1000,k+depth]),GradedBigraph[{{1}}..]],g:GradedBigraph[{{1}}..,z0:Except[{{1}}],z1___]/;Length[{z1}]==depth-1])]
]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[3+(Sqrt[3])]),1]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[3+(Sqrt[3])]),2]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[3+(Sqrt[3])]),3]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[3+(Sqrt[3])]),4]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[3+(Sqrt[3])]),5]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[3+(Sqrt[3])]),6]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[5]),1]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[5]),2]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[5]),3]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[5]),4]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[5]),5]

DisplayBigraph/@HighlySupertransitiveSeeds[(Sqrt[5]),6]

g=HighlySupertransitiveSeeds[(Sqrt[5]),6][[3]]

SquareBigraph[a_,b_]:=AnBigraph[a+1]~Join~GradedBigraph[{{1},{1}},{{1,1}}]~Join~AnBigraph[b+1]

Map[{DisplayBigraph[#],KnownObstructions[#]}&,Table[SquareBigraph[a,b],{a,1,4},{b,1,4}],{2}]//TableForm

DisplayBigraph[SquareBigraph[5,5]]

DisplayBigraph/@HighlySupertransitiveSeeds[3,1]

DisplayBigraph/@HighlySupertransitiveSeeds[3,2]

DisplayBigraph/@HighlySupertransitiveSeeds[3,3]

DisplayBigraph/@HighlySupertransitiveSeeds[3,4]

LimitingDimension[HaagerupBigraph]

SortBy[{DisplayBigraph[AnBigraph[10]~Join~#],LimitingDimension[#]}&/@branches2,#[[2]]&]//TableForm

N[(Sqrt[5])]