Fricke-Macbeath Graph

Author

Eric W. Weisstein
July 24, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/Fricke-MacbeathGraph.nb.

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

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

Figure

GraphicsGrid[
Partition[
StyleGraphs[
GraphData["FrickeMacbeathGraph","Graph","All"],
EdgeStyle->Directive[LightDarkSwitched@Black,Opacity[.5]]
],
UpTo[5]
],
Dividers->All
]

Sources

https://en.wikipedia.org/wiki/Macbeath_surface

This surface was originally discovered by Robert Fricke (1899), but named after Alexander Murray Macbeath due to his later independent rediscovery of the same curve.  Elkies writes that the equivalence between the curves studied by Fricke and Macbeath "may first have been observed by Serre in a 24.vii.1990 letter to Abhyankar".  In a later survey article Macbeath attributes the result to Fricke.

https://houseofgraphs.org/graphs/52273

https://math.stackexchange.com/questions/5066009/classification-of-simple-finite-locally-c-7-graphs

Jürgen Bokowski and Michael Cuntz.  "Hurwitz's regular map (3, 7) of genus 7: A polyhedral realization."  The Art of Discrete and Applied Mathematics 1, #P1.02, 2018.  https://doi.org/10.26493/2590-9770.1186.258

"For the Hurwitz surface of genus 7, the name Macbeath surface is used as well, although the corresponding article of Macbeath is from 1965"

A. M. Macbeath, On a curve of genus 7, Proc. London Math. Soc. 15 (1965), 527–542, doi: 10.1112/plms/s3-15.1.527

Fricke, R. (1899), "Ueber eine einfache Gruppe von 504 Operationen", Mathematische Annalen, 52 (2–3): 321–339, doi:10.1007/BF01476163, S2CID 122400481.

Properties

Genus

GraphData["FrickeMacbeathGraph","Genus"]

Locally C7

