Super TSP
A trip around the world ver. 1.2

Kazume Nishidate

Faculty of Engineering, Iwate University, Morioka 020, JAPAN
nisidate@dragon.elc.iwate-u.ac.jp

Introduction

The package including; two dimensional TSP,three dimensional TSP and Super TSP programs. The Monte Carlo method was used for determining the optimal route. All of the codes was written in Mathematica uising the functional programming style [Rich93]. The traveling salesman will visit all N cities once and end of the trip coincides with the beginning. But he wishes to save his money, so he must find out the optimum route. For further details of the TSP the reader should refer to [Bind86] and [Kirk83].

Please enjoy!

Two dimensional TSP

Algolithm

[1] set a seed
    SeedRandom[seed];

[2] set N cities
    Cities = Table[{Random[],Random[]},{num}];

[3] set the travelling course
    Course = Flatten[{Table[Range[num]],1}];

[4] cost function
    DD = Table[((Cities[[i]]-Cities[[j]]).
                  (Cities[[i]]-Cities[[j]])),{i,1,num},{j,1,num}];

[5] calculate the cost
    EnergyCalc=
         ((DD[[#1[[#2-1]],#1[[#2+1]]]]+
                      DD[[#1[[#3]],#1[[#2]]]]+
                                      DD[[#1[[#2]],#1[[#3+1]]]])-
         (DD[[#1[[#2-1]],#1[[#2]]]]+
                      DD[[#1[[#2]],#1[[#2+1]]]]+
                                      DD[[#1[[#3]],#1[[#3+1]]]]) )&;

[6] select a new route
    SelectRoute=(Join[Take[#1,#2-1],
                   RotateLeft[Table[#1[[i]],{i,#2,#3}]],
                               Take[#1,-Length[#1]+(#3) ]])&;

[7] change the route (Monte Carlo method)
    change = (route=#;
         A=Random[Integer,{2,num-1}];B=Random[Integer,{A+1,num}];
         deltaE=EnergyCalc[route,A,B];
         p=E^(-deltaE/T);
         If[Random[]<p,route=SelectRoute[route,A,B]];
         route)&;

[8] travel course
    tlavelList = NestList[change,Course,step];

[9] N cities
    points = {PointSize[.02],
       Map[Point,Cities[[ Flatten[{Last[tlavelList]}]  ]]  ]};

[10] tour course
    path = Line[Cities[[ Flatten[{Last[tlavelList]}]  ]]  ];
    Show[Graphics[{points,path}]];

[11] cost function
    Cost=Map[DD[[#[[1]],#[[2]]]]&,
       Map[Transpose,Transpose[{#,RotateLeft[#]}]]]&;
       finalCost=Table[
          Apply[Plus,Cost[tlavelList[[i]]]],{i,1,Length[tlavelList]}];
       ListPlot[finalCost,PlotJoined->True]

Program

TSP2d[num_,T_,step_,seed_?IntegerQ]:=
 Module[{Cities,points,change},
    SeedRandom[seed];
    Cities = Table[{Random[],Random[]},{num}];
    Course = Flatten[{Table[Range[num]],1}];
    
    DD = Table[((Cities[[i]]-Cities[[j]]).
                  (Cities[[i]]-Cities[[j]])),{i,1,num},{j,1,num}];

    EnergyCalc=
         ((DD[[#1[[#2-1]],#1[[#2+1]]]]+
                      DD[[#1[[#3]],#1[[#2]]]]+
                                      DD[[#1[[#2]],#1[[#3+1]]]])-
         (DD[[#1[[#2-1]],#1[[#2]]]]+
                      DD[[#1[[#2]],#1[[#2+1]]]]+
                                      DD[[#1[[#3]],#1[[#3+1]]]]) )&;
    SelectRoute=(Join[Take[#1,#2-1],
                   RotateLeft[Table[#1[[i]],{i,#2,#3}]],
                               Take[#1,-Length[#1]+(#3) ]])&;
   
    change = (route=#;
         A=Random[Integer,{2,num-1}];B=Random[Integer,{A+1,num}];
         deltaE=EnergyCalc[route,A,B];
         p=E^(-deltaE/T);
         If[Random[]<p,route=SelectRoute[route,A,B]];
         route)&;
         
    tlavelList = NestList[change,Course,step];

    points = {PointSize[.02],
       Map[Point,Cities[[ Flatten[{Last[tlavelList]}]  ]]  ]};
  
    path = Line[Cities[[ Flatten[{Last[tlavelList]}]  ]]  ];
    Show[Graphics[{points,path}]];
    
    Cost=Map[DD[[#[[1]],#[[2]]]]&,
       Map[Transpose,Transpose[{#,RotateLeft[#]}]]]&;
       finalCost=Table[
          Apply[Plus,Cost[tlavelList[[i]]]],{i,1,Length[tlavelList]}];
       ListPlot[finalCost,PlotJoined->True]
 ]

Running test

TSP2d[10,0.04,100,0];

TSP2d[50,0.04,5000,0];

Three dimensional TSP

Program

TSP3d[num_,T_,step_,seed_?IntegerQ]:=
 Module[{Cities,points,change},
    SeedRandom[seed];
    Cities = Table[{Random[],Random[],Random[]},{num}];
    Course = Flatten[{Table[Range[num]],1}];
    
    DD = Table[((Cities[[i]]-Cities[[j]]).
                  (Cities[[i]]-Cities[[j]])),{i,1,num},{j,1,num}];

    EnergyCalc=
         ((DD[[#1[[#2-1]],#1[[#2+1]]]]+
                      DD[[#1[[#3]],#1[[#2]]]]+
                                      DD[[#1[[#2]],#1[[#3+1]]]])-
         (DD[[#1[[#2-1]],#1[[#2]]]]+
                      DD[[#1[[#2]],#1[[#2+1]]]]+
                                      DD[[#1[[#3]],#1[[#3+1]]]]) )&;
    SelectRoute=(Join[Take[#1,#2-1],
                   RotateLeft[Table[#1[[i]],{i,#2,#3}]],
                               Take[#1,-Length[#1]+(#3) ]])&;
   
    change = (route=#;
         A=Random[Integer,{2,num-1}];B=Random[Integer,{A+1,num}];
         deltaE=EnergyCalc[route,A,B];
         p=E^(-deltaE/T);
         If[Random[]<p,route=SelectRoute[route,A,B]];
         route)&;
         
    tlavelList = NestList[change,Course,step];

    points = {PointSize[.02],
       Map[Point,Cities[[ Flatten[{Last[tlavelList]}]  ]]  ]};

    path = Line[Cities[[ Flatten[{Last[tlavelList]}]  ]]  ];
    Show[Graphics3D[{points,path}],PlotRange->{{0,1},{0,1},{0,1}}];
    
    Cost=Map[DD[[#[[1]],#[[2]]]]&,
       Map[Transpose,Transpose[{#,RotateLeft[#]}]]]&;
       finalCost=Table[
          Apply[Plus,Cost[tlavelList[[i]]]],{i,1,Length[tlavelList]}];
       ListPlot[finalCost,PlotJoined->True]
 ]

Running test

TSP3d[20,0.02,400,1];

Super TSP

Preparation

Morioka city in IWATE prefecture is my home city. So, I add the city position of Morioka to the database. Please add the city you want to the database, then the Super TSP will visit the city.

<</math/Packages/Miscellaneous/CityData.m
<</math/Packages/Miscellaneous/WorldData.m
<</math/Packages/Miscellaneous/WorldNames.m
<</math/Packages/Miscellaneous/WorldPlot.m

(* from CityData.m  *)
AllCities={"Abu Dhabi","Addis Ababa","Aden","Algiers",
"Amman","Amsterdam","Anchorage","Ankara","Asuncion",
"Athens","Atlanta","Baghdad","Bangkok","Beijing","Beirut",
"Belgrade","Beograd","Berlin","Bern","Bogota","Bombay",
"Bonn","Boston","Brasilia","Brussels","Budapest",
"Buenos Aires","Cairo","Calcutta","Cape Town","Caracas",
"Cardiff","Cayenne","Chicago","Mexico City","Copenhagen",
"Cupertino","Dacca","Dallas","Damascus","Denver","Djakarta",
"Doha","Dublin","Edinburgh","Geneva","Georgetown",
"Godthab","Havana","Helsinki","Hong Kong","Honolulu",
"Istanbul","Jerusalem","Kabul","Karachi","Khartoum",
"Kuwait","Lagos","La Habana","La Paz","Leningrad",
"Lima","Lisboa","Lisbon","London","Los Angeles",
"Madrid","Manama","Manila","Mecca","Mexico City",
"Miami","Minneapolis","Mogadisho","Montevideo",
"Montreal","Moscow","Muscat","Nairobi","New Delhi",
"New York","Nouakchott","Osaka","Oslo","Ottawa",
"Paramaribo","Paris",
"Peking","Perth","Philadelphia",
"Portland","Prague","Quito", 
"Rabat","Reykjavik","Rio de Janeiro",
"Riyadh","Rome","Saint Louis","Salt Lake City",
"San Diego","San Francisco","San Jose","Seoul",
"Shanghai","Singapore","Sao Paulo","Stockholm",
"Sydney","Tehran","Tianjin","Tokyo","Tripoli","Tunis",
"Vancouver","Vienna","Warsaw","Washington","Wellington",
"Zurich","Morioka"};

CityPosition["Morioka"] = {{39, 42}, {141, 11}};
CityData["Morioka"]
km=CityDistance["Morioka","Chicago"]

wgra=WorldPlot[World,WorldToGraphics->True];

Program

Clear[superTSP]

superTSP[num_,T_,step_,seed_?IntegerQ]:=Module[{},
    SeedRandom[seed];
    Cities=Table[AllCities[[Random[Integer,{1,Length[AllCities]}]]],
                                                        {i,1,num}];
    AppendTo[Cities,Cities[[1]]];
    
    Cxy= ({(CityPosition[#][[2,1]] + CityPosition[#][[2,2]]/60),
      (CityPosition[#][[1,1]] + CityPosition[#][[1,2]]/60) } )&;

    Course = Flatten[{Table[Range[num]],1}];
    
    DD = Table[CityDistance[ Cities[[i]],Cities[[j]] ],
                                            {i,1,num},{j,1,num}];

    EnergyCalc=
         ((DD[[#1[[#2-1]],#1[[#2+1]]]]+
                      DD[[#1[[#3]],#1[[#2]]]]+
                                      DD[[#1[[#2]],#1[[#3+1]]]])-
         (DD[[#1[[#2-1]],#1[[#2]]]]+
                      DD[[#1[[#2]],#1[[#2+1]]]]+
                                      DD[[#1[[#3]],#1[[#3+1]]]]) )/20000&;
    SelectRoute=(Join[Take[#1,#2-1],
                   RotateLeft[Table[#1[[i]],{i,#2,#3}]],
                               Take[#1,-Length[#1]+(#3) ]])&;

    change = (route=#;
         A=Random[Integer,{2,num-1}];B=Random[Integer,{A+1,num}];
         deltaE=EnergyCalc[route,A,B];
         p=E^(-deltaE/T);
         If[Random[]<p,route=SelectRoute[route,A,B]];
         route)&;
    
    tlavelList=NestList[change,Course,step];
    finalArrengiment = Table[Cities[[tlavelList[[step+1,i]]]],{i,1,num+1}];
    
    Print[" Arrangement "];Print[" "];
    Print[finalArrengiment//MatrixForm];

     Show[wgra,Graphics[
           RGBColor[1,0,1], PointSize[0.01],
           Table[Point[N[Cxy[Cities[[i]] ] 60]],{i,1,num}],
           Line[Table[N[Cxy[Cities[[i]] ] 60],{i,1,num+1} ]]  ]]; 
   
       Cost=Map[DD[[#[[1]],#[[2]]]]&,
       Map[Transpose,Transpose[{#,RotateLeft[#]}]]]&;
       finalCost=Table[
          Apply[Plus,Cost[tlavelList[[i]]]],{i,1,Length[tlavelList]}];
     ListPlot[finalCost, PlotJoined->True, DefaultFont -> {"Times",9},
     AxesLabel -> {"t","km"},
     PlotLabel ->  FontForm[" super TSP ",{"Times",12}]]
]

Running the program

superTSP[6,0.05,100,37]

REFERENCES

[Rich93]  Richard J. Gaylord, Samuel N. Kamin and Paul Wellin, "Introduction to Programming with Mathematica", TELOS/Springer-Verlag Publishers (1993)

[Bind86]  K. Binder, ed. "Monte Carlo Methods in Statistical Physics", second ed., Springer-Verlag (1986)

[Kirk83]  S. Kirkpatrick, C. D. Gellat and M. P. Vecchi, "Optimization by simulated annealing", Science 220, 671 (1983)