Foster Cage

Author

Eric W. Weisstein
November 11, 2022

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/FosterCage.nb.

For more information, see Eric's MathWorld entry https://mathworld.wolfram.com/FosterCage.html.

©2022 Wolfram Research, Inc. except for portions noted otherwise

Embeddings

GraphData["FosterCage","StandardName"]

Primary

GraphData["FosterCage"]//StyleGraphs[#,ImageSize->Small]&

All

GraphData["FosterCage","Graph","All"]//StyleGraphs

Exact nested rings

g0=Annotate[CenterGraph@LabelGraph@(),Axes->True]

Norm/@(v0=GraphEmbedding[g0])

DegenerateGraphEmbeddingTypes[g0]

groups=SplitBy[SortBy[MapIndexed[{#2[[1]],Round[2Norm[#]]/2,Mod[ArcTan@@#,2Pi],#}&,v0],#[[2]]&],#[[2]]&]

a1=SortBy[groups[[1]],#[[3]]&][[All,1]]

a2=SortBy[groups[[2]],#[[3]]&][[All,1]]

v=FullSimplify@Join[CirclePoints[{1,Pi/2},15],CirclePoints[{1/2,Pi/2},15]][[InversePermutation@Join[a2,a1]]];
g=Graph[Range[Length[v]],EdgeList[g0],VertexCoordinates->v,VertexLabels->Automatic]

EdgeList[g]

RegionIntersection[Line[v[[{9,11}]]],Line[v[[{7,9}]]]]

Graphics[{Line[v[[{9,11}]]],{Red,Line[v[[{7,9}]]]},PointSize[Large],Point[v[[9]]]}]

RecognizeGraph[g]

DegenerateGraphEmbeddingQ[g,Debug->True]

DegenerateGraphEmbeddingTypes[g]

GraphEmbedding[g]

BilateralGraphEmbeddingQ[g]

v=FullSimplify@Join[CirclePoints[{1,Pi/2},15],CirclePoints[{1/2,-.7},15]][[InversePermutation@Join[a2,a1]]];
g=Graph[Range[Length[v]],EdgeList[g0],VertexCoordinates->v,VertexLabels->Automatic]

Default embedding

GraphPlot@GraphData["FosterCage","Edges"]

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Embedding types

GraphDataEmbeddings[GraphData["FosterCage","EdgeList"]]

Degenerate

GraphData["FosterCage","Graph","Degenerate"]//StyleGraphs

Bilateral

GraphData["FosterCage","Graph","Bilateral"]//StyleGraphs

Circular

GraphData["FosterCage","Graph","Circular"]//StyleGraphs

Planar

GraphData["FosterCage","Planar"]

GraphData["FosterCage","Graph","Planar"]//StyleGraphs

MinimalCrossing

GraphData["FosterCage",{"RCN","CN"}]

GraphData["FosterCage","Graph","MinimalCrossing"]//StyleGraphs

MinimalCrossing construction

(cn=CrossingNumber[GraphData["FosterCage"],TimeConstraint->10])//AbsoluteTiming

CrossingNumber[GraphData["FosterCage"],TimeConstraint->60]//AbsoluteTiming

g=RotateGraph[MinimalCrossingGraph[GraphData["FosterCage"],"CrossingNumber"->cn]]

Union[Select[Table[RotateGraph[MinimalCrossingGraph[GraphData["FosterCage"],"CrossingNumber"->cn,RandomSeed->n]],{n,50}],Max[OuterFace[#]]<=GraphData["FosterCage","V"]&]]//Timing

v={};
g=Graph[Range[Length[v]],UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["FosterCage","Circulant"]

GraphData["FosterCage","Graph","Circulant"]//StyleGraphs

Halin

GraphData["FosterCage","Halin"]

GraphData["FosterCage","Graph","Halin"]//StyleGraphs

LCF

GraphData["FosterCage","LCF"]

GraphData["FosterCage","HamiltonianCycleCount"]

GraphData["FosterCage","LCFSignature"]

GraphData["FosterCage","Graph","LCF"]//StyleGraphs

Tally[LCFFromEmbedding[#][[2]]&/@%]

BilateralLCFEmbedding/@(LCFGraph@@@LCFFromEmbedding/@{,})

LCF compute

Length[FindHamiltonianCycle[GraphData["FosterCage"],All][[All,All,1]]]//Timing

Tally[(lcf=LCF[GraphData["FosterCage"],All])[[All,2]]]//Timing

ComputeLCF["FosterCage","Prune"->False,Method->"FindPath","ChunkSize"->10*^6,Debug->True]

FileByteCount[file="/Volumes/GraphProperties/Properties/LCFNotations/FosterCage.m.gz"]

Tally[(lcf=Import[file])[[All,-1]]]//Timing//AbsoluteTiming

LCFGraph@@@Take[lcf,2]

LCFGraph@@@lcf

(gs=DeleteMissing[BilateralLCFEmbedding/@(LCFGraph@@@Cases[lcf,{_,3}])])//Timing

(gs=DeleteMissing[BilateralLCFEmbedding/@(LCFGraph@@@Take[Cases[lcf,{_,1}],10^3])])//Timing

UnitDistance

GraphData["FosterCage","UnitDistance"]

UnitDistanceGraphQ[GraphData["FosterCage"],Debug->True]//Timing

GraphData["FosterCage","Graph","UnitDistance"]//StyleGraphs

Select[%,!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&]

UnitDistance by refinement

UnitDistanceEmbeddingRefine/@GraphData["FosterCage","Graph","All"]

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistanceEmbeddingRefine/@Complement@@(GraphData["FosterCage","Graph",#]&/@{"All","UnitDistance"})

Select[%,UnitDistanceGraphEmbeddingQ]

UnitDistance by FindUnitDistanceEmbedding

FindUnitDistanceEmbedding[GraphData["FosterCage"],MaxIterations->5000,"ReturnWithMessage"->True]//Timing

FindUnitDistanceEmbedding[GraphData["FosterCage"],MaxIterations->5000,"ReturnWithMessage"->False]//Quiet//Timing

FindUnitDistanceEmbedding[GraphData["FosterCage"],MaxIterations->50000,"ReturnWithMessage"->False]//Quiet//Timing

UnitDistance refine

UnitDistanceEmbeddingRefine[,WorkingPrecision->1000]

Abs[EdgeLengths[%]-1]//N//Union

(Not UD)

UnitDistance by FindSubgraphUnitDistanceEmbedding

{"FosterCage",l=FindSubgraphUnitDistanceEmbedding[GraphData["FosterCage"],TimeConstraint->300,"Results"->All]//Timing}

gs=SortBy[UniqueEmbeddings[l],Replace[RectilinearCrossingCount[#],Infinity->0]&]

Matchstick

GraphData["FosterCage","Matchstick"]

GraphData["FosterCage","Graph","Matchstick"]//StyleGraphs

3D default

Graph3D[GraphData["FosterCage","Edges"]]

3D All

GraphData["FosterCage","Graph",{"3D","All"}]

3D UnitDistance

GraphData["FosterCage","Graph",{"3D","UnitDistance"}]

3D Polyhedron

GraphData["FosterCage","Polyhedral"]

GraphData["FosterCage","Graph",{"3D","Polyhedron"}]

Properties

Through[{Union[DegreeSequence[#]]&,V,M,Diameter,Girth}[FosterCage]]

Chromatic Number

ChromaticNumber[FosterCage]//Timing

Chromatic Polynomial

(p=ChromaticPolynomial[FosterCage,z])//Timing

TraditionalForm[Factor[p]]

Spectrum

Spectrum[FosterCage]//SpectrumForm//TraditionalForm

Automorphism Group

Length[Automorphisms[FosterCage]]//Timing