Traveling Salesman Problem

Author

Eric W. Weisstein
March 1, 2009

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/TravelingSalesmanProblem.nb.

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

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

Usage

?TravelingSalesman

Example

g=FromAdjacencyMatrix[{{0,1,1,0,1,0,0,0},{1,0,1,1,0,1,0,1},{1,1,0,1,0,0,1,0},{0,1,1,0,0,0,1,1},{1,0,0,0,0,0,1,0},{0,1,0,0,0,0,0,1},{0,0,1,1,1,0,0,1},{0,1,0,1,0,1,1,0}}]

HamiltonianQ[g]

tour=TravelingSalesman[g]

edges=Partition[tour,2,1]

ShowGraph[Highlight[g,{edges},HighlightedEdgeColors->{Red}],
VertexStyle->Disk[.05]]

SetOptions[Arrow,HeadShape->Automatic,HeadScaling->Absolute,HeadCenter->.8];

Show[GraphicsArray[
Block[{$DisplayFunction=Identity},
{
ShowGraph[g,VertexColor->Black,VertexStyle->Disk[.07]],
Graphics[{PointSize[.06],ShowGraph[g,VertexColor->Black,VertexStyle->Disk[.07]][[1]],ShowGraph[FromOrderedPairs[edges],EdgeColor->Red][[1]]/.Point[l_]:>{}},AspectRatio->Automatic,PlotRange->All]
}
]
]]

Better Figure

pts=Table[Random[],{30},{2}];

GraphicsGrid[{{Graphics[Point[pts]],Graphics[{Point[pts],White,EdgeForm[Black],Polygon[pts[[Last[FindShortestTour[pts]]]]]}]}},ImageSize->400]

Example

g=SetEdgeWeights[RandomVertices[RandomGraph[7,.5]],WeightingFunction->Euclidean]

{#,Norm[Subtract@@Vertices[g][[#]]]}&/@Edges[g]

GetEdgeWeights[g]

Have to do this sorting nonsense because EdgeLabel doesn't work properly.

weights=Last/@Sort[Transpose[{Edges[g],GetEdgeWeights[g]}]]

Have to do VertexLabel->Range[V[g]] because VertexLabel->True doesn't work properly.

ShowGraph[Highlight[g,List[Partition[t=TravelingSalesman[g],2,1]],
HighlightedEdgeColors->{Red},HighlightedEdgeStyle->Thin],
EdgeLabel->weights,PlotRange->All,EdgeLabelPosition->Center,VertexLabel->Range[V[g]],AspectRatio->Automatic,Frame->True
]

t