Fritsch Graph

Author

Eric W. Weisstein
September 6, 2024

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

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

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

Relation to the Soifer graph

g=GraphData["FritschGraph"]//StyleGraphs

s=EdgeDelete[g,4\[UndirectedEdge]9]

RecognizeGraph@s

With[{style=LabelStyle->Directive[Italic,14,Black,FontFamily->"Times"]},GraphicsRow[{Show[g,PlotLabel->"Fritsch graph",style],Style["→",24],Show[s,PlotLabel->"Soifer graph",style]},Alignment->Center,Spacings->-5]]

Embeddings

Names

GraphData["FritschGraph","StandardName"]

GraphData["FritschGraph","StandardNames"]

Primary

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

All

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

Inexact

Select[GraphData["FritschGraph","Graph","All"],(!FreeQ[GraphEmbedding[#],_?InexactNumberQ]&)]//StyleGraphs

Embedding types

GraphDataEmbeddings[GraphData["FritschGraph","EdgeList"]]

Default embedding

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

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

RecognizeGraph[g]

Degenerate

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

DegenerateGraphEmbeddingTypes/@GraphData["FritschGraph","Graph","Degenerate"]

Bilateral

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

Grid[DeleteCases[Monitor[{g=#,BilateralGraphEmbeddingQ[#],GraphSymmetryGroup[#]}&/@GraphData["FritschGraph","Graph","All"],g],{_,_,TransformationGroup[{}]}],Dividers->All,Alignment->{{Center,{Left}}}]

Circular

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

Circular construction

Length[hc=FindHamiltonianCycle[GraphData["FritschGraph"],All][[All,All,1]]]

Length[bilat=DeleteDuplicatesBy[
DeleteMissing[BilaterallyRotatedGraph@CircularEmbeddingFromHamiltonianCycle[GraphData["FritschGraph"],#]&/@hc],
CircularCanonicalGraphEmbedding]]//Timing

gs=bilat

Length[quad=DeleteDuplicatesBy[Union@Select[bilat,BilateralGraphEmbeddingQ[#,Axis->"X"]&],CircularCanonicalGraphEmbedding[#,4]&]]

Planar

GraphData["FritschGraph","Planar"]

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

Tutte embeddings

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

Tally[ReverseSort[Length/@faces]]

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

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

Tutte embedding construction 3 #1

GraphPlot@

v=Join[CirclePoints[Csc[Pi/3]/2,3],CirclePoints[{1/6,Pi/2},6]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,9,2,5,3,7,1,8,9,4,5,6,7,8,6,4,8],{2,4},{3,6}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #2

v={{-1,0},{1,0},{0,Sqrt[3]},{0,1/4},{-1/4,1/2},{1/4,1/2},{0,3/4},{-1/4,1},{1/4,1}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,4,2,9,3,8,1,5,6,9,8,5,4,6,7,8],{2,6},e[5,7,9]},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Tutte embedding construction 3 #3

GraphPlot@RotateGraph[,-2Pi/3]

v={{-1,0},{1,0},{0,Sqrt[3]},{-1/4,1/2},{0,1/2},{1/4,1/2},{0,3/4},{-1/4,1},{1/4,1}};
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,2,3,1,5,2,9,3,8,1,4,5,6,9,8,4,7,9],e[2,6,7,8],{5,7}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph[g]

Halin

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

LCF

GraphData["FritschGraph","LCFSignature"]

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

UnitDistance

GraphData["FritschGraph","UnitDistance"]

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

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

Matchstick

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

3D default

Graph3D[GraphData["FritschGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

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

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

3D Canonical

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

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

3D Canonical construction

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

(can=FindCanonicalPolyhedron[poly,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]

Construction

l=;

ShowLabeledGraph[g=LinesToGraph[l]]

RecognizeGraph[g]

(g2=RenumberVertices[g,{9,3,6,7,1,4,5,2,8}])//ShowLabeledGraph

FastIsomorphicQ[g,g2]

can=Get["/Volumes/Users/eww/Mathematica/Paclets/GraphData/CanonicalForms/9.m"];

Position[can,CanonicalForm[g],1,1]

GraphData

GraphClassString

GraphClassString["FritschGraph"]

GraphDataString

WriteString[file,GraphDataString[g2,
"StandardName"->"FritschGraph",
"AlternateStandardNames"->{{9,264265}},
"AlternateNames"->{"9-graph 264265"},
"Name"->"Fritsch graph",
"Classes"->{"KempeCounterexample"},
"Information"->"FritschGraph",
Debug->True,
TimeConstraint->120
]]