23
$\begingroup$

I've been trying to find some kind of mathematical computer software to solve the Travelling Salesman Problem. The Excel Solver is able to do it, but I've noticed there is a built-in function in Mathematica:

TravelingSalesman[g] finds an optimal traveling salesman tour in graph g.

I've been given a matrix which represents the costs of traveling between six cities. I could start typing them in to the Graph function and then use the TravelingSalesman function to solve it. But I'm too lazy for such work. Is there a way to type in the matrix, convert it to some kind of graph, and then apply the TravelingSalesman function directly to the graph?

Hope you understand my question! Thanks in advance.

$\endgroup$
4
  • $\begingroup$ This may be of interest: flinders.edu.au/science_engineering/csem/research/programs/… which includes a link to the snakes and ladders web page for testing some solutions. FWIW the heuristics they have developed are supposedly orders of magnitude faster than the what Mathematica can do. $\endgroup$ Commented Dec 9, 2012 at 10:37
  • $\begingroup$ You might get decent results from FindShortestTour[...,DistanceFunction->...] $\endgroup$ Commented Dec 9, 2012 at 23:08
  • $\begingroup$ I found even better solution and updated the answer. $\endgroup$ Commented Dec 10, 2012 at 20:29
  • $\begingroup$ See the latest solution method by hand with zero or negligible error: P vs NP: Solutions of the Traveling Salesman Problem by A. A.Frempong At vixra.org/abs/1505.0167 $\endgroup$
    – user30016
    Commented Jun 8, 2015 at 1:59

2 Answers 2

35
$\begingroup$

True traveling salesman problem

FindShortestTour is the function you are looking for. This defines a sparse distance matrix among six points and finds the shortest tour:

d = SparseArray[{{1, 2} -> 1, {2, 1} -> 1, {6, 1} -> 1, {6, 2} -> 
     1, {5, 1} -> 1, {1, 5} -> 1, {2, 6} -> 1, {2, 3} -> 10, {3, 2} ->
      10, {3, 5} -> 1, {5, 3} -> 1, {3, 4} -> 1, {4, 3} -> 
     1, {4, 5} -> 15, {4, 1} -> 1, {5, 4} -> 15, {5, 2} -> 
     1, {1, 4} -> 1, {2, 5} -> 1, {1, 6} -> 1}, {6, 6}, Infinity];


{len, tour} = FindShortestTour[{1, 2, 3, 4, 5, 6}, DistanceFunction -> (d[[#1, #2]] &)]

{6, {1, 4, 3, 5, 2, 6}}

This plots the shortest tour in red, and the distance on each edge:

HighlightGraph[
  WeightedAdjacencyGraph[d, GraphStyle -> "SmallNetwork", EdgeLabels -> "EdgeWeight"], 
  Style[UndirectedEdge[#1, #2], Thickness[.01], Red] & @@@ Partition[tour, 2, 1, 1]]

enter image description here

Some other experiments with graphs

Another interesting thing to look at is (FindPostmanTour function), but below method is also interesting. Sample matrix of cost quantities (distances, times, expenses, etc.) between the cities:

m = RandomReal[1, {10, 10}]; (m[[#, #]] = Infinity) & /@ Range[10]; m // MatrixForm

enter image description here

Matrix should be of course symmetric, but DirectedEdges -> False below takes care of it. A default embedding would of course give a complete graph:

g = WeightedAdjacencyGraph[m, DirectedEdges -> False, VertexLabels -> "Name"]

enter image description here

While weighted embedding results in edges length reflecting upon distances:

g = WeightedAdjacencyGraph[m, DirectedEdges -> False, GraphLayout ->   
{"SpringElectricalEmbedding", "EdgeWeighted" -> True}, VertexLabels -> "Name"]

enter image description here

Now get vertex coordinates, find shortest tour:

p = GraphEmbedding[g]

{{1.28207, 1.43548}, {0.63296, 0.7209}, {1.01456, 0.812491}, {1.27993,0.}, {1.16843, 1.46467}, {0.0713373, 1.23935}, {1.29842, 1.4204}, {0., 1.22425}, {0.167924, 0.587497}, {0.643434, 1.17666}}

st = FindShortestTour[p]

{5.02343, {1, 5, 10, 6, 8, 9, 2, 4, 3, 7}}

Show[g, Graphics[{Red, Thick, Line[p[[Last[st]]]]}]]

enter image description here

Just shortest path (not through all cities)

Lets choose a test weighted matrix:

m = {{\[Infinity], 1, 7, \[Infinity]}, {1, \[Infinity], 2, 5}, {7, 
    2, \[Infinity], 1}, {\[Infinity], 5, 1, \[Infinity]}};
m // MatrixForm

enter image description here

Infinity means no edge between vertices. This builds the graph:

g = WeightedAdjacencyGraph[m, EdgeLabels -> "EdgeWeight", GraphStyle -> "SmallNetwork"]

enter image description here

Find shortest path between vertices 1 and 4 and visualize:

sp = FindShortestPath[g, 1, 4]

{1, 2, 3, 4}

HighlightGraph[g, PathGraph[sp]]

enter image description here

which is obviously correct.

Known positions of the cities

If you know locations or names of the cities, then take a look at this. A short example traveling through the centro-ids of countries in Europe:

Graphics[{EdgeForm[White], Gray, CountryData[#, "Polygon"] & /@ 
CountryData["Europe"], Thick, Red, Line[#[[Last[FindShortestTour[#]]]] &
[Reverse[CountryData[#, "CenterCoordinates"]] & /@ CountryData["Europe"]]]}]

enter image description here

$\endgroup$
4
  • 5
    $\begingroup$ As always, thorough and outstanding answer. $\endgroup$
    – JohnD
    Commented Dec 9, 2012 at 19:56
  • $\begingroup$ I note that randomly drawing distances between cities, as you do with the random matrix, will quite probably lead to positions of cities that are inconsistent with the 2D or 3D space they supposedly live in. You better start with random positions and derive distances from that. $\endgroup$ Commented Dec 9, 2012 at 22:29
  • $\begingroup$ Something like Outer[EuclideanDistance, #, #, 1]&[RandomReal[{0, 1}, {10, 2}]] /. 0. -> \[Infinity] should do. $\endgroup$ Commented Dec 9, 2012 at 22:37
  • $\begingroup$ @SjoerdC.deVries Found a better solution. Thanks for the comment. $\endgroup$ Commented Dec 10, 2012 at 20:29
8
$\begingroup$

As Vitaliy shows, you can probably use WeightedAdjacencyGraph. Of course, it would be much easier to answer the question correctly, if you included an example. Also, it's really not hard to find such functions. Near the bottom of the help for the Graph command, you'll find pointers to related functions. In this case, there's a pointer to the AdjacencyGraph command:

enter image description here

Then, from that page, you'll find a pointer to the WeightedAdjacencyGraph command. Judging from your two questions, I'd say that understanding how to navigate the documentation would be very fruitful. Even "lazy" folks can do it!:)

$\endgroup$
2
  • 1
    $\begingroup$ Thanks, Mark. I'll try to use even more time in the Documentation Center before asking "lazy" questions! ;) $\endgroup$
    – marcopah
    Commented Dec 9, 2012 at 11:26
  • 1
    $\begingroup$ @MarcoDalFarra Great! Sometimes, it's just a matter of learning how to use that type of resource. $\endgroup$ Commented Dec 9, 2012 at 11:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.