Mathematica 教學 Using Dynamic Programming To Solve TSP- via Mathematica

mytsp[distmatrix_?MatrixQ]:=Block[{g,route,distdata},
distdata=distmatrix;

(*以動態函數定義方式定義遞迴函數*)

g[i_,S_List]:=g[i,S]=Evaluate@If[Length@S==1,
distdata[[S[[1]],1]]+distdata[[i,S[[1]]]],
distdata[[i,#]]+Min@g[#,Complement[S,{i,#}]]&/@S];

(*最佳路徑*)

route=NestList[{Sort[
Transpose@{g[#[[1]],Complement[#[[2]],{#[[1]]}]],
Complement[#[[2]],{#[[1]]}]}][[1,2]],
Complement[#[[2]],{#[[1]]}]}&,{1,Range[Length@distdata]},
Length@distdata-2][[All,1]];
route=Flatten@{route,Complement[Range[Length@distdata],route]}
]


(*地球半徑*)

r=6371.11;

(*城市經緯度*)
city={{116.40,39.93},{110.32,20.05},{117.28,31.85},{113.55,22.20},{119.30,26.08},
{103.68,36.05},{113.25,23.12},{108.32,22.82},{106.72,26.58},{114.48,38.05},
{113.67,34.75},{126.65,45.75},{114.27,30.58},{112.97,28.20},{125.35,43.87},
{118.78,32.05},{115.88,28.68},{123.45,41.80},{111.64,40.82},{106.27,38.47},
{101.77,36.62},{117.00,36.67},{112.55,37.87},{108.90,34.27},{121.47,31.23},
{104.07,30.67},{121.45,25.02},{117.20,39.13},{91.00,29.60},{114.15,22.28},
{87.58,43.80},{102.70,25.05},{120.17,30.25},{106.58,29.57}};


(*將經緯度轉成球面座標*)

SC[{lon_,lat_}]:=
r{Cos[lat \[Degree]]Cos[lon \[Degree]],
Cos[lat \[Degree]]Sin[lon \[Degree]],Sin[lat \[Degree]]};
distfun[{lon1_,lat1_},{lon2_,lat2_}]:=
VectorAngle[SC[{lon1,lat1}],SC[{lon2,lat2}]]r;

(*隨機選取12個城市，建立距離矩陣*)
aa=RandomSample[Range[34],12]
data=Table[If[i==j,99999,distfun[city[[i]],city[[j]]]],{i,aa},{j,aa}];

ans=mytsp[data]

(*畫圖*)
ListPlot[{#}&/@city,PlotStyle->PointSize[0.02],
PlotMarkers->Table[{Text[Style[i,FontSize->20]]},{i,34}],
Epilog->{Thickness[0.005],
Line[{city[[aa[[#[[1]]]]]],city[[aa[[#[[2]]]]]]}]&/@
Partition[ans,2,1]}]

Tags: Mathematica 教學, Teaching

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見