Select[GraphData["Local"],GraphData[#,"LocalGraph","Name"]==={"Cycle",7}&]

Embeddings

<<MathWorld`Graphs`

Names

GraphData["FrickeMacbeathGraph","StandardName"]

GraphData["FrickeMacbeathGraph","StandardNames"]

HouseOfGraphs

hogid=GraphData["FrickeMacbeathGraph","NotationRules","HouseOfGraphs"]

HouseOfGraphsLookup[hogid]

HouseOfGraphsGraph[hogid]//StyleGraphs[#,ImageSize->Small]&

Wikidata

GraphData["FrickeMacbeathGraph","WikidataID"]

GraphData["FrickeMacbeathGraph","WikidataID","URL"]

Primary

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

All

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

CurvedEdge

GraphData["FrickeMacbeathGraph","Graph","CurvedEdge"]//StyleGraphs

Inexact

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

Embeddings

GraphDataEmbeddings[GraphData["FrickeMacbeathGraph"]]

Embeddings from "halves"

Ed Pegg Jr.
2025-05-21

From https://houseofgraphs.org/graphs/52273  and https://math.stackexchange.com/questions/5066009/classification-of-simple-finite-locally-c-7-graphs

(but I changed the edgelist)

ee={{1,2},{1,3},{1,4},{1,5},{1,6},{1,7},{1,8},{2,3},{2,8},{2,9},{2,15},{2,16},{2,28},{3,4},{3,9},{3,10},{3,17},{3,18},{4,5},{4,10},{4,11},{4,19},{4,20},{5,6},{5,11},{5,12},{5,21},{5,22},{6,7},{6,12},{6,13},{6,23},{6,24},{7,8},{7,13},{7,14},{7,25},{7,26},{8,14},{8,15},{8,27},{8,29},{9,16},{9,17},{9,30},{9,47},{9,52},{10,18},{10,19},{10,31},{10,46},{10,50},{11,20},{11,21},{11,32},{11,48},{11,57},{12,22},{12,23},{12,33},{12,44},{12,55},{13,24},{13,25},{13,34},{13,45},{13,53},{14,26},{14,29},{14,35},{14,51},{14,56},{15,27},{15,28},{15,36},{15,49},{15,54},{16,28},{16,33},{16,41},{16,52},{16,62},{17,18},{17,34},{17,38},{17,47},{17,59},{18,34},{18,40},{18,50},{18,61},{19,20},{19,35},{19,37},{19,46},{19,58},{20,35},{20,39},{20,48},{20,60},{21,22},{21,36},{21,43},{21,57},{21,64},{22,36},{22,38},{22,44},{22,59},{23,24},{23,30},{23,42},{23,55},{23,63},{24,30},{24,37},{24,45},{24,58},{25,26},{25,31},{25,41},{25,53},{25,62},{26,31},{26,43},{26,56},{26,64},{27,29},{27,32},{27,42},{27,54},{27,63},{28,33},{28,39},{28,49},{28,60},{29,32},{29,40},{29,51},{29,61},{30,37},{30,42},{30,47},{30,52},{31,41},{31,43},{31,46},{31,50},{32,40},{32,42},{32,48},{32,57},{33,39},{33,41},{33,44},{33,55},{34,38},{34,40},{34,45},{34,53},{35,37},{35,39},{35,51},{35,56},{36,38},{36,43},{36,49},{36,54},{37,51},{37,52},{37,58},{38,53},{38,54},{38,59},{39,55},{39,56},{39,60},{40,45},{40,57},{40,61},{41,44},{41,46},{41,62},{42,47},{42,48},{42,63},{43,49},{43,50},{43,64},{44,46},{44,59},{44,65},{45,57},{45,58},{45,71},{46,58},{46,65},{47,48},{47,59},{47,66},{48,60},{48,66},{49,50},{49,60},{49,67},{50,61},{50,67},{51,52},{51,61},{51,68},{52,62},{52,68},{53,54},{53,62},{53,69},{54,63},{54,69},{55,56},{55,63},{55,70},{56,64},{56,70},{57,64},{57,71},{58,65},{58,71},{59,65},{59,66},{60,66},{60,67},{61,67},{61,68},{62,68},{62,69},{63,69},{63,70},{64,70},{64,71},{65,66},{65,71},{65,72},{66,67},{66,72},{67,68},{67,72},{68,69},{68,72},{69,70},{69,72},{70,71},{70,72},{71,72}};

fmg=Graph[Range[72],UndirectedEdge@@@ee];
gdm=GraphDistanceMatrix[fmg];
ArrayPlot[gdm]

g=Graph[Range[72],UndirectedEdge@@@ee,  VertexCoordinates->
Join[{1-> {-12/10,0}, 72-> {12/10,0}},
Thread[{6,68,4,70,2,65,7,67,5,69,3,71,8,66}->(135/100 CirclePoints[14]) ],
Thread[{9,58,14,60,12,62,10,64,15,59,13,61,11,63}->(2 CirclePoints[14]) ],Thread[{24,23,51,52,20,19,55,56,16,28,46,44,26,25,49,50,22,21,53,54,18,17,57,45,27,29,47,48}->(24/10 CirclePoints[28]) ],
Thread[{30,37,35,39,33,41,31,43,36,38,34,40,32,42}->(3 CirclePoints[14])]]]

set={{1},{5,8,4,7,3,6,2},{15,11,14,10,13,9,12},{22,21,27,29,20,19,26,25,18,17,24,23,16,28},{36,32,35,31,34,30,33},Reverse@{37,41,38,42,39,43,40},Reverse@{51,52,46,44,53,54,47,48,55,56,49,50,57,45},Reverse@{58,62,59,63,60,64,61},Reverse@{68,65,69,66,70,67,71},{72}};

places1=Thread[Flatten[set]-> Flatten[{{{0,0}},CirclePoints[7],CirclePoints[7],()CirclePoints[14],CirclePoints[7],-1.15CirclePoints[7],(-+.1)CirclePoints[14],-CirclePoints[7],-CirclePoints[7], {{0,0}}},1]];

Half of the graph has a notable structure:

g1=Graph[Range[36],UndirectedEdge@@@Select[ee, Max[#]<= 36&],VertexLabels->Placed[Automatic,Center],VertexSize-> .3,
VertexCoordinates-> Take[places1,36]]

places2=Thread[Reverse[Flatten[set]]-> (Flatten[{{{0,0}},CirclePoints[7],CirclePoints[7],()CirclePoints[14],CirclePoints[7],-1.15CirclePoints[7],(-+.1)CirclePoints[14],-CirclePoints[7],-CirclePoints[7], {{0,0}}},1])];

The other half of the graph has the same structure:

g2=Graph[Range[37,72],UndirectedEdge@@@Select[ee, Min[#]>= 37&],VertexLabels->Placed[Automatic,Center],VertexSize-> .3,
VertexCoordinates-> Take[places2,36]]

{g1,g2}

PlanarGraphQ@g1

RecognizeGraph/@{g1,g2}

IsomorphicGraphQ[g1,g2]

Putting them all together:

[EWW: modified by making the two center points lie on the x-axis]

c1=Graph[UndirectedEdge@@@ee,  VertexCoordinates->
Join[{1-> {1/10,0}, 72-> {-1/10,0}},
Thread[{5,3,8,6,4,2,7}-> -3/4CirclePoints[7]],
Thread[{68,70,65,67,69,71,66}-> 3/4CirclePoints[7]],
Thread[{9,52,37,51,14,56,39,55,12,44,41,46,10,50,43,49,15,54,38,53,13,45,40,57,11,48,42,47}-> (RotationMatrix[-Pi/28].#&/@(15/10CirclePoints[28]))],Thread[{30,24,58,19,35,20,60,28,33,16,62,25,31,26,64,21,36,22,59,17,34,18,61,29,32,27,63,23}->(RotationMatrix[-Pi/28].#&/@(2 CirclePoints[28]))]]]

DegenerateGraphEmbeddingTypes@c1

g=c1;

c2=Graph[UndirectedEdge@@@ee, VertexCoordinates->
Join[{1-> {1/10,0}, 72-> {-1/10,0}},
Thread[{5,3,8,6,4,2,7}-> -1CirclePoints[7]],
Thread[{68,70,65,67,69,71,66}-> 1CirclePoints[7]],
Thread[{15,13,11,9,14,12,10}-> -24/10CirclePoints[7]],
Thread[{58,60,62,64,59,61,63}-> 27/10CirclePoints[7]],
Thread[{48,55,52,46,56,49,44,53,50,57,54,47,45,51}-> 2.2CirclePoints[14]],Thread[{30,24,37,19,35,20,39,28,33,16,41,25,31,26,43,21,36,22,38,17,34,18,40,29,32,27,42,23}->(RotationMatrix[-Pi/28].#&/@(3 CirclePoints[28]))]]]

c3=Graph[UndirectedEdge@@@ee,  VertexCoordinates->
Join[{1-> {1/10,0}, 72-> {-1/10,0}},
Thread[{5,3,8,6,4,2,7}-> -1CirclePoints[7]],
Thread[{68,70,65,67,69,71,66}-> 1CirclePoints[7]],
Thread[{15,13,11,9,14,12,10}-> -122/100CirclePoints[7]],
Thread[{58,60,62,64,59,61,63}-> 149/100CirclePoints[7]],
Thread[{51,52,55,56,46,44,49,50,53,54,57,45,47,48}-> 16/10CirclePoints[14]],Thread[{30,24,37,19,35,20,39,28,33,16,41,25,31,26,43,21,36,22,38,17,34,18,40,29,32,27,42,23}->(RotationMatrix[-Pi/28].#&/@(2 CirclePoints[28]))]]]

c4=Graph[UndirectedEdge@@@ee, VertexCoordinates->
Join[{1-> {1/10,0}, 72-> {-1/10,0}},
Thread[{5,3,8,6,4,2,7}-> -8/10CirclePoints[7]],
Thread[{68,70,65,67,69,71,66}-> 8/10CirclePoints[7]],
Thread[{15,13,11,9,14,12,10}-> -165/100CirclePoints[7]],
Thread[{58,60,62,64,59,61,63}-> 18/10CirclePoints[7]],
Thread[{52,51,56,55,44,46,50,49,54,53,45,57,48,47}-> 165/100CirclePoints[14]],Thread[{30,24,37,19,35,20,39,28,33,16,41,25,31,26,43,21,36,22,38,17,34,18,40,29,32,27,42,23}->(N[RotationMatrix[-Pi/28]].#&/@(2 CirclePoints[28]))]]]

RecognizeGraph/@{c1,c2,c3,c4}

[EWW combine directly]

newee=Complement[ee,List@@@EdgeList[g1],List@@@EdgeList[g2]]

g=Graph[Range[72],ee,VertexCoordinates->Join[GraphEmbedding[g1],GraphEmbedding[g2]]]

RecognizeGraph@g

DegenerateGraphEmbeddingTypes@g

g=Graph[Range[72],ee,VertexCoordinates->Join[{-1/2,0}+#&/@GraphEmbedding[g1],{1/2,0}+#&/@GraphEmbedding[g2]]]

RecognizeGraph@g

DegenerateGraphEmbeddingTypes@g

Default embedding

GraphPlot[Graph[GraphData["FrickeMacbeathGraph","VertexList"],GraphData["FrickeMacbeathGraph","Edges"]]]

s=Sqrt[3]/2;
v={};
g=Graph[Range@Length@v,UndirectedEdge@@@{},VertexCoordinates->v,VertexLabels->Automatic]

g=FindCorrespondingGraph[,v]

RecognizeGraph@g

Degenerate

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

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

GeneralizedPetersen

GraphData["FrickeMacbeathGraph","Graph","GeneralizedPetersen"]//StyleGraphs

IGraph

GraphData["FrickeMacbeathGraph","Graph","IGraph"]//StyleGraphs

Bipartite

GraphData["FrickeMacbeathGraph","Bipartite"]

GraphData["FrickeMacbeathGraph","Graph","Bipartite"]//StyleGraphs

Bilateral

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

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

Circular

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

Circular construction All

GraphData["FrickeMacbeathGraph","Hamiltonian"]

GraphData["FrickeMacbeathGraph","HamiltonianCycles"]

GraphData["FrickeMacbeathGraph","HamiltonianCycleCount"]

GraphData["FrickeMacbeathGraph","LCF"]

GraphData["FrickeMacbeathGraph","LCFSignature"]

BilateralHamiltonianCycleQ[GraphData["FrickeMacbeathGraph"]]

FindBilateralHamiltonianCycle[GraphData["FrickeMacbeathGraph"]]

Planar

GraphData["FrickeMacbeathGraph","Planar"]

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

MinimalCrossingNumber: "EmbeddingScheme" -> 1

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->1,TimeConstraint->1])//AbsoluteTiming

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

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->1,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->1,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->1,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->1,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 2

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->2,TimeConstraint->1])//AbsoluteTiming

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

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->2,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->2,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->2,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->2,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossingNumber: "EmbeddingScheme" -> 3

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->3,TimeConstraint->1])//AbsoluteTiming

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

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->3,TimeConstraint->60])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->3,TimeConstraint->3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->3,TimeConstraint->5 3600])//AbsoluteTiming

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],"EmbeddingScheme"->3,TimeConstraint->86400])//AbsoluteTiming

MinimalCrossing

GraphData["FrickeMacbeathGraph","CN"]

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

MinimalRectilinearCrossing

GraphData["FrickeMacbeathGraph","RCN"]

GraphData["FrickeMacbeathGraph","Graph","MinimalRectilinearCrossing"]//StyleGraphs

MinimalRectilinearCrossing construction order X [minimum RCN == ]

Length[gs=FindMinimalRectilinearCrossingGraph[GraphData["FrickeMacbeathGraph"],Automatic,All,"Size"->Automatic,Method->"SubgraphIsomorphism",Debug->True]]//Timing

MaxMemoryUsed[]/10^9. GB

Tally[RectilinearCrossingCount/@gs]//Timing

Tally[RectilinearLocalCrossingCount/@gs]//Timing

GraphSymmetryGroup/@gs//Tally

Select[gs,GraphSymmetryGroup[#]=!=TransformationGroup[{}]&]

Take[gs,UpTo[100]]

MinimalCrossing construction

(cn=CrossingNumber[GraphData["FrickeMacbeathGraph"],TimeConstraint->1])//AbsoluteTiming

(g=MinimalCrossingGraph[GraphData["FrickeMacbeathGraph"],"CrossingNumber"->cn])//PolyhedralGraphQ

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

tuttegraphs=IGLayoutTutte[g,"OuterFace"->#]&/@faces

Select[tuttegraphs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData["FrickeMacbeathGraph","V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

Select[tuttegraphs,Count[OuterFace[#],_?(GreaterThan[GraphData["FrickeMacbeathGraph","V"]])]==0&]

Select[tuttegraphs,Count[OuterFace[#],_?(GreaterThan[GraphData["FrickeMacbeathGraph","V"]])]==1&]

(gs=Table[RotateGraph[MinimalCrossingGraph[GraphData["FrickeMacbeathGraph"],"CrossingNumber"->cn,RandomSeed->n]],{n,1000}]//Union)//Timing

Select[gs,Count[OuterFace[#],_?(GreaterThan[GraphData["FrickeMacbeathGraph","V"]])]==0&]

Select[gs,Count[OuterFace[#],_?(GreaterThan[GraphData["FrickeMacbeathGraph","V"]])]==1&]

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData["FrickeMacbeathGraph","V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

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

RecognizeGraph[g]

RectilinearCrossingCount[g]

RectilinearLocalCrossingCount[g]

MinimalLocalCrossing

GraphData["FrickeMacbeathGraph",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["FrickeMacbeathGraph","Graph","MinimalLocalCrossing"]//StyleGraphs

MinimalRectilinearLocalCrossing

GraphData["FrickeMacbeathGraph",{"LocalCrossingNumber","RectilinearLocalCrossingNumber"}]

GraphData["FrickeMacbeathGraph","Graph","MinimalRectilinearLocalCrossing"]//StyleGraphs

MinimaRectilinearlLocalCrossing construction

AdjacentCrossingsQ[g_Graph,cn_Integer]:=Module[{a=AdjacencyList[g],n=VertexCount[g]-cn},Max[Take[a,-cn]]>n]

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

(gs=Select[Table[MinimalCrossingGraph[GraphData["FrickeMacbeathGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData["FrickeMacbeathGraph","V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

(gs=Select[Table[MinimalCrossingGraph[GraphData["FrickeMacbeathGraph"],"CrossingNumber"->(cn=XXX),RandomSeed->i],{i,20000}],!AdjacentCrossingsQ[#,cn]&]//Union)//Timing

Select[gs,GraphSymmetryGroup[#,AdditionalData->Join[Table[True,GraphData["FrickeMacbeathGraph","V"]],Table[False,cn]],SameTest->Equal]=!=TransformationGroup[{}]&]

Circulant

GraphData["FrickeMacbeathGraph","Circulant"]

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

Circulant construction

GraphData["FrickeMacbeathGraph","NotationRules","Circulant"]

(ci=CirculantIndices[GraphData["FrickeMacbeathGraph"]])//Timing

CirculantGraph1@@@ci

Cases[GraphData["FrickeMacbeathGraph","StandardNames"],{"Circulant",i_}:>i]

CirculantGraph1@@@%

Complement graph

compl=GraphData["FrickeMacbeathGraph","ComplementGraph","Name"]

Line graph

GraphData["FrickeMacbeathGraph","Line"]

LineGraphQ[GraphData["FrickeMacbeathGraph"]]//Timing

RootGraph

roots=Select[GraphData[All],GraphData[#,"LineGraph","Name"]==="FrickeMacbeathGraph"&]

RootGraph[GraphData["FrickeMacbeathGraph"]]

RecognizeGraph[%]

Halin

GraphData["FrickeMacbeathGraph","Halin"]

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

Rigid

GraphData["FrickeMacbeathGraph","Rigid"]

GraphData["FrickeMacbeathGraph","Graph","Rigid"]//StyleGraphs

Flexible

GraphData["FrickeMacbeathGraph","Flexible"]

GraphData["FrickeMacbeathGraph","Graph","Flexible"]//StyleGraphs

Voltage

GraphData["FrickeMacbeathGraph","Graph","Voltage"]//StyleGraphs

Voltage construction

gs=VoltageGraph[GraphData["FrickeMacbeathGraph"],"MaxResults"->20,Debug->True]

Length[gs]

RecognizeGraph/@gs

VoltageGraphNotation/@gs//Column

EmbeddingClasses/@gs//Column

GraphSymmetryGroup/@gs//Column

LCF

GraphData["FrickeMacbeathGraph","LCF"]

GraphData["FrickeMacbeathGraph","HamiltonianCycleCount"]

GraphData["FrickeMacbeathGraph","LCFSignature"]

GraphData["FrickeMacbeathGraph","LCFNotations"]

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

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

LCF compute FindBilateralHamiltonianCycle

BilateralHamiltonianCycleQ[GraphData["FrickeMacbeathGraph"],Debug->True]//AbsoluteTiming

(BilateralHamiltonianCycles=FindBilateralHamiltonianCycle[GraphData["FrickeMacbeathGraph"],Debug->True])//AbsoluteTiming

g=BilateralGraph@CircularEmbeddingFromHamiltonianCycle[GraphData["FrickeMacbeathGraph"],BilateralHamiltonianCycles[[1]]]

LCFNotation@g

LCF compute FindHighlySymmetricLCFNotation

lcf=FindHighlySymmetricLCFNotation[GraphData["FrickeMacbeathGraph"],TimeConstraint->600,Debug->True];//AbsoluteTiming

lcf[[All,-1]]//Tally

l2={
{"FrickeMacbeathGraph",{0,Missing["NotAvailable",Most@{{18,4},{9,256},{6,2352},{3,161789}}]}}
}

PropertyReplace[l2,"LCFSignature"]

RenameGraphFiles[]

gs=NiceLCFGraphs[lcf,18,9]

nicelcf=LCFNotation/@gs

nicelcftally=nicelcf[[All,-1]]//Tally

nicelcftally[[All,-1]]//Total

bilatgs=Select[gs,BilateralGraphEmbeddingQ]

bilatlcf=LCFNotation/@bilatgs;

bilatlcf[[All,-1]]//Tally

LCF compute random

FindRandomLCFNotation[GraphData["FrickeMacbeathGraph"],TimeConstraint->120]

FindRandomLCFNotation[GraphData["FrickeMacbeathGraph"],TimeConstraint->3600]

FindRandomLCFNotation[GraphData["FrickeMacbeathGraph"],TimeConstraint->86400]

LCF compute 10^5 [4.5 GB]

Tally[(lcf=LCF[GraphData["FrickeMacbeathGraph"],10^5])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

LCF compute 10^6 [5.5 GB]

Tally[(lcf=LCF[,10^6])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

LCF compute 10^7 [54 GB]

Tally[(lcf=LCF[,10^7])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

LCF compute 3*^7 [161 GB]

Tally[(lcf=LCF[,3*^7])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

LCF compute 5*^7 [XX GB]

Tally[(lcf=LCF[,5*^7])[[All,2]]]//Timing

MaxMemoryUsed[]/10.^9 "GB"

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

(nice=SelectFirst[lcf,GraphSymmetryGroup[LCFGraph@@#]=!=TransformationGroup[{}]&])//Timing

l={
{"FrickeMacbeathGraph",{0,Missing["NotAvailable",LCFNotation/@gs]}}
}

PropertyReplace[l,"LCFNotations","14.3"]

RenameGraphFiles[]

LCF compute all

Divisors[GraphData["FrickeMacbeathGraph","V"]]

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

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

MaxMemoryUsed[]/10.^9 "GB"

Tally[(lcf=ReadProperty["LCFNotations",GraphNameToFileName["FrickeMacbeathGraph",".m.gz"]])[[All,2]]]//Timing

DeleteCases[lcf,{_,1}]

LCFGraph@@@DeleteCases[lcf,{_,1}]//StyleGraphs

Tally[LCFNotation[#][[-1]]&/@(gs=NiceLCFGraphs[lcf,2,1])]//Timing

Length[gs]

gs

BilateralGraphEmbeddingQ/@gs

(nice=SelectFirst[lcf,GraphSymmetryGroup[LCFGraph@@#]=!=TransformationGroup[{}]&])//Timing

UnitDistance

GraphData["FrickeMacbeathGraph","UnitDistance"]

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

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

UnitDistance by refinement

UnitDistanceEmbeddingRefine[Graph[GraphData["FrickeMacbeathGraph","VertexList"],GraphData["FrickeMacbeathGraph","EdgeList"]],MaxIterations->500]

UnitDistanceEmbeddingRefine[Annotate[#,VertexCoordinates->N[GraphEmbedding[#]]],MaxIterations->500]&/@Complement@@(GraphData["FrickeMacbeathGraph","Graph",#]&/@{"All","UnitDistance"})

UnitDistance by FindUnitDistanceEmbedding

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

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

Matchstick

GraphData["FrickeMacbeathGraph","Matchstick"]

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

3D default

Graph3D[GraphData["FrickeMacbeathGraph","Edges"]]

3D construction

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

RecognizeGraph[g]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["FrickeMacbeathGraph","Polyhedral"]

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

Construction

House of Graphs

fmg=HouseOfGraphsGraph[52273]

RecognizeGraph@g

VertexCount[fmg]

GraphAutomorphismGroup[fmg]//GroupOrder

LocalGraphQ[fmg]

LocalGraph[fmg]//RecognizeGraph

Cyclic two-half construction

Ed Pegg, Jr. 
2025-05-20

ee={{1,2},{1,3},{1,4},{1,5},{1,6},{1,7},{1,8},{2,3},{2,8},{2,9},{2,15},{2,16},{2,28},{3,4},{3,9},{3,10},{3,17},{3,18},{4,5},{4,10},{4,11},{4,19},{4,20},{5,6},{5,11},{5,12},{5,21},{5,22},{6,7},{6,12},{6,13},{6,23},{6,24},{7,8},{7,13},{7,14},{7,25},{7,26},{8,14},{8,15},{8,27},{8,29},{9,16},{9,17},{9,30},{9,47},{9,52},{10,18},{10,19},{10,31},{10,46},{10,50},{11,20},{11,21},{11,32},{11,48},{11,57},{12,22},{12,23},{12,33},{12,44},{12,55},{13,24},{13,25},{13,34},{13,45},{13,53},{14,26},{14,29},{14,35},{14,51},{14,56},{15,27},{15,28},{15,36},{15,49},{15,54},{16,28},{16,33},{16,41},{16,52},{16,62},{17,18},{17,34},{17,38},{17,47},{17,59},{18,34},{18,40},{18,50},{18,61},{19,20},{19,35},{19,37},{19,46},{19,58},{20,35},{20,39},{20,48},{20,60},{21,22},{21,36},{21,43},{21,57},{21,64},{22,36},{22,38},{22,44},{22,59},{23,24},{23,30},{23,42},{23,55},{23,63},{24,30},{24,37},{24,45},{24,58},{25,26},{25,31},{25,41},{25,53},{25,62},{26,31},{26,43},{26,56},{26,64},{27,29},{27,32},{27,42},{27,54},{27,63},{28,33},{28,39},{28,49},{28,60},{29,32},{29,40},{29,51},{29,61},{30,37},{30,42},{30,47},{30,52},{31,41},{31,43},{31,46},{31,50},{32,40},{32,42},{32,48},{32,57},{33,39},{33,41},{33,44},{33,55},{34,38},{34,40},{34,45},{34,53},{35,37},{35,39},{35,51},{35,56},{36,38},{36,43},{36,49},{36,54},{37,51},{37,52},{37,58},{38,53},{38,54},{38,59},{39,55},{39,56},{39,60},{40,45},{40,57},{40,61},{41,44},{41,46},{41,62},{42,47},{42,48},{42,63},{43,49},{43,50},{43,64},{44,46},{44,59},{44,65},{45,57},{45,58},{45,71},{46,58},{46,65},{47,48},{47,59},{47,66},{48,60},{48,66},{49,50},{49,60},{49,67},{50,61},{50,67},{51,52},{51,61},{51,68},{52,62},{52,68},{53,54},{53,62},{53,69},{54,63},{54,69},{55,56},{55,63},{55,70},{56,64},{56,70},{57,64},{57,71},{58,65},{58,71},{59,65},{59,66},{60,66},{60,67},{61,67},{61,68},{62,68},{62,69},{63,69},{63,70},{64,70},{64,71},{65,66},{65,71},{65,72},{66,67},{66,72},{67,68},{67,72},{68,69},{68,72},{69,70},{69,72},{70,71},{70,72},{71,72}};

fmg2=Graph[Range[72],UndirectedEdge@@@ee]

RecognizeGraph[fmg2]

ArrayPlot[GraphDistanceMatrix[#]]&/@{fmg,fmg2}

tri = Sort[Sort/@(First/@# &/@FindCycle[fmg,{3},All])]

Select[tri,MemberQ[#,33]&]

Length[tri]

Tally[Sort[Flatten[GraphDistanceMatrix[fmg]]]]

Position[GraphDistanceMatrix[fmg][[1]],5]

local1=Union[Flatten[With[{k=#},Union[Flatten[Select[tri,MemberQ[#,k]&]]]]&/@Union[Flatten[Select[tri,MemberQ[#,1]&]]]]]

Sort[Table[{Length[Intersection[local1,
Union[Flatten[With[{k=#},Union[Flatten[Select[tri,MemberQ[#,k]&]]]]&/@Union[Flatten[Select[tri,MemberQ[#,j]&]]]]]]],j},{j,1,72}]]

local16=Union[Flatten[With[{k=#},Union[Flatten[Select[tri,MemberQ[#,k]&]]]]&/@Union[Flatten[Select[tri,MemberQ[#,16]&]]]]]

Complement[Range[72],Flatten[{local1,local16}]]

twographs=Graph[UndirectedEdge@@@Select[List@@@EdgeList[fmg],(Length[Intersection[#,local1]]==2)||(Length[Intersection[#,local16]]==2)&], VertexLabels->"Name"]

cc=ConnectedGraphComponents[twographs]

IsomorphicGraphQ@@cc

RecognizeGraph/@cc

Compact cyclic two-half generator

A compact generator obtained by organizing the edge list above into two isomorphic 36-vertex halves. The argument h is 0 or 1 and selects a half. center[h] is its fixed vertex. orbit1[h, i] through orbit5[h, i] are its five seven-vertex orbits. The index i is reduced modulo 7.

fmgCyclic=Module[{center,orbit1,orbit2,orbit3,orbit4,orbit5,mod,half,join},mod[i_]:=Mod[i,7];half[h_]:=Flatten[Table[UndirectedEdge@@@{{center[h],orbit1[h,i]},{orbit1[h,i],orbit1[h,mod[i+3]]},{orbit1[h,i],orbit2[h,mod[i+2]]},{orbit1[h,i],orbit2[h,mod[i+5]]},{orbit1[h,i],orbit3[h,mod[i+4]]},{orbit1[h,i],orbit4[h,mod[i+3]]},{orbit2[h,i],orbit3[h,mod[i+6]]},{orbit2[h,i],orbit4[h,mod[i+1]]},{orbit2[h,i],orbit5[h,mod[i+4]]},{orbit3[h,i],orbit4[h,mod[i+6]]},{orbit3[h,i],orbit5[h,i]},{orbit4[h,i],orbit5[h,mod[i+1]]}},{i,0,6}],1];join=Flatten[Table[UndirectedEdge@@@{{orbit2[0,i],orbit3[1,mod[-i]]},{orbit2[0,i],orbit4[1,mod[-i]]},{orbit3[0,i],orbit2[1,mod[-i]]},{orbit3[0,i],orbit3[1,mod[6-i]]},{orbit3[0,i],orbit5[1,mod[4-i]]},{orbit4[0,i],orbit2[1,mod[-i]]},{orbit4[0,i],orbit4[1,mod[1-i]]},{orbit4[0,i],orbit5[1,mod[4-i]]},{orbit5[0,i],orbit3[1,mod[4-i]]},{orbit5[0,i],orbit4[1,mod[4-i]]},{orbit5[0,i],orbit5[1,mod[4-i]]},{orbit5[0,i],orbit5[1,mod[5-i]]}},{i,0,6}],1];FrickeMacbeathGraph=Graph[Join[half[0],half[1],join]]]

RecognizeGraph@FrickeMacbeathGraph

GraphData

GraphDataClassString

GraphDataClassString["FrickeMacbeathGraph"]

GraphDataString

<<MathWorld`Graphs`

file=OpenWrite["~/fricke-macbeath.m"]

fmg=HouseOfGraphsGraph[52273]

WriteString[
file,
GraphDataString[
fmg,
"Embeddings"->None,
"StandardName"->"FrickeMacbeathGraph",
"AlternateStandardNames"->{"MacbeathGraph"},
"Name"->"Fricke\[Hyphen]Macbeath graph",
"AlternateNames"->{"Macbeath graph"},
"Skip"->{"ConnectedInducedSubgraphPolynomial","ConstructionNumber","CyclicEdgeConnectivity","DominatingSets","IdiosyncraticPolynomial","IndependencePolynomial","IndependentEdgeSets","IndependentVertexSets","IntersectionNumber","MatchingGeneratingPolynomial","MatchingPolynomial","MaximumIndependentEdgeSetCount","MaximumIndependentEdgeSets","MetricDimension","MinimumConnectedDominatingSet","MinimumCyclicEdgeCuts","MinimumDominatingSets","MinimumTotalDominatingSets","MinimumVertexColorings","MinimumWeightFractionalColoring","MinimumWeightFractionalEdgeColoring","MinorCount","QuadraticEmbeddingConstant","TotalDominatingSets","TuttePolynomial"}
]]

Close[file]