' 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