McGee Graph

Author

Eric W. Weisstein
August 7, 2023

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

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

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

Construction graphic

Combinatorica (update)

Context[GraphUnion]

p=GraphUnion[MakeGraph[Range[8],Mod[#1-#2,8]==3&],Cycle[8]];
p=GraphUnion[p,EmptyGraph[8]];
Do[p=AddEdge[p,{i,i+ 8}],{i,8}];
mcg1=MakeUndirected[p /. Graph[l_List,v_List]:>Graph[l,Join[CircularVertices[8],2CircularVertices[8],1.5CircularVertices[8]]]];
q=EmptyGraph[8];
Do[q=AddEdge[q,{2i-1,2i}],{i,4}];
mcg2=MakeUndirected[q /. Graph[l_List,v_List]:>Graph[l,Flatten[Table[{j,.5i+1.25},{i,4},{j,-1,1,2}],1]] ];
mcg=mcg1;
vs={5,6,7,8,1,2,3,4};
Do[mcg=AddEdge[mcg,16+{i,vs[[i]]}],{i,8}];

vs={5,3,1,8,6,4,2,7};
Show[GraphicsArray[{
Graphics[{
PointSize[.035],graphic[mcg1],
Table[Text[Subscript[v,vs[[i]]],{1.6Cos[#],.1+1.6Sin[#]}&[2Pi i/8]],{i,8}]
},AspectRatio->Automatic,PlotRange->2{{-1,1},{-1,1}}],
Graphics[{
PointSize[.05],graphic[mcg2],
Table[Text[Subscript[v,2(5-i)+(j+1)/2-1],{1.2j,.5i+1.25}],{i,4},{j,-1,1,2}]
},AspectRatio->Automatic,PlotRange->{{-1,1},{1,4}}],
Graphics[{
PointSize[.035],graphic[MakeUndirected[mcg]]
},AspectRatio->Automatic]
}]
]

Properties

CrossingNumber

GraphData["McGeeGraph","CrossingNumber"]

[Computation timed out!]

Dear Eric Weisstein,

we are sorry to report that the requested computation (McGee graph) failed.
Please contact Markus Chimani (http://www-lehre.informatik.uni-osnabrueck.de/theoinf/index/staff/chimani)
if you really need to compute the crossing number of this graph.

Please visit this link for detailed results: http://crossings.uos.de/job/RJkmDvCJNF_1ke_cqyvSRQ

Embeddings

<<MathWorld`Graphs`

Names

GraphData["McGeeGraph","StandardName"]

GraphData["McGeeGraph","StandardNames"]

Primary

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

All

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

Inexact

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

Embedding types

GraphDataEmbeddings[GraphData["McGeeGraph","EdgeList"]]

Default embedding

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

v=Join[UnitCirclePoints[16],CirclePoints[3/2,4],CirclePoints[{1/2,Pi/2},4]];
g=Graph[Range[Length[v]],UndirectedEdge@@@{e[1,3,5,7,9,11,13,15,1],Sequence@@Partition[Range[2,16,2],2,1,1],e[13,23,4],e[12,21,5],e[9,22,16],e[1,24,8],e[14,20,15],e[2,17,3],e[6,18,7],e[11,19,10],{19,17},{20,18},{21,23},{22,24}},VertexCoordinates->v,VertexLabels->Automatic]

RecognizeGraph@g

RecognizeGraph[g]

Degenerate

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

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

Bilateral

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

Circular

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

Planar

GraphData["McGeeGraph","Planar"]

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

MinimalCrossing

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

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

MinimalCrossing construction

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

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

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

faces=ReverseSort@SymmetricallyDistinctFaces[g]

Tally[ReverseSort[Length/@faces]]

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

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

Table[MinimalCrossingGraph[GraphData["McGeeGraph"],"CrossingNumber"->cn,RandomSeed->i],{i,500}]//Union

g0=;

GraphEmbedding[g0]

v={#/7,#2/8}&@@@GraphEmbedding[g0];
g=Annotate[g0,VertexCoordinates->v]

RecognizeGraph[g]

RectilinearCrossingCount[g]

Circulant

GraphData["McGeeGraph","Circulant"]

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

Line graph

GraphData["McGeeGraph","Line"]

LineGraphQ[GraphData["McGeeGraph"]]//Timing

RootGraph

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

RootGraph[GraphData["McGeeGraph"]]

Halin

GraphData["McGeeGraph","Halin"]

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

Rigid

GraphData["McGeeGraph","Rigid"]

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

Flexible

GraphData["McGeeGraph","Flexible"]

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

LCF

GraphData["McGeeGraph","LCF"]

GraphData["McGeeGraph","HamiltonianCycleCount"]

GraphData["McGeeGraph","LCFSignature"]

GraphData["McGeeGraph","LCFNotations"]

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

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

LCF compute all

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

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

lcf

LCFGraph@@@lcf//StyleGraphs

(gs=Flatten[{
(* all LCF's with order >1, sorted by order and with bilateral graphs first *)
Join[DeleteCases[#,{_Missing,_}][[All,1]],Cases[#,{_Missing,_}][[All,2]]]&/@Map[{BilateralLCFGraph@#,#}&,Map[LCFGraph@@#&,SplitBy[DeleteCases[lcf,{_,1}],Last],{2}],{2}],
(* order-1 bilateral only *)
DeleteMissing[BilateralLCFGraph@@@Cases[lcf,{_,1}]]}])//Timing

Length[gs]

UnitDistance

GraphData["McGeeGraph","UnitDistance"]

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

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

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

UnitDistance by refinement

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

UnitDistanceGraphEmbeddingQ[%]

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

Select[%,UnitDistanceGraphEmbeddingQ]

g=;

UnitDistance by FindUnitDistanceEmbedding

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

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

UnitDistance FindSubgraphUnitDistanceEmbedding

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

gs=UniqueEmbeddings[l]

gs={,,,,};

Matchstick

GraphData["McGeeGraph","Matchstick"]

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

3D default

Graph3D[GraphData["McGeeGraph","Edges"]]

3D All

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

3D UnitDistance

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

3D Polyhedron

GraphData["McGeeGraph","Polyhedral"]

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

Construction

MinimalRectilinearCrossing

Show[ImageCrop@Import["http://isu.indstate.edu/ge/COMBIN/RECTILINEAR/mcgee.gif"],ImageSize->"Small"]

LCF (Modulo)

McGeeGraphConstruction:=MakeUndirected[MakeGraph[Range[24],(Mod[{#1,#2},3]=={0,0}&&Abs[#1-#2]==12||Mod[#1-#2,24]==1||((Mod[(-1)^(#1)(#1-#2),24]==17||Mod[(-1)^(#1)(#1-#2),24]==7)&&Mod[#1,3]≠0&&Mod[#2,3]≠0))&]]

ShowGraph[McGeeGraphConstruction]

RecognizeGraph[McGeeGraphConstruction]

Harary, p. 174

ShowLabeledGraph[g=AddEdges[AddVertices[ChangeVertices[MakeUndirected[MakeGraph[Range[8],Mod[#1-#2,8]==3&]],RotationMatrix[π/8.].#&/@CircularEmbedding[8][[All,1]]],Join[
1.5 RotationMatrix[π/8.].#&/@CircularEmbedding[8][[All,1]],
2RotationMatrix[π/8.].#&/@CircularEmbedding[8][[All,1]]]
],
Join[
Partition[Range[17,24],2,1,1],
Table[{n,n+8},{n,16}],
Table[{n,n+4},{n,9,12}]
]
]
]

RecognizeGraph[g]

UnitDistance

Ed Pegg, Jr.

http://community.wolfram.com/groups/-/m/t/583974

ca. 2016

McGeePoints=RootReduce[{{0,1/2},{0,-1/2},{1/2,0},{-1/2,0},{Sqrt[2]/4,Sqrt[2]/4},{-Sqrt[2]/4,Sqrt[2]/4},{Sqrt[2]/4,-Sqrt[2]/4},{-Sqrt[2]/4,-Sqrt[2]/4},{Cos[a],1/2+Sin[a]},{-Cos[a],1/2+Sin[a]},{Cos[a],-1/2-Sin[a]},{-Cos[a],-1/2-Sin[a]},{1/2+Sin[a],Cos[a]},{-1/2-Sin[a],Cos[a]},{1/2+Sin[a],-Cos[a]},{-1/2-Sin[a],-Cos[a]},{Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7],Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8]},{-Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7],Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8]},{Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7],-Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8]},{-Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7],-Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8]},{Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8],Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7]},{-Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8],Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7]},{Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8],-Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7]},{-Root[81-2592 #1+24192 #1^2-81792 #1^3+149760 #1^4-215040 #1^5-1777664 #1^6+11354112 #1^7-23052288 #1^8+15728640 #1^9+6291456 #1^10-12582912 #1^11+4194304 #1^12&,8],-Root[81+2592 #1+24192 #1^2+81792 #1^3+149760 #1^4+215040 #1^5-1777664 #1^6-11354112 #1^7-23052288 #1^8-15728640 #1^9+6291456 #1^10+12582912 #1^11+4194304 #1^12&,7]}}/.a->ArcSin[Root[-71+624 #1+192 #1^2-2688 #1^3-1152 #1^4+3072 #1^5+2048 #1^6&,2]]];

McGeeLines={{1,2},{1,9},{1,10},{2,11},{2,12},{3,4},{3,13},{3,15},{4,14},{4,16},{5,8},{5,17},{5,21},{6,7},{6,18},{6,22},{7,19},{7,23},{8,20},{8,24},{9,17},{9,23},{10,18},{10,24},{11,19},{11,21},{12,20},{12,22},{13,18},{13,21},{14,17},{14,22},{15,20},{15,23},{16,19},{16,24}};

g=GraphData[gn="McGeeGraph"];

VertexCount[g]

g1=System`Graph[Range[24],UndirectedEdge@@@McGeeLines,VertexCoordinates->McGeePoints]

RecognizeGraph[g1]

dist=EuclideanDistance@@@(List@@@EdgeList[g1]/.i_Integer:>GraphEmbedding[g1][[i]]);

Block[{$MaxExtraPrecision=100},N[dist-1,10^6]]//Union

Do[Print[{i,RootReduce[dist[[i]]]//Timing}],{i,Length[dist]}]

RootReduce[dist]//Union//Timing

McGeePoints//ByteCount

ByteCount[pt2=FullSimplify[McGeePoints]]//Timing

Exact expression is too large (in byte count) to include explcitly