' TravSalesmanB3.bas ' Implement simulated annealing to find minimal distance solutions. ' To-dos:- ' Change storage so arrays stay in place, but order of addressing is stored in a string which mutates DONE ' Add ability to choose # of cities ' Add a mouse driven editor to design a layout of cities ' Add more extreme mutations than a swap of two- eg take one to end and slide rest down (rotate), etc. ' Stop the sreen redraw bug that hits after a few mins! ' Add line on graph showing best-yet. DONE ' Check terminates correctly. And the mid-run crashes!! ' Reposition & size buttons ' Save best sequence order each time a new one found (append path length), DONE ' and add a 'recall best' function. ' Add option to only draw when new minimum has been found ' Print current path length on graphic window ' Convert bmp files to gif to save space (ImageMagick or GraphicMagick) ' Add a 'chill' button. ' Add a window displaying sequence ' Use 'locate' to print city # rather than a circle DONE ' Add a mouse routine to choose your own sequence, or modify existing one nomainwin UpperLeftX = 10: UpperLeftY = 1 WindowWidth =800: WindowHeight =720 graphicbox #w.g1, 10, 10, 400, 400 graphicbox #w.g2, 10, 450, 780, 200 button #w.b1, "Hold", [hold], UR, 50, 10 button #w.b2, "Run", [main], UR,100, 10 button #w.b3, "Create/Save", [CreateAndSave], UR, 50, 40 button #w.b4, "Reload", [Reload], UR,150, 40 button #w.b5, "Info", [Info], UR,150,120 button #w.b5, "Reheat", Reheat, UR, 50, 80 button #w.b6, "SaveGraphic", SaveGraphic, UR,120, 80 textbox #w.tb1, 630, 220, 50, 20 textbox #w.tb2, 630, 260, 50, 20 textbox #w.tb3, 630, 300, 50, 20 textbox #w.tb4, 630, 340, 50, 20 textbox #w.tb5, 10, 660, 780, 20 statictext #w.st1, "Graph of distance of current route choice linking all in a loop.", 20, 420, 600, 20 statictext #w.st2, "Best-yet path........", 500, 220, 120, 20 statictext #w.st3, "Current alternative..", 500, 260, 120, 20 statictext #w.st4, "# paths tried........", 500, 300, 120, 20 statictext #w.st5, "'Heat'...............", 500, 340, 120, 20 groupbox #w.gb, "Current values", 480, 200, 210, 170 global source, sink, tour, last, i, places, first, heat, bestyet, order$ '__________________________________________________________________ open "Travelling salesman -simulated annealing" for window as #w #w "trapclose [quit]" #w.g1 "size 4" hGW = hWnd( #w.g1) CallDLL #user32, "GetDC", hGW as uLong, hDC as uLong CallDLL #gdi32, "SetBkMode", hDC as uLong, 1 as Long, result as Long CallDLL#user32, "ReleaseDC", hGW as uLong, hDC as uLong, result as Long #w.g2 "down ; fill lightgray ; flush" #w.st1 "!font arial 12 bold" #w.st2 "!font arial 10" #w.st3 "!font arial 10" #w.st4 "!font arial 10" #w.st1 "!font arial 10" #w.tb5 "!font courier 6" #w.b2 "!disable" places =25 ' <= 50. If changed, the current load/save routines will fail at present... order$ ="" ' Will hold ( in space-plus-two-digit triplets) the order sites will be visited in, ' then "_" and 2 chars for number of cities & 7 chars for path length found. for i =1 to places order$ =order$ +" " +right$( "00" +str$( i), 2) next i order$ =order$ +"_" +right$( "00" +str$( places), 2) +" nnnnnn" ' 01 02 03 04 05 06......... ..... pl_40 nnnnnn' if places =40. dim xlocation( places), ylocation( places) #w.g1, "down ; fill lightgray ; up ; goto "; int( xlocation( 1)); " "; int( ylocation( 1)); " ; down" last =10000000 ' Seeds previous total distance. first =10000000 tour = 0 ' present total distance. heat = 100 ' amount total route could go UP by and still be acceptable. bestyet =10000000 ' Seeds best path length so far now =time$( "seconds") wait [main] for i =1 to 100000 call allway ' find length of whole tour route in present order of visiting if i <2 then first =tour ' save as 'first' the initial tour length for scaling graph y_max. last =tour ' store path currently specified as 'last'. source =1 +int( ( places -0) *rnd( 1)) ' Choose unique source and sink to consider swapping [tryagain] ' DON'T Keep 01 as position 1- any others may swap. sink =1 +int( ( places -0) *rnd( 1)) if sink =source then [tryagain] temp$ =order$ ' Save for fast reversion of a swap that's not acceptable. call swap2 ' alter route by swapping two cities call allway ' check new tour length is smaller, or within 'heat' if larger if tour >=( heat +last) then ' if no advantage, swap back to previous order order$ =temp$ ' Quicker than calling swap again else ' Keep new order with updated path length 'tour' and save/ print it order$= left$( order$, ( places *3) +3) +right$( "/ " +str$( int( tour)), 7) print order$ #w.tb5 order$ ' diagnostic and for saving later if bestyet >tour then bestyet =tour 'call SaveGraphic end if if heat >1 then heat =heat *0.9995 #w.tb4 int( heat) if i /1000 =int( i /1000) then call SaveGraphic call plotscreen scan next i #w.g1 "flush" #w.g2 "flush" wait [CreateAndSave] filedialog "Create and save as location file", "*.jhf", file$ open file$ for output as #o for city =1 to places xlocation( city) =10 +int( 380 *rnd(1)) #o, xlocation( city) ylocation( city) =10 +int( 380 *rnd(1)) #o, ylocation( city) next city ' add line holding optimum route order close #o #w.b2 "!enable" wait [Reload] filedialog "Load a location file", "*.jhf", file$ open file$ for input as #ii for city =1 to places input #ii, xlocation( city) input #ii, ylocation( city) next city ' Option to extract ( if known) the optimum order close #ii call plotscreen #w.b2 "!enable" wait sub swap2 ' source and sink are to be swapped in position.. ie where they appeared in order$ swaps over... ' eg if source =3, sink =6 ' 23 12 03 24 36 41 06 08 ........ becomes ' ** ** ' 23 12 06 24 36 41 03 08 ........ ' ** ** ' ' Sometimes a better swap is to pull out one; close the gap by shifting rest; then insert it elsewhere. ' eg if source =3, sink =6 ' 23 12 03 24 36 41 06 08 ........ becomes ' ** ** ' 23 12 24 36 41 06 08 ........ ' and then ' 23 12 24 36 41 03 06 08 ' ** ** l =len( order$) so =instr( order$, " " +right$( "00" +str$( source), 2)) si =instr( order$, " " +right$( "00" +str$( sink), 2)) if int( 10 *rnd( 1)) <>0 then ' ie 8/9th of the time order$ =left$( order$, so -1) +" " +right$( "00" +str$( sink), 2) +mid$( order$, so +3) order$ =left$( order$, si -1) +" " +right$( "00" +str$( source), 2) +mid$( order$, si +3) else ' ie 1/9th of the time take$ =mid$( order$, so, 3) order$ =left$( order$, so -1) +mid$( order$, so +3) order$ =left$( order$, si -1) +take$ +mid$( order$, si) end if print order$ end sub sub allway tour =0 cityprev =val( mid$( order$, 2, 2)) for j =5 to places *3 step 3 citynext =val( mid$( order$, j, 2)) leg =( ( xlocation( citynext) -xlocation( cityprev))^2 +( ylocation( citynext) -ylocation( cityprev))^2)^0.5 tour =tour +leg cityprev =citynext next j citystart =val( mid$( order$, 2, 2)) lastleg =( ( xlocation( citynext) -xlocation( citystart))^2 +( ylocation( citynext) -ylocation( citystart))^2)^0.5 tour =tour +lastleg end sub [hold] hold =not( hold) if hold then wait goto [main] sub plotscreen city =val( mid$( order$, 2, 2)) #w.g1 "cls ; up ; goto "; xlocation( city) +5; " "; ylocation( city)+5; " ; down ; color black ; font arial 8" for j =2 to places *3 step 3 city =val( mid$( order$, j, 2)) #w.g1 "place "; xlocation( city)+5; " " ; ylocation( city) #w.g1, "|"; str$( city) next j ' Calc. position in order$ of the present and next city cityprev =val( mid$( order$, 2, 2)) ' First city to visit. st =cityprev for j =5 to places *3 step 3 citynext =val( mid$( order$, j, 2)) ' Next city to visit #w.g1 "color "; ( j -5) /( places *3) *255; " "; 255 -( j -5) /( places *3) *255; " 0" #w.g1 "line "; xlocation( cityprev); " "; ylocation( cityprev); " "; xlocation( citynext); " "; ylocation( citynext) cityprev =citynext next j ' Complete the path to start #w.g1 "color 255 0 0" #w.g1 "line "; xlocation( cityprev); " "; ylocation( cityprev); " "; xlocation( st); " "; ylocation( st) #w.g1 "up ; flush" #w.tb1 int( bestyet) #w.tb2 int( last) #w.tb3 i #w.g2 "color black ; set "; i *780 /100000; " "; 200 -int( last /first *200) #w.g2 "color red ; line "; i *780 /100000; " "; 201 -int( bestyet /first *200); " "; i *780 /100000; " 200" #w.g2 "flush" end sub sub Reheat dum$ heat =heat +10 end sub sub SaveGraphic #w.g1 "getbmp screen 0 0 399 399" bmpsave "screen", "TravSales" +str$( time$( "seconds")) +".bmp" unloadbmp "screen" end sub [Info] WindowWidth =750 WindowHeight =530 texteditor #i.te, 10, 10, 720, 490 open "Information" for dialog_modal as #i #i "trapclose [quit2]" #i.te "!font arial 14" #i.te "" #i.te " Simulated annealing & approximate solutions to the travelling salesman problem." #i.te "" #i.te " Twenty five cities are positioned at random. ( You can change this.)" #i.te " A looped route is to be designed of minimal length." #i.te " The initial route joins them in random order." #i.te " Two cities are chosen at random and swapped in the visiting order." #i.te " If the result shortens the route, or increases it only a little, it is retained." #i.te " It is otherwise discarded." #i.te " The allowable upward excursions in path length get smaller and smaller." #i.te " This allows escape from local minima towards a more global minimum." #i.te "" #i.te " Option buttons allow you to save an initial configuration, or reload an old one." #i.te " You can also save the graphic of the current situation." #i.te "" #i.te " There is an option to 'warm up' ie allow larger positive changes if it gets" #i.te " trapped in a local but not global minimum." #i.te "" #i.te " After closing this window, either reload an existing map, or make/save a new one." #i.te " Then 'Run'. You can hold, save graphic, and 'warm it up' if stuck in a sub-minimum." wait [quit] close #w end [quit2] close #i wait