{*************************************************************** * THE SALESMAN'S PROBLEM: FIND THE BEST ITINERARY TO VISIT NV * * TOWNS WITH THE MINIMAL TOTAL DISTANCE USING THE "SIMULATED * * ANNEALING METHOD". THE MAXIMUM NUMBER OF TOWNS IS HERE SET * * TO FIFTY. * * ------------------------------------------------------------ * * LISTE OF MAIN VARIABLES: * * NV : NUMBER OF TOWNS TO VISIT * * CH\$(NV,4) : TABLE OF TOWN NAMES * * V\$(NV,4) : SHORTEST ITINERARY * * D(NV,NV) : MATRIX OF DISTANCES IN KM (OPTION 2) * * ICO(NV,2) : GEOGRAPHICAL COORDINATES OF TOWNS (OPTION 1) * * IT1 ET LL : INDICES OF STEPS OF RESOLUTION * * ------------------------------------------------------------ * * SAMPLE RUN: * * (Find shortest itinerary to visit 38 French towns: * * AMIENS, ANGOULEME, AUXERRE, BAYONNE, BORDEAUX, BOURGES, * * BREST, CAEN, CALAIS, CHERBOURG, CLERMONT-FERRAND, DIJON, * * GRENOBLE, LE HAVRE, LE MANS, LILLE, LIMOGES, LYON, * * MARSEILLE, METZ, MONTPELLIER, MULHOUSE, NANCY, NANTES, NICE,* * ORLEANS, PARIS, PAU, PERIGUEUX, POITIERS, REIMS, RENNES, * * ROUEN, SAINT-ETIENNE, STRASBOURG, TOULOUSE, TOURS, TROYES). * * * * Input file "Villes.dat" contains the number of towns, the * * names and geographical coordinates in km of the 38 towns (The* * origin is an arbitrary point 30 km west of Brest and at the * * latitude of Calais): * * * * AMIENS 525 115 * * ANGOULEME 365 585 * * AUXERRE 620 340 * * BAYONNE 228 830 * * BORDEAUX 305 675 * * BOURGES 535 425 * * BREST 030 260 * * CAEN 333 190 * * CALAIS 497 0 * * CHERBOURG 250 140 * * CLERMONT-FERRAND 590 565 * * DIJON 730 395 * * GRENOBLE 795 630 * * LE_HAVRE 370 157 * * LE_MANS 370 325 * * LILLE 578 034 * * LIMOGES 450 565 * * LYON 725 570 * * MARSEILLE 775 835 * * METZ 810 195 * * MONTPELLIER 655 805 * * MULHOUSE 910 340 * * NANCY 810 245 * * NANTES 235 405 * * NICE 920 780 * * ORLEANS 495 330 * * PARIS 530 228 * * PAU 316 844 * * PERIGUEUX 410 630 * * POITIERS 380 480 * * REIMS 655 185 * * RENNES 233 305 * * ROUEN 440 165 * * SAINT-ETIENNE 690 605 * * STRASBOURG 925 245 * * TOULOUSE 460 810 * * TOURS 410 390 * * TROYES 657 286 * * * * Distances between towns (km): * * 1 : as the crow flies * * 2 : by road * * Your choice (1 or 2): 2 * * * * Starting number of iterations: 10 * * Maximum number of iterations : 2000 * * Increment value of iterations: 10 * * * * See results in file Villes.lst. * * * * NOTE: Since this program depends on random numbers, you are * * never sure to really have the shortest itinerary in * * one pass. With above data, the output file contains: * * * * Shortest Itinerary: * * * * DIJON --> TROYES --> * * AUXERRE --> PARIS --> * * ORLEANS --> BOURGES --> * * CLERMONT-FERRAND --> SAINT-ETIENNE --> * * LYON --> GRENOBLE --> * * NICE --> MARSEILLE --> * * MONTPELLIER --> TOULOUSE --> * * PAU --> BAYONNE --> * * BORDEAUX --> PERIGUEUX --> * * ANGOULEME --> LIMOGES --> * * POITIERS --> TOURS --> * * LE_MANS --> NANTES --> * * BREST --> RENNES --> * * CHERBOURG --> CAEN --> * * LE_HAVRE --> ROUEN --> * * AMIENS --> CALAIS --> * * LILLE --> REIMS --> * * METZ --> NANCY --> * * STRASBOURG --> MULHOUSE --> * * * * NITER= 490 DMIN= 5509.00 KM. * * * * * * This is probably one of the best itineraries possible, but * * other solutions may exist. * * Note: with option 1 (by air), total distance is of course * * shorter. * * ------------------------------------------------------------ * * * * TPW Release By J-P Moreau, Paris. * * (www.jpmoreau.fr) * **************************************************************** NOTE: With F90: NBITER=1085 DMIN=5599 (see tanneal.f90) With C++: NBITER=1450 DMIN=5630 (see tanneal.cpp) ---------------------------------------------------------------} Program TANNEAL; Uses WinCrt; Const NBRVILLES=50; {Maximum number of towns} Type NomVille = String[16]; pDist = ^Dist; Dist = Array[1..NBRVILLES,1..NBRVILLES] of Double; pIDist = ^IDist; IDist = Array[1..NBRVILLES,1..NBRVILLES] of Integer; pCoord = ^Coord; Coord = Array[1..NBRVILLES] of Double; pTab=^Tab; Tab = Array[1..NBRVILLES] of NomVille; pICord = ^ICord; ICord = Array[1..NBRVILLES,1..2] of Integer; pItab = ^ITab; ITab = Array[1..NBRVILLES] of Integer; Var CH, Vs: pTab; ICO: pICord; D: pDist; L: pITab; C: pCoord; ID:pIDist; i,j, NV: Word; choice,diter,itermin,nbreiter,nmax: Integer; DDMIN,DMAX,DMIN,DT,TP,X,Y: Double; fp, fp1: TEXT; {I/O Text Files} {indices of towns} Amiens,Angouleme,Auxerre,Bayonne,Bordeaux,Bourges, Brest,Caen,Calais,Cherbourg,Clermont,Dijon,Grenoble, LeHavre,LeMans,Lille,Limoges,Lyon,Marseille,Metz, Montpellier,Mulhouse,Nancy,Nantes,Nice, Orleans,Paris,Pau,Perigueux,Poitiers,Reims,Rennes, Rouen,StEtienne,Strasbourg,Toulouse,Tours,Troyes:Integer; { GENERATE A RANDOM TIME } Procedure TIME; Label a15,a20,a25; Var i5,it,j5,k5,n5:integer; r: Double; Begin for i5:=1 to NV do begin L^[i5]:=0; C^[i5]:=0.0; end; n5:=NV; a15: it:= 1 + Random(n5); k5:=0; j5:=1; Repeat if C^[j5]=0.0 then Inc(k5); if k5<>it then goto a20; k5:=j5; goto a25; a20: Inc(j5) Until j5 > NV; a25: L^[n5]:=k5; Dec(n5); C^[k5]:=1.0; if n5>0 then goto a15 End; {TIME} { Calculate total distance, DT } Function DELTAT: Double; Var T: Double; i6: integer; Begin T:=0.0; for i6:=1 to NV-1 do T := T + D^[L^[i6],L^[i6+1]]; DELTAT:=T End; { Debug only } Procedure aff_L(j:integer); Var i,n: integer; Begin writeln(fp1); writeln(fp1,'(',j,')'); n:=0; for i:=1 to NV do begin Inc(n); write(fp1,L^[i]:3); if n=20 then begin writeln(fp1); n:=0 end end End; { Simulated Annealing Method } Procedure ANNEAL(nbiter:Integer; Var itmin:Integer); Label a,b,a25; Var DD,EX,R,R1: Double; I,I1,I2,I9,II,IR,IT1,J,J1,J2,K,K2,KF,LL,M,M1:Integer; V1s:pTab; Begin New(V1s); DT:=DELTAT; DMIN:=35000.0; TP:=110.0; for IT1:=1 to 40 do begin for LL:=1 to nbiter do begin I:= 1 + Random(NV); if I<1 then I:=1; Repeat J:= 1 + Random(NV); if J<1 then J:=1; Until J<>I; if J < I then begin II:=I; I:=J; J:=II end; I1:=I-1; if I1<1 then I1:=I1+NV; I2:=I+1; J1:=J-1; R:=random; if R > 0.5 then goto a; J2:=J+1; if J2>NV then J2:=J2-NV; a25: K:= 1 + Random(NV); K2:=K+1; if K2 > NV then K2:=1; if K=I then goto a25; if K=J then goto a25; if K<=I then begin II:=K; K:=I; I:=II; II:=K2; K2:=I2; I2:=II end; if K<=J then begin II:=K; K:=J; J:=II; II:=K2; K2:=J2; J2:=II end; DD:=D^[L^[I],L^[J2]]+D^[L^[K],L^[I2]]+D^[L^[J],L^[K2]]; DD:=DD-(D^[L^[I],L^[I2]]+D^[L^[J],L^[J2]]+D^[L^[K],L^[K2]]); R1:=Random; {Guard against underflow or over flow in Exp} if DD/TP>60 then EX:=0.0 else if DD/TP<-60 then EX:=1.0 else EX:=Exp(-DD/TP); if R1>EX then goto b; for M:=1 to I do C^[M]:=1.0*L^[M]; M:=I+1; for M1:=J2 to K do begin C^[M]:=1.0*L^[M1]; Inc(M) end; for M1:=I2 to J do begin C^[M]:=1.0*L^[M1]; Inc(M) end; if K2 <> 1 then for M1:=K2 to NV do begin C^[M]:=1.0*L^[M1]; Inc(M) end; for M1:=1 to NV do L^[M1] := Round(C^[M1]); { aff_L(1); } goto b; a: if I=J1 then goto b; DD:=D^[L^[I1],L^[J1]]+D^[L^[I],L^[J]]-(D^[L^[I1],L^[I]]+D^[L^[J1],L^[J]]); R1:=Random; {Guard against underflow or over flow in Exp} if DD/TP>60 then EX:=0.0 else if DD/TP<-60 then EX:=1.0 else EX:=Exp(-DD/TP); if R1<=EX then begin { aff_L(2); } KF:= I+Round(0.5+((J1-I) Div 2)); for K:=I to KF do begin II:=L^[K]; L^[K]:=L^[J1+I-K]; L^[J1+I-K]:=II end; { aff_L(3); } end; b: end; {for LL} TP:=TP*0.9; {lower temperature} DT:=DELTAT; DMAX:=DT; if DT ', Vs^[L^[i+1]],' -->'); i:=i+2 end; writeln(fp1); writeln(fp1,' NITER= ',itermin,' DMIN= ', DELTAT:8:2,' KM.'); writeln; writeln(' Results in file villes.lst'); writeln; Close(fp1); ReadKey; Dispose(CH); Dispose(Vs); Dispose(ICO); Dispose(D); Dispose(L); Dispose(C); Dispose(ID); DoneWinCrt END. {End of file tanneal.pas}