Frucht Graph

Author

Eric W. Weisstein
November 9, 2022

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/FruchtGraph.nb.

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

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

Embeddings

GraphData["FruchtGraph","StandardName"]

Primary

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

All

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

Embedding types

GraphDataEmbeddings[GraphData["FruchtGraph","EdgeList"]]

Default embedding

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

GraphData["FruchtGraph","Graphics"]

f=1/5;
v={{0,0},{1,0},{1,2/3},{1,1},{3f,1},{0,1},{0,2/3},{2f,1/3},{f,2/3},{2f,2/3},{3f,2/3},{4f,2/3}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,4,5,6,7,1,8,2],e[7,9,10,11,12,3],{8,10},{5,11},{4,12},{6,9}},VertexCoordinates->v,VertexLabels->"Name"]

RecognizeGraph[g]

Degenerate

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

Bilateral

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

Circular

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

Planar

GraphData["FruchtGraph","Planar"]

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

Tutte embeddings

faces=ReverseSort@SymmetricallyDistinctFaces[GraphData["FruchtGraph"]]

Tally[ReverseSort[Length/@faces]]

IGLayoutTutte[GraphData["FruchtGraph"],"OuterFace"->#]&/@faces

gs=Annotate[#,{VertexLabels->None,ImageSize->Tiny}]&/@{}

RecognizeGraph/@gs

Tutte embedding construction

GraphPlot[RotateGraph[]]

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

RecognizeGraph[g]

MinimalCrossing

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

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

MinimalCrossing Construction

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

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["FruchtGraph","Circulant"]

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

Halin

GraphData["FruchtGraph","Halin"]

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

LCF

GraphData["FruchtGraph","LCF"]

GraphData["FruchtGraph","LCFSignature"]

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

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

LCF compute

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

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

gs=LCFGraph@@@lcf//StyleGraphs

gs=Join[With[{g=BilateralLCFEmbedding[#]},If[MissingQ[g],#,g]]&/@LCFGraph@@@DeleteCases[lcf,{_,1}],DeleteMissing[BilateralLCFEmbedding/@LCFGraph@@@Cases[lcf,{_,1}]]]

UnitDistance

GraphData["FruchtGraph","UnitDistance"]

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

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

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

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding construction

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

gs=UniqueEmbeddings[l]

gs={,,,,,};

Matchstick

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

3D All

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

3D Polyhedron

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

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

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

3D Polyhedron construction

poly=GraphPolyhedron[GraphData["FruchtGraph"],-1]

Graphics3D[{FaceForm[Green,Red],poly}]

Graphics3D[poly2=Polyhedron[Normalize/@poly[[1]],poly[[2]]]]

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

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

SimplePolyhedronQ[can]

(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]

Properties

Through[{V,M,PlanarQ,HamiltonianQ}[FruchtGraph]]

CubicQ[FruchtGraph]

Automorphisms[FruchtGraph]

Spectrum[FruchtGraph]//SpectrumForm//TraditionalForm

ChromaticPolynomial[FruchtGraph,z]

Construction

FruchtGraphConstruction:=AddEdges[ChangeVertices[GraphUnion[Cycle[7],EmptyGraph[5]],Join[CircularVertices[7],.4CircularVertices[4],{{-.1,.05}}]],{{5,10},{10,6},{10,12},{9,12},{4,9},{3,9},{12,8},{8,2},{8,11},{11,7},{11,1}}]