The Icosian Game, Revisited

Ed Pegg Jr

Some extensions of Hamiltonian tours are explored.

The Original Icosian Game

In 1857 Sir William Rowan Hamilton invented the Icosian game [1]. In a world based on the dodecahedral graph, a traveler must visit 20 cities, without revisiting any of them. Today, when the trip makes a loop through all the vertices of the graph, it is called a Hamiltonian tour (or cycle). When the first and last vertices in a trip are not connected, it is called a Hamiltonian path (or trail). The first image shown is a tour; the second is a path.

<<GraphUtilities`
size = 90;
edges = GraphData["DodecahedralGraph","EdgeIndices"];
tours ={Sort/@Partition[HamiltonianCycles[Rule@@@edges][[1]],2,1,1], Sort/@Partition[HamiltonianCycles[Rule@@@Join[edges,{{1,21},{20,21}}]][[1]],2,1,1]};
Grid[{Table[GraphPlot[Rule@@@edges, VertexCoordinateRules-> Thread[Range[20]-> GraphData["DodecahedralGraph","VertexCoordinates"]], 
VertexRenderingFunction->({White,EdgeForm[Black],Disk[#,.18],Black(*, Text[#2,#1]*)}&),
EdgeRenderingFunction->(If[MemberQ[tours[[tour]],List@@#2],{Thick,Blue,Line[#1]},{Dashed,Thick,Red,Line[#1]}]&),
ImageSize-> size],{tour,1,2}],Text/@{"Hamiltonian tour", "Hamiltonian path"}}]

Hamiltonian cycles gained popularity in 1880, when P. G. Tait made the conjecture: “Every cubic polyhedron has a Hamiltonian cycle through all its vertices”. Cubic means that three edges meet at every vertex. Without the cubic requirement, there are smaller polyhedra that are not Hamiltonian. The simplest counterexample is the rhombic dodecahedron. Every edge connects one of six valence-four vertices to one of eight valence-three vertices. The six valence-four vertices would need to occupy every other vertex in the length-14 tour. Six items cannot fill seven slots, so this is impossible.

Last/@Select[Sort[{GraphData[#,"VertexCount"], #}&/@
Intersection[GraphData["Polyhedral"],GraphData["Nonhamiltonian"]]],First[#]<40&];

SizedGraph[name_,size_] := GraphPlot[GraphData[name,"EdgeRules"],
VertexCoordinateRules->Thread[Range[GraphData[name,"VertexCount"]]->GraphData[name,"VertexCoordinates"]],ImageSize-> {size,size}]

size=50;

Grid[{{SizedGraph["GoldnerHararyGraph",size],GraphPlot[{1->2,2->3,3->4,1->4,1->5,5->6,6->7,7->8,8->5,7->9,9->10,10->11,7->11,2->6,2->9,3->10,4->11,4->8},VertexCoordinateRules->Thread[Range[11]->{{0,0},{4,0},{4,4},{0,4},{1,1},{2,1},{2,2},{1,2},{3,2},{3,3},{2,3}}],ImageSize-> {size,size}],GraphPlot[{1->2,1->3,1->5,1->6,2->4,2->7,3->4,3->8,4->9,4->10,5->7,5->11,6->8,6->11,7->9,7->12,8->10,8->13,9->14,10->14,11->12,11->13,12->14,13->14},VertexCoordinateRules->Thread[Range[14]->{{0,5},{0,0},{1,3},{1,1},{5,5},{2,4},{5,0},{2,3},{3,1},{2,2},{4,4},{4,2},{3,3},{3,2}}],ImageSize-> {size,size}]},
Text/@(StringReplace[GraphData[#,"Name"]&/@{"GoldnerHararyGraph","HerschelGraph","RhombicDodecahedralGraph"}," graph" -> ""])
}]

Any noncubic graph can be made cubic by placing a small disk over the exceptions.

size = 50;
Row[Graphics[{White, EdgeForm[Black],Table[Polygon[{{0,0},{0,1},{1,1},{1,0}}+Table[{a,b},{4}]],{a,0,1},{b,0,1}],If[#==1, Disk[{1,1},.1],Sequence@@{}]},ImageSize-> {size,size}]&/@{0,1},Style[" -> ",24]]

The word “polyhedral” implies that the graph must be 3-connected. If a line is drawn to disconnect the map, it must pass through at least three borders. Central Europe is not 3-connected, since a line through Spain will disconnect Portugal. France, the Vatican, and various islands also make the shape of Europe nonpolyhedral.

Graphics[{EdgeForm[Black],LightGray,CountryData[#,"Polygon"]&/@{"Austria","Belgium","Belarus","BosniaHerzegovina","Bulgaria","Croatia","CzechRepublic","Denmark","France","Germany","Greece","Hungary","Latvia","Italy","Lithuania","Liechtenstein","Luxembourg","Macedonia","Moldova","Netherlands","Poland","Portugal","Romania","Serbia","Slovakia","Slovenia","Spain","Switzerland","Ukraine"}}]

Tait’s method turns a Hamiltonian cycle on a cubic polyhedral graph into a four-coloring, by the following method.

Alternately color the edges of the Hamiltonian cycle blue and purple. Color the other edges red.

Throw out thin edges, and color the resulting polygon blue.

Throw out dashed edges, and color the resulting polygon(s) red.

Overlay the two colorings to get a four-coloring.

size=70;
With[{
bluepoly = Polygon[{{151,130},{134,139},{120,153},{120,169},{73,135},{89,130},{106,139},{114,128},{126,128},{130,117},{143,113},{139,94},{120,96},{120,110},{110,117},{97,113},{101,94},{91,80},{149,80},{167,135}}],
redpoly =Polygon/@{{{151,130},{143,113},{130,117},{120,110},{110,117},{114,128},{126,128},{134,139},{120,153},{106,139},{89,130},{97,113},{101,94},{120,96},{139,94},{149,80},{91,80},{73,135},{120,169},{167,135}}}},
With[{
blueseg = Sort/@Flatten[Partition[#,2,1,1]&/@Last/@{bluepoly},1],redseg = Sort/@Flatten[Partition[#,2,1,1]&/@Last/@redpoly,1]},
Row[
{Graphics[{Thick,PointSize[Large],
Purple,Thick,Line/@Intersection[blueseg,redseg],
Red,Thin, Line/@Complement[redseg,blueseg],
Blue,Dashed,Thick,Line/@Complement[blueseg,redseg],

Black,AbsolutePointSize[.1],Point/@Union[Flatten[Union[blueseg,redseg],1]]},ImageSize-> {size,size}],
Graphics[{EdgeForm[Thick],Opacity[.5],Blue,bluepoly},ImageSize-> {size,size}],Graphics[{EdgeForm[Thick],Opacity[.5],Red,redpoly},ImageSize-> {size,size}],
Graphics[{EdgeForm[Thick],Opacity[.5],Red,redpoly,Blue,bluepoly},ImageSize-> {size,size}]}]]]

For 66 years, Tait’s conjecture held. In 1946, W. G. Tutte found the first counterexample, now known as Tutte’s graph. Since then, some smaller cubic polyhedral non-Hamiltonian graphs have been found, with the smallest such graph being the Barnette–Bosák–Lederberg graph, found in 1965. Seven years earlier, Lederberg had won the Nobel Prize in Medicine.

size=50;

Grid[{SizedGraph[#,size]&/@{"BarnetteBosakLederbergGraph","FaulknerYoungerGraph42","FaulknerYoungerGraph44"},
Text/@(StringReplace[GraphData[#,"Name"]&/@{"BarnetteBosakLederbergGraph","FaulknerYoungerGraph42","FaulknerYoungerGraph44"}," graph" -> ""]),
{SizedGraph["GrinbergGraph42",size],SizedGraph["GrinbergGraph46",size],GraphPlot[{1->2,1->3,1->16,2->5,2->6,3->4,3->11,4->5,4->7,5->9,6->10,6->15,7->8,7->12,8->9,8->19,9->20,10->13,10->14,11->12,11->17,12->18,13->21,13->22,14->21,14->23,15->22,15->38,16->17,16->37,17->18,18->19,19->20,20->25,21->24,22->26,23->28,23->29,24->26,24->29,25->27,25->28,26->34,27->30,27->31,28->32,29->32,30->35,30->36,31->33,31->36,32->34,33->37,33->43,34->38,35->39,35->40,36->41,37->46,38->44,39->41,39->42,40->42,40->44,41->43,42->45,43->45,44->46,45->46},VertexCoordinateRules->Thread[Range[46]->{{0,0},{0,898},{207,225},{207,449},{207,898},{363,1526},{415,449},{415,673},{415,898},{557,1414},{622,225},{622,449},{661,1593},{751,1301},{777,2244},{829,0},{829,225},{829,449},{829,673},{829,898},{855,1481},{868,1952},{945,1189},{958,1660},{1036,898},{1062,1840},{1139,718},{1139,1077},{1153,1548},{1334,830},{1347,359},{1347,1436},{1450,180},{1450,1615},{1528,943},{1541,472},{1554,0},{1554,1795},{1632,763},{1722,1055},{1735,584},{1826,875},{1839,404},{1916,1167},{2033,516},{2331,449}}],ImageSize-> {size,size}]},
Text/@(StringReplace[GraphData[#,"Name"]&/@{"GrinbergGraph42","GrinbergGraph46","TuttesGraph"}," graph" -> ""])}]

Hamilton-Connected Graphs

Hamilton’s Icosian game is unfortunately flawed. It is possible to choose two vertices that are not connected by a Hamiltonian path. An improvement would use a Hamilton-connected graph, where all pairs of vertices are connected by a Hamiltonian path [2]. A wide selection of these graphs is given by GraphData["HamiltonConnected"].

size=70;
Grid[{SizedGraph[#,size]&/@{"CrossingNumberGraph8E", "McGeeGraph", {"Fullerene",{26,1}}},
Text/@Text@StringReplace[#,"-"->"\[Hyphen]"]&/@(StringReplace[GraphData[#,"Name"]&/@{"CrossingNumberGraph8E", "McGeeGraph", {"Fullerene",{26,1}}}," graph" -> ""])}]

A more solving-friendly version of the 26-fullerene graph is given next [3]. Vertices have been replaced with squares, and edges are replaced by lines between neighboring squares or connecting green paths. A path at the edge of the diagram wraps around to the opposite edge. To try out the puzzle, put the letters A and Z in any two squares. Then try to find a connecting Hamiltonian path, using the letters A to Z. No matter where you put the A and Z, the puzzle is solvable. For example, if you started with A in block 2, and Z in block 6, one of the two solutions is (A)2 3 4 8 7 15 16 9 10 5 1 14 13 26 25 24 21 20 19 23 22 17 18 11 12 6(Z).

This path can be found and displayed with Mathematica, using the trick of adding a nondisplayed vertex connecting 2 to 6.

edges = {{1,2},{1,5},{1,14},{2,3},{2,11},{3,4},{3,6},{4,5},{4,8},{5,10},{6,7},{6,12},{7,8},{7,15},{8,9},{9,10},{9,16},{10,13},{11,12},{11,18},{12,20},{13,14},{13,26},{14,17},{15,16},{15,21},{16,25},{17,18},{17,22},{18,19},{19,20},{19,23},{20,21},{21,24},{22,23},{22,26},{23,24},{24,25},{25,26}};
vertices = {{0,5.5},{1,5},{3,5},{5,5},{7,5.5},{3,4},{4,4},{5,4},{6,4},{7,4},{1,3},{3,3},{7,2.75},{0,2.75},{4,2.5`},{6,2.5`},{0,1.5`},{1,1.5`},{2,1.5`},{3,1.5`},{4,1.5`},{0,0},{2,0.5`},{4,0.5`},{6,0.5`},{7,0}};
tour =Sort/@Partition[HamiltonianCycles[Rule@@@Join[edges,{{2,27},{6,27}}],All][[3]],2,1,1];
GraphPlot[Rule@@@edges, VertexCoordinateRules-> Thread[Range[26]-> vertices], 
VertexRenderingFunction->({White,EdgeForm[Black],Disk[#,.18],Black (*,Text[#2,#1]*)}&),
EdgeRenderingFunction->(If[MemberQ[tour,List@@#2],{Thick,Blue,Line[#1]},{Thick,Red,Dashed,Line[#1]}]&),
VertexLabeling-> True,ImageSize-> 120]

A harder puzzle involves the Coxeter graph minus an edge. Here is a solving-friendly version of this Hamiltonian puzzle.

References

J. Dalgety. “The Icosian Game.” (Jul 6, 2009)
puzzlemuseum.com/month/picm02/200207icosian.htm.

E. W. Weisstein. “Hamilton-Connected Graph” from Wolfram MathWorld—A Wolfram Web Resource. mathworld.wolfram.com/Hamilton-ConnectedGraph.html.

J. Tierney. “The Hamiltonian Puzzle.” (May 4, 2009)
tierneylab.blogs.nytimes.com/2009/05/04/the-hamiltonian-puzzle.