Faulkner-Younger Graphs

Author

Eric W. Weisstein
May 16, 2022

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/Faulkner-YoungerGraphs.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Faulkner-YoungerGraphs.html.

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

Figure

GraphicsRow[Show[StyleGraphs@GraphData[#],PlotLabel->GraphData[#,"Name"],LabelStyle->Directive[14,Black,FontFamily->"Times",Italic]]&/@GraphData["Faulk*"],Dividers->All]

Properties

TextGrid[GraphData[#,{"#","VertexConnectivity","Cubic","Hamiltonian"}]&/@GraphData["Faulk*"],Dividers->All]

Embeddings

"FaulknerYoungerGraph42"

GraphData["FaulknerYoungerGraph42","StandardName"]

All

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

LCF

GraphData["FaulknerYoungerGraph42","LCFSignature"]

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

UnitDistance

GraphData["FaulknerYoungerGraph42","UnitDistance"]

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

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

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

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

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

FindSubgraphIsomorphism

l=FindSubgraphIsomorphism[GraphData["FaulknerYoungerGraph42"],TimeConstraint->300,"Results"->All]//Timing

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

Default embedding

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

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

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["FaulknerYoungerGraph42"]],-2.5]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Original construction

ShowLabeledGraph[g2=AddEdges[DeleteVertices[g,{14,19}],{{17,18},{13,14}}]]

CubicQ[g2]

RecognizeGraph[g2]

3D default

Graph3D[GraphData["FaulknerYoungerGraph42","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData["FaulknerYoungerGraph42","Polyhedron"]}]

3D Polyhedron Canonical

GraphData["FaulknerYoungerGraph42","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["FaulknerYoungerGraph42","Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["FaulknerYoungerGraph42"],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]

"FaulknerYoungerGraph44"

GraphData["FaulknerYoungerGraph44","StandardName"]

All

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

Halin

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

LCF

GraphData["FaulknerYoungerGraph44","LCFSignature"]

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

UnitDistance

GraphData["FaulknerYoungerGraph44","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

Matchstick

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

MinimalCrossing

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

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

Default embedding

g=Graph@GraphData["FaulknerYoungerGraph44","Edges"]

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

RecognizeGraph[g]

Original construction

ShowLabeledGraph[g=AddEdges[Graph[List/@{{7,34},{21,34},{30,34},{14,19},{10,25},{24,12},{26,33},{28,32},{38,42},{1,35},{13,35},{1,11},{17,44},{4,44},{6,20},{5,18},{9,33},{8,31},{27,23},{15,43},{16,41},{3,39},{2,37},{36,43},{22,29},{40,44}},
List/@{{652,408},{653,357},{654,258},{654,207},{454,14},{259,16},{55,207},{55,257},{58,349},{57,407},{354,553},{351,449},{452,404},{456,382},{456,352},{451,255},{455,208},{406,112},{343,113},{305,113},{260,208},{258,261},{259,351},{261,402},{158,406},{158,355},{209,352},{205,311},{207,259},{160,260},{111,259},{110,308},{111,351},{154,209},{551,407},{554,356},{600,355},{601,306},{602,257},{553,257},{500,256},{504,308},{502,355},{554,206}}/600.],Join[
Partition[Range[33],2,1],
Partition[Range[35,43],2,1]
]
]]

Position[Degrees[g],Except[3],Heads->False]

RecognizeGraph[g]

MinimalCrossing construction

GraphPlot@RotateGraph[MinimalCrossingGraph[GraphData["FaulknerYoungerGraph44"]]]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

3D default

Graph3D[GraphData["FaulknerYoungerGraph44","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

Graphics3D[{FaceForm[Green,Red],GraphData["FaulknerYoungerGraph44","Polyhedron"]}]

3D Canonical

GraphData["FaulknerYoungerGraph44","Graph",{"3D","Canonical"}]

Graphics3D[{Opacity[.5],Red,GraphData["FaulknerYoungerGraph44","Polyhedron"],Yellow,Sphere[]}]

3D Polyhedron construction

Graphics3D[{FaceForm[Green,Red],poly=GraphPolyhedron[GraphData["FaulknerYoungerGraph44"],-1]}]

(can=FindCanonicalPolyhedron[poly,WorkingPrecision->1000,MaxIterations->10000,PrecisionGoal->20])//Timing

(can=FindCanonicalPolyhedron[can,WorkingPrecision->1000,MaxIterations->20000,PrecisionGoal->20])//Timing

SimplePolyhedronQ[can]

Graphics3D[{Opacity[.5],Red,can,Yellow,Sphere[]}]

(lens=Mean/@Split[Sort[PolyhedronEdgeLengths[can]],Abs[#1-#2]<1.*^-10&])//N

v=PolyhedronCoordinates[can];

colors=With[{n=Length[lens]},Table[Hue[i/n],{i,0,n-1}]]

Graphics3D[{Thick,Sequence@@Nearest[Thread[lens->colors],EuclideanDistance@@v[[#]]],Line[v[[#]]]}&/@PolyhedronEdges[can],Boxed->False]

g=PolyhedronGraph[can]