Hosted by The Math Forum


Problem of the Week 861

The Bald Traveling Salesman

_____________________________________________
Spring 98 Archive || MacPOW Home || Math Forum POWs || Search MacPOW
_____________________________________________

What is the shortest route you can find that visits all the 33 points shown below and starts and finishes at the same point?

The general traveling salesman problem is most likely impossible, but attempting to find an optimal solution to a particular instance can be instructive. Indeed, the sport of ROGAINE'ing (Rough Outdoor Group Activity Involving Navigation and Endurance) is a 2-person, 24-hour event in which teams have two hours prior to the start to study a map with about 50-100 points on it and plan an efficient route through as many of the points as possible. The World Rogaine Championships will take place this August in British Columbia, so here's your chance to practice the route selection part!

The real reason that I am proposing this problem is that I have a program based on J. J. Bartholdi's beautiful idea of using space-filling curves to get an approximation to the optimal TSP tour. I am curious if there is a tour that is better than the one my program produces.

You will need to write a program to visualize the data set. Mathematica code for doing so (and checking the length of your tour) is appended.

Mathematica code:

data = {
 {0.78,0.56}, {0.45,0.63}, {0.95,0.78}, {0.24,0.54},
 {0.75,0.48}, {0.14,0.55}, {0.56,0.11}, {0.04,0.55},
 {0.93,0.83}, {0.27,0.28}, {0.99,0.52}, {0.31,0.08},
 {0.20,0.96}, {0.25,0.19}, {0.63,0.92}, {0.50,0.71},
 {0.49,0.36}, {0.94,0.60}, {0.45,0.81}, {0.01,0.77},
 {0.18,0.53}, {0.02,0.25}, {0.87,0.45}, {0.82,0.28},
 {0.00,1.00}, {0.38,0.08}, {0.07,0.39}, {0.89,0.72},
 {0.13,0.79}, {0.44,0.91}, {0.12,0.03}, {0.26,0.38},
 {0.01,0.78}};

Show[Graphics[{Circle[#, 0.02] & /@  data,
  MapIndexed[Text[#2[[1]], #1] &, data]}],
  AspectRatio -> Automatic, Frame -> True, FrameTicks -> None];
  
dist[p_,q_] := Sqrt[(p - q) . (p - q)];

TourLength[indices_] := Apply[Plus,
  Apply[dist, Partition[data[[indices]], 2, 1],{1}]]

(* A sample tour; note that it ends at the starting point *)
TourLength[{31, 22, 27, 8, 6, 21, 4, 29, 33, 20, 25, 13,
  30, 15, 19, 16, 2, 5, 1, 28, 9, 3, 18, 11, 23, 24, 7, 26,
  12, 17, 32, 10, 14, 31}]

5.34289 (* the length of the sample tour *)

© Copyright 1998 Stan Wagon. Reproduced with permission.

[Privacy Policy] [Terms of Use]

_____________________________________
Home || The Math Library || Quick Reference || Search || Help 
_____________________________________

© 1994-2014 Drexel University. All rights reserved.
http://mathforum.org/
The Math Forum is a research and educational enterprise of the Drexel University School of Education.The Math Forum is a research and educational enterprise of the Drexel University School of Education.

The Math Forum

2 October 1998