Hamiltonian Graph

Author

Eric W. Weisstein
March 17, 2021

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

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

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

Documentation

From Charles, 2020-12-16: "There is no specific paper.  HamiltonianGraphQ uses sufficient conditions (Dirac theorem, edge condition, ...), necessary conditions (bipartite, ...) and fast methods to detect cycles (heuristic, backtrack algorithm, …) depending on graphs (undirected, directed, multigraph, mixed, ...)."

Parametrized families

Antiprism

Entity["Graph",{"Antiprism",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Antiprism",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,3,25}],{_,x_,x_}]

Complete

Entity["Graph",{"Complete",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Complete",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,20}],{_,x_,x_}]

CompleteBipartite m×n

Entity["Graph",{"CompleteBipartite",{m,n}}]["Hamiltonian"]

DeleteCases[Table[With[{g={"CompleteBipartite",{m,n}}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,25}],{_,x_,x_}]

CompleteBipartite n×n

Entity["Graph",{"CompleteBipartite",{n,n}}]["Hamiltonian"]

DeleteCases[Table[With[{g={"CompleteBipartite",{n,n}}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,10}],{_,x_,x_}]

CompleteTripartite k×m×n

Entity["Graph",{"CompleteTripartite",{k,m,n}}]["Hamiltonian"]

Cases[Flatten[Table[{{k,m,n},GraphData[{"CompleteTripartite",{k,m,n}},"Hamiltonian"]},{n,10},{m,n},{k,m}],2],{gr_,True}:>gr]//Sort

Select[Flatten[Table[{k,m,n},{n,10},{m,n},{k,m}],2],k+m+n≥2Max[k,m,n]&]//Sort

CompleteTripartite n×n×n

Entity["Graph",{"CompleteTripartite",{n,n,n}}]["Hamiltonian"]

DeleteCases[Table[With[{g={"CompleteTripartite",{n,n,n}}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,10}],{_,x_,x_}]

CubeConnectedCycle

Entity["Graph",{"CubeConnectedCycle",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"CubeConnectedCycle",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,5}],{_,x_,x_}]

GraphData[#,"Hamiltonian"]&/@GraphData["CubeConnectedCycle"]

Cycle

Entity["Graph",{"Cycle",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Cycle",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,3,20}],{_,x_,x_}]

DiagonalIntersection

seq=Table[GraphData[{"DiagonalIntersection",n},"V"],{n,3,14}]

seq=Table[GraphData[{"DiagonalIntersection",n},"Hamiltonian"],{n,3,14}]

GraphData[{"DiagonalIntersection",14},"HamiltonianCycles"]

Grid m×n

Entity["Graph",{"Grid",{m,n}}]["Hamiltonian"]

And@@Flatten[Table[GraphData[{"Grid",{m,n}},"Hamiltonian"]==Entity["Graph",{"Knight",{m,n}}]["Hamiltonian"],{n,20},{m,n}]]

Cases[Flatten[Table[{{m,n},GraphData[{"Grid",{m,n}},"Hamiltonian"]},{n,10},{m,n}],1],{gr_,True}:>gr]//Sort

Select[Flatten[Table[{m,n},{n,10},{m,n}],1],#=={1,1}||(Min@@#>1&&Mod[Times@@#,2]==0)&]//Sort

%==%203

Grid n×n

Entity["Graph",{"Grid",{n,n}}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Grid",{n,n}}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,10}],{_,x_,x_}]

Grid k×m×n

Entity["Graph",{"Grid",{k,m,n}}]["Hamiltonian"]

And@@Flatten[Table[GraphData[{"Grid",{m,n}},"Hamiltonian"]==Entity["Graph",{"Knight",{m,n}}]["Hamiltonian"],{n,20},{m,n}]]

Cases[Flatten[Table[{{k,m,n},GraphData[{"Grid",{k,m,n}},"Hamiltonian"]},{n,5},{m,n},{k,m}],2],{gr_,True}:>gr]//Sort

Select[Flatten[Table[{k,m,n},{n,5},{m,n},{k,m}],2],#=={1,1,1}||(Times@@#≠Max@@#&&Mod[Times@@#,2]==0)&]//Sort

%==%203

Grid n×n×n

Entity["Graph",{"Grid",{n,n,n}}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Grid",{n,n,n}}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,10}],{_,x_,x_}]

Empty

Entity["Graph",{"Empty",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Empty",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,30}],{_,x_,x_}]

Hypercube

Entity["Graph",{"Hypercube",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Hypercube",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,0,10}],{_,x_,x_}]

Keller

Entity["Graph",{"Keller",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Keller",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,5}],{_,x_,x_}]

Knight m×n

Entity["Graph",{"Knight",{m,n}}]["Hamiltonian"]

And@@Flatten[Table[GraphData[{"Knight",{m,n}},"Hamiltonian"]==Entity["Graph",{"Knight",{m,n}}]["Hamiltonian"],{n,20},{m,n}]]

Knight n×n

Entity["Graph",{"Knight",{n,n}}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Knight",{n,n}}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,20}],{_,x_,x_}]

Ladder

Entity["Graph",{"Ladder",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Ladder",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,20}],{_,x_,x_}]

MoebiusLadder

Entity["Graph",{"MoebiusLadder",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"MoebiusLadder",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,3,25}],{_,x_,x_}]

Mycielski

Entity["Graph",{"Mycielski",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Mycielski",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,11}],{_,x_,x_}]

Odd

Entity["Graph",{"Odd",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Odd",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,7}],{_,x_,x_}]

Path

Entity["Graph",{"Path",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Path",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,20}],{_,x_,x_}]

Prism

Entity["Graph",{"Prism",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Antiprism",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,3,25}],{_,x_,x_}]

SierpinskiTetrahedron

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"V"],{n,6}]

seq=Table[GraphData[{"SierpinskiTetrahedron",n},"Hamiltonian"],{n,6}]

Table[GraphData[{"SierpinskiTetrahedron",n},"HamiltonianCycles"],{n,5,6}]

Star

Entity["Graph",{"Star",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Star",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,25}],{_,x_,x_}]

Transposition

Entity["Graph",{"Transposition",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Transposition",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,6}],{_,x_,x_}]

Wheel

Entity["Graph",{"Wheel",n}]["Hamiltonian"]

DeleteCases[Table[With[{g={"Wheel",n}},{g,GraphData[g,"Hamiltonian"],Entity["Graph",g]["Hamiltonian"]}],{n,4,20}],{_,x_,x_}]

End-Member Cases

The singleton graph is considered Hamiltonian, but Mathematica reports it as non-Hamiltonian

(Subscript[C, 1])

HamiltonianQ[EmptyGraph[1]]

GraphData["K1","Hamiltonian"]

(Subscript[C, 2])

This graph is not considered Hamiltonian

HamiltonianQ[CompleteGraph[2]]

GraphData["K2","Hamiltonian"]

Counts

SetDirectory[FileNameJoin[{$GraphDataDirectory,"Nodes","Hamiltonian"}]]

Table[Count[ParallelMap[HamiltonianGraphQ,Graphs[n]],True],{n,7}]//AbsoluteTiming

7

Graphs[7];

Count[p=ParallelMap[HamiltonianGraphQ,Graphs[7]],True]//AbsoluteTiming

8

Graphs[8];//AbsoluteTiming

Count[p=ParallelMap[HamiltonianGraphQ,Graphs[8]],True]//AbsoluteTiming

Put[p,"Hamiltonian_8.m"]

9

Length[g=Graphs[9]]//AbsoluteTiming

Count[p=ParallelMap[HamiltonianGraphQ,g],True]//AbsoluteTiming

Put[p,"Hamiltonian_9.m"]

10

Length[g=Graphs[10]]//AbsoluteTiming

Count[p=ParallelMap[HamiltonianGraphQ,g],True]//AbsoluteTiming

Put[p,"Hamiltonian_10.m"]

Graphs

Hamiltonian

Length/@(ham=Select[#,HamiltonianQ]&/@Graphs/@Range[9])//Timing

ShowGraphArray[DeleteCases[Take[ReplacePart[ham,{CompleteGraph[1]},1],5],{}],
VertexStyle->Disk[.12]
]

Nonamiltonian

MapIndexed[NumberOfGraphs[#2[[1]]]-#1&,{0,1,1,3,8,48,383,6196,177083}]

Table

Missing

GraphData["Hamiltonian","Missing"]

Listings

Sort[{GraphData[#,"Name"],GraphData[#,"VertexCount"]}&/@GraphData["Hamiltonian"],Last[#1]<=Last[#2]&]//TableForm

Platonics

Combinatorica

Print[{#,TimeConstrained[HamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["Platonic"];

FastHamiltonianQ (FindHamiltonianCycle in GraphUtilities)

Print[{#,TimeConstrained[FastHamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["Platonic"];

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
HamiltonianGraphPlot/@PlatonicGraphs
]
],ImageSize->500]

Cube

HamiltonianCycle[Skeleton[Polyhedron[Cube]]]

Show[Graphics3D[{
Wireframe[Polyhedron[Cube]],
{Red,Thickness[.02],
Line[PolyhedronVertices[Cube][[HamiltonianCycle[Skeleton[Polyhedron[Cube]]]]]]
}
}],Boxed->False]

WriteLiveForm["hamcube.m",
	Show[Graphics3D[{	
				WireFrame[NetlistSolid[1]][[1]],
				Thickness[.02],RGBColor[1,0,0],
				Line[Part[NetlistSolidVertices[1],{1,3,7,5,6,8,4,2,1}]]}],
		Boxed->False]]

Dodecehedron

WriteLiveForm["hamdod.m",
	Show[Graphics3D[{	
				WireFrame[NetlistSolid[3]][[1]],
				Thickness[.02],RGBColor[1,0,0],
				Line[Part[NetlistSolidVertices[3],{1,2,5,11,12,7,8,4,10,9,14,19,16,15,18,20,17,13,6,3,1}]]}],
		Boxed->False,
	   ViewPoint->{-1.1695655876730247, -1.2935902788331037, -2.8997828412899387},
   ViewVertical->{0.3106794780832444, -0.9213935148675785, 0.3128124278266356}
]]

Icosahedron

HamiltonianCycle[Skeleton[Polyhedron[Icosahedron]]]

Show[Graphics3D[{
Wireframe[Polyhedron[Icosahedron]],
{Red,Thickness[.02],
Line[PolyhedronVertices[Icosahedron][[{1,5,6,10,8,4,2,7,12,11,9,3,1}]]]
}
}],Boxed->False]

WriteLiveForm["hamicos.m",
	Show[Graphics3D[{	
				WireFrame[NetlistSolid[4]][[1]],
				Thickness[.02],RGBColor[1,0,0],
				Line[Part[NetlistSolidVertices[4],{1,5,6,10,8,4,2,7,12,11,9,3,1}]]}],
		Boxed->False,
	   ViewPoint->{-2.47699464637572, 2.2943599241762485, -0.22452184784552703},
   ViewVertical->{-0.46971472978816287, -0.6100594258707658, -0.6941737626012837}
]]

Octahedron

WriteLiveForm["hamoct.m",
	Show[Graphics3D[{	
				WireFrame[NetlistSolid[2]][[1]],
				Thickness[.02],RGBColor[1,0,0],
				Line[Part[NetlistSolidVertices[2],{1,2,4,5,6,3,1}]]}],
		Boxed->False,
	   ViewPoint->{0.047441200677727946, -0.21313864088181247, 3.376732333520279},
   ViewVertical->{-0.4910660039927335, 1.0033636689538246, 0.08732233183989842}
]]

Tetrahedron

WriteLiveForm["hamtet.m",
	Show[Graphics3D[{	
				WireFrame[NetlistSolid[0]][[1]],
				Thickness[.02],RGBColor[1,0,0],
				Line[Part[NetlistSolidVertices[0],{1,2,3,4,1}]]}],
		Boxed->False]]

Archimedean

Combinatorica

Print[{#,TimeConstrained[HamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["Archimedean"];

FastHamiltonianQ (FindHamiltonianCycle in GraphUtilities)

Print[{#,TimeConstrained[FastHamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["Archimedean"]

V8

Options[Graph]//InputForm

Graph[GraphData["CubicalGraph","EdgeRules"],DirectedEdges->False]

HamiltonianGraphQ[Graph[GraphData["CubicalGraph","EdgeRules"],DirectedEdges->False]]

Graph[GraphData["CubicalGraph","EdgeRules"],DirectedEdges->False]//InputForm

$Version

Print[{#,TimeConstrained[HamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["Archimedean"];

Plots

Show[GraphicsArray[partition[HamiltonianGraphPlot/@{
Skeleton[Archimedean[1],1.05],
Skeleton[Archimedean[9],1.9],
Skeleton[Archimedean[12],1.8],
Skeleton[Archimedean[13],1.3]
},4]]]

Archimedean Duals

Combinatorica

Print[{#,TimeConstrained[HamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["ArchimedeanDual"];

FastHamiltonianQ (FindHamiltonianCycle in GraphUtilities)

Print[{#,TimeConstrained[FastHamiltonianQ[Graph[#]],120]//Timing}]&/@GraphData["ArchimedeanDual"];

V8

Testing

Counts

Simple = Connected

A003216

1, 0, 1, 3, 8, 48, 383, 6196, 177083, 9305118, 883156024

Length/@Table[GraphData["Hamiltonian",n],{n,7}]

Count[#,True]&/@Table[(HamiltonianGraphQ/@GraphData/@GraphData[n]),{n,7}]

Count[#,True]&/@Table[(HamiltonianGraphQ/@AdjacencyGraph/@ToAdjacencyMatrix/@Graphs[n]),{n,8}]//Timing

...wrong...

Count[#,True]&/@Table[(HamiltonianGraphQ/@AdjacencyGraph/@ToAdjacencyMatrix/@Graphs[n]),{n,9}]//Timing

HamiltonianGraphQ

2

(l=Monitor[Select[GraphData[;;2],HamiltonianGraphQ[GraphData[g=#]]=!=GraphData[#,"Hamiltonian"]&],g])//Timing

Grid[{#,GraphData[#,"Hamiltonian"],HamiltonianQ[Graph[#]],FastHamiltonianQ[Graph[#]],HamiltonianGraphQ[GraphData[#]]}&/@l,Dividers->All,Alignment->Left]

10

(l=Monitor[Select[GraphData[;;10],HamiltonianGraphQ[GraphData[g=#]]=!=GraphData[#,"Hamiltonian"]&],g])//Timing

Grid[{#,GraphData[#,"Hamiltonian"],HamiltonianQ[Graph[#]],FastHamiltonianQ[Graph[#]],HamiltonianGraphQ[GraphData[#]]}&/@l,Dividers->All,Alignment->Left]

(l2=Monitor[Select[GraphData[;;10],(FindHamiltonianCycle[GraphData[g=#]]=!={})=!=GraphData[#,"Hamiltonian"]&],g])//Timing

20

(l=Monitor[Select[GraphData[;;20],HamiltonianGraphQ[GraphData[g=#]]=!=GraphData[#,"Hamiltonian"]&],g])//Timing

Grid[{#,GraphData[#,"Hamiltonian"],HamiltonianQ[Graph[#]],FastHamiltonianQ[Graph[#]],HamiltonianGraphQ[GraphData[#]]}&/@l,Dividers->All,Alignment->Left]

FindHamiltonianCycle

10

(l2=Monitor[Select[GraphData[;;10],(FindHamiltonianCycle[GraphData[g=#]]=!={})=!=GraphData[#,"Hamiltonian"]&],g])//Timing

FindHamiltonianCycle/@GraphData/@{"SingletonGraph",{"Path",2}}