The Travelling Salesman problem

A salesman is to visit all his customers by the shortest route possible, returning to the start.
Here, I implement this by continually trying mutations of 'order$', which holds the order they are to be visited. Each change is tested to see if it makes an improvement, and is rejected unless it does. However, at first it is allowed to make INCREASES, but this allowance 'heat' gets smaller and smaller. This allows it to 'get out of' local minima and settle into (we hope) the global minimum.
By including graphics everything is slowed a lot, but it is addictive to watch it trying to improve the route! And you can 'warm it up' if it seems stuck!


You can never guarantee you've reached THE minimum. You can boost the 'heat' with the 'reheat' button, or start again and reload the same datapoints to see if there is a lurking better solution! The example shown above CAN be bettered...
First, either create/save a new dataset, or reload an existing one. Then click 'run'. You cn toggle 'hold' off and on if you wish. It saves every 1000 trials, but you can also choose spot-saves with the button.
This is a work still not finished- see the to-do list included!

'   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



You can e-mail any comments or queries to mr dot joh dot f at gmail.com