The Travelling Salesman Problem

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Lothar Schirm
Posts: 443
Joined: Sep 28, 2013 15:08
Location: Germany

The Travelling Salesman Problem

Post by Lothar Schirm »

"Given a list of cities and the distances between each pair of cities, what is the shortest possible route that visits each city exactly once and returns to the origin city?" (https://en.wikipedia.org/wiki/Travellin ... an_problem). Since finding an exact solution is a big effort (for n cities, there are n! possible routes), a simple approach is to visit alway the nearest city as next. Here is what I have tried:

Code: Select all

'===============================================================================
' Travelling_Salesman_Next_Town.bas
' Created on March 06, 2024
'===============================================================================

'Code example for the Travelling Salesman Problem:
'The salesman has to visit the towns number 0 to n in a roundtrip using the shortest 
'possible route. The algorithm is an approximate solution, i.e. always the nearest 
'city is visited as next.


Type Town
	x As Integer	'x, y = Pixelcoordinates of the town
	y As Integer
	flag As Integer	'flag is set to 1 when the town has been selected as next waypoint
End Type

ReDim As Town City(0)
Dim As Integer d, dmin, i, j, k, n, count
Dim As String yn	

'Open graphics screen:
ScreenRes 600, 600
WindowTitle "Travelling Salesman"
Width 600\8, 600\16
Color 0, 15

Do

	Cls
		
	'Number of cities:
	Input "Number of cities: ", n
	n = n - 1
	ReDim City(n)
	
	'Draw cities as circles in random positions with number o to n:
	Randomize Timer
	For i = 0 To n
		City(i).x = 30 + 540 * Rnd
		City(i).y = 30 + 540 * Rnd
		City(i).flag = 0 'no waypoints are selected up to now
		Circle (City(i).x+2, City(i).y+2), 5, 4,,,, F
		Draw String (City(i).x+6, City(i).y+6), Str(i)
	Next
	
	k = 0 
	PSet (City(0).x, City(0).y)	'set graphics cursor to position of city(0)
	count = 0	'number of waypoints
	Do
		'After the first waypoint has ben found, set City(0).flag to 1: 
		If count > 0 Then City(0).flag = 1
		'Search for the shortest distance between City(k) and all other cities 
		'which have yet not been selected as waypoints to find the next waypoint:
		dmin = 1000
		For i = 0 To n
			If i <> k And City(i).flag = 0 Then
				d = Sqr((City(k).x - City(i).x)^2 + (City(k).y - City(i).y)^2)
				If d < dmin Then 
					dmin = d
					j = i
				End If
			End If
		Next
		'City(k) is the next waypoint:  
		k = j 
		count = count + 1	'increment number of defined waypoints
		City(k).flag = 1
		'Draw the way to the next city:
		Line - (City(k).x, City(k).y), 2
		Sleep 500
	Loop Until count = n	'Stop afte n waypoints
	
	'Close the path:
	Line - (City(0).x, City(0).y), 2
	
	Input "Again y/n? ", yn
	
Loop Until LCase(yn) = "n"

End	
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The Travelling Salesman Problem

Post by dodicat »

You could also do a circuit around the locations??

Code: Select all


#define intrange(f,l) Int(Rnd*(((l)+1)-(f))+(f))
Type pt
    As Integer x,y
End Type

Function distance(points() As pt) As Integer
    #define length(a,b) ((a.x-b.x)*(a.x-b.x)+(a.y-b.y)*(a.y-b.y))
    Dim As Single total,L
    For n As Integer=Lbound(points) To Ubound(points)-1
        L= length(points(n),points(n+1))
        total+=Sqr(L)
    Next n
    Return total
End Function

Sub show(c() As pt,flag As Integer)
    Circle(c(1).x,c(1).y),5,4,,,,f 
    For n As Integer=Lbound(c)+1 To Ubound(c)
        If flag Then Line -(c(n).x,c(n).y)
        If n< Ubound(c) Then Circle(c(n).x,c(n).y),5 Else Circle(c(n).x,c(n).y),5,2,,,,f
    Next n
    If flag Then
        Draw String(c(1).x,c(1).y-20),Str(1)
        For n As Integer=Lbound(c)+1 To Ubound(c)
            Draw String(c(n).x,c(n).y-20),Str(n)
        Next n
    End If
End Sub

sub circulate(p() as pt)
 #macro Circlesort() 
 '  bubblesort
For p1 as long  = lbound(p) To ubound(p)-1
    For p2 as long  = p1 + 1 To ubound(p)
        if atan2(p(p1).y-c.y,p(p1).x-c.x)< atan2(p(p2).y-c.y,p(p2).x-c.x) then
            swap p(p1),p(p2)
            end if
         Next p2
    Next p1
 #endmacro
 dim as pt C '--centroid of points
 dim as long counter
 for n as long=lbound(p) to ubound(p)
     counter+=1
     c.x+=p(n).x
     c.y+=p(n).y
 next n
 c.x=c.x/counter
 c.y=c.y/counter
 CircleSort()
end sub

Sub setup(points() As pt)
    For n As Integer=Lbound(points) To Ubound(points)
        points(n)=Type<pt>(IntRange(10,790),IntRange(50,590))
    Next n
End Sub


Screen 19
randomize(timer)
Redim As pt result()
Do
    Var num=intrange(6,30)
    Redim result(1 To num)
    setup(result()) 'set some random screen points
    circulate(result())
    show(result(),0)
    Print "Press a key (or <esc> to end)"
    Sleep
    If Inkey=Chr(27) Then Exit Do
    show(result(),1)
    Draw String(10,15), "minimum distance = "& distance(result())
    Sleep
    If Inkey=Chr(27) Then Exit Do
    Cls
Loop 

 
Lothar Schirm
Posts: 443
Joined: Sep 28, 2013 15:08
Location: Germany

Re: The Travelling Salesman Problem

Post by Lothar Schirm »

Hi dodicat, I see only some circles (not filled), a green circle (filled) and a red circle (filled), no path (no lines), no result. Is your code incomplete?
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: The Travelling Salesman Problem

Post by BasicCoder2 »

Lothar Schirm
Works ok for me? When I hit the space bar once I get the circles (towns). Hit the space bar again straight lines join up the towns from red to green circle. Hit the space bar again and another random number of towns at random positions appear. Hit the space bar again and they join up. ESC key to exit.

Ideally you need to run both algorithms on the same layout of towns to see which one performs the best.

Real towns are usually not joined by straight lines (roads).
Lothar Schirm
Posts: 443
Joined: Sep 28, 2013 15:08
Location: Germany

Re: The Travelling Salesman Problem

Post by Lothar Schirm »

Oh yes, I understand. Works fine and looks very nice. I misinterpreted "Press a key (or <esc> to end)", I just pressed <esc>.
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The Travelling Salesman Problem

Post by dodicat »

A little more colourful maybe?

Code: Select all

'#cmdline "-exx"
#define intrange(f,l) Int(Rnd*(((l)+1)-(f))+(f))

Dim  As String  vn(0 To ...) ={"Lockwood Village","Little Hinton","New Malia","Rose Hills","Katoka Village","Lemzilville","Elderville","Brushwind Village","Old Town Sycamore","Azalea Village","Kraniya Town","Tancarville","Taffir Town","Old Evergreen","Zyron Village","The Valley","Apolline Village","Yellow Garden Village","Gentle Mornings","Stoneykirk Village","Old Town Kiko","Taziz Town","Great Oaks Village","Old Lucia","Tryxon Village","Kharthas Village","Lady Krea Village","Wahftar Town","Frandlyn Village","Grytt Village","Quinn Village","Old Pyro","Old Town Desberg","Bird Valley","Plum Paradise","Blurg Village","New Chestnut","Saeville","Great Xendos","Tryx Town","Hirtas Villas","New Grasslands","Diamond Village","Marys Town","Auburn Village","Port Gendar","Peach Pink Village","Waehr Village","Old Town Joviz","Gale Town"}
Type pt
    As Integer x,y
    As String  cap
End Type

Redim Shared As pt c()

Function ShortSpline(p() As pt,t As Single) As pt
    #macro set(n)
    0.5 *(     (2 * P(2).n) +_
    (-1*P(1).n + P(3).n) * t +_
    (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
    #endmacro
    Dim As pt G
    G.x=set(x):G.y=set(y)':G.z=set(z)
    Return g
End Function

Sub GetSpline(v() As pt,outarray() As pt,arraysize As Integer=9000)
    Dim As pt p(1 To 4)
    Redim outarray(0)
    Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
    If stepsize>1 Then stepsize=1
    For n As Integer=Lbound(v)+1 To Ubound(v)-2
        p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
        For t As Single=0 To 1 Step stepsize
            Redim Preserve outarray(1 To Ubound(outarray)+1)
            outarray(Ubound(outarray))=ShortSpline(p(),t)
        Next t
    Next n
End Sub

Sub DrawCurve(a() As pt,ydisp As Integer=0,col As Ulong)
    Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
    For z As Integer=Lbound(a)+1 To Ubound(a)
        Line-(a(z).x,a(z).y+ydisp),col
    Next z
End Sub

Function shortline(fp As pt,p As pt,length As Single) As pt
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As pt t
    t.x=fp.x+length*diffx
    t.y=fp.y+length*diffy
    Return t
End Function

Function closestdistance Overload(clr() As pt,v As Long) As Long
    #define dist(p1,p2) Sqr((p1.x-p2.x)*(p1.x-p2.x) + (p1.y-p2.y)*(p1.y-p2.y))
    Dim As Double dt=1e20
    For n As Long=Lbound(clr) To Ubound(clr)
        If v=n Then Continue For
        Var distance=dist(clr(n),clr(v))
        If dt> distance Then dt = distance 'catch the distance
    Next n
    Return dt
End Function

Sub shuffle(a() As String)
    #define range(f,l) Int(Rnd*((l+1)-(f))+(f))
    For n As Long = Lbound(a) To Ubound(a)-2
        Swap a(n), a(range((n+1),Ubound(a)))
    Next n
End Sub

Function distance(points() As pt) As Integer
    #define length(a,b) ((a.x-b.x)*(a.x-b.x)+(a.y-b.y)*(a.y-b.y))
    Dim As Single total,L
    For n As Integer=Lbound(points) To Ubound(points)-1
        L= length(points(n),points(n+1))
        total+=Sqr(L)
    Next n
    Return total
End Function

Sub show(c() As pt,flag As Integer)
    For n As Integer=Lbound(c)+1 To Ubound(c)-1
        Var L=Len(c(n).cap)
        Draw String(c(n).x-8*L/2,c(n).y+7),c(n).cap,6
        Circle(c(n).x,c(n).y),5
    Next n
    If flag Then
        For n As Integer=Lbound(c)+1 To Ubound(c)-1
            If n=Lbound(c)+1 Then Circle(c(n).x,c(n).y),5,4,,,,f :Draw String(10,25)," start at village "+c(n).cap
            If n=Ubound(c)-1 Then Circle(c(n).x,c(n).y),5,2,,,,f:Draw String(10,35),"finish at village "+c(n).cap 
            Draw String(c(n).x,c(n).y-14),Str(n)
        Next n
        Draw String(10,45),"number of visits "+Str(Ubound(c)-1) 
    End If
End Sub

Sub circulate(p() As pt)
    #macro Circlesort() 
    '  bubblesort
    For p1 As Long  = Lbound(p)+1 To Ubound(p)-1-1
        For p2 As Long  = p1 + 1 To Ubound(p)-1
            If Atan2(p(p1).y-c.y,p(p1).x-c.x)< Atan2(p(p2).y-c.y,p(p2).x-c.x) Then
                Swap p(p1),p(p2)
            End If
        Next p2
    Next p1
    #endmacro
    Dim As pt C '--centroid of points
    Dim As Long counter
    For n As Long=Lbound(p) To Ubound(p)
        counter+=1
        c.x+=p(n).x
        c.y+=p(n).y
    Next n
    c.x=c.x/counter
    c.y=c.y/counter
    CircleSort()
End Sub

Sub setup(points() As pt,vn() As String)
    Var u=Ubound(points),L=Lbound(points)
    For n As Integer=Lbound(points) To Ubound(points)
        Do
            points(n).x=IntRange(20,1000) 
            points(n).y=IntRange(50,710)
        Loop Until closestdistance(points(),n)>80
    Next n
    
    Dim As pt temp(Lbound(points) To Ubound(points))
    For n As Long=Lbound(points) To Ubound(points)
        temp(n)=points(n)
    Next
    Redim  points(0 To Ubound(points)+1)
    For n As Long=Lbound(points) To Ubound(points)
        If n>0 And n<Ubound(points) Then points(n)=temp(n)
    Next
    Var k=shortline(points(2),points(1),1.1)
    points(0)=k
    k=shortline(points(u-1),points(u),1.1)
    points(u+1)=k
    For n As Long=Lbound(points) To Ubound(points)
        points(n).cap=Ucase(vn(n))
    Next
End Sub


Screen 20
Width 1024\8,768\8
Randomize(Timer)
Redim As pt result()

Do
    Var num=intrange(6,30)
    Redim result(1 To num)
    setup(result(),vn()) 'set some random screen points
    show(result(),0)
    circulate(result())
    GetSpline(result(),c())
    Print "Press a key (or <esc> to end)"
    Sleep
    Cls
    If Inkey=Chr(27) Then Exit Do
    show(result(),1)
    Draw String(10,15), "crow fly distance = "& distance(result())
    DrawCurve(c(),,2)
    Sleep
    shuffle(vn())
    If Inkey=Chr(27) Then Exit Do
    Cls
Loop 

 
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: The Travelling Salesman Problem

Post by BasicCoder2 »

Just for fun I asked AI to generate a solution. I had to modify the solution to make it work and add graphics to display the city layouts.

Code: Select all

'MODIFIED CODE GENERATED BY https://deepai.org/chat

'This code generates random cities with x and y coordinates, computes the
'shortest path through all cities using a brute force approach, and then
'outputs the shortest path and total cost of the path.

screenres 640,480,32

#define NCITIES 5

type city
    x as integer
    y as integer
end type

dim shared cities(NCITIES) as city
dim shared visited(NCITIES) as integer
dim shared minpath(NCITIES) as integer
dim shared mincost as double


function distance() as double
    dim i as integer
    dim result as double

    result = 0

    for i = 0 to NCITIES - 1
        if i < NCITIES - 1 then
            result = result + sqr((cities(visited(i)).x - cities(visited(i + 1)).x) ^ 2 + (cities(visited(i)).y - cities(visited(i + 1)).y) ^ 2)
        else
            result = result + sqr((cities(visited(i)).x - cities(visited(0)).x) ^ 2 + (cities(visited(i)).y - cities(visited(0)).y) ^ 2)
        end if
    next

    return result
end function


sub permuteCities(k as integer)
    dim i as integer
    dim temp as double

    if k = NCITIES then
        temp = distance()

        if temp < mincost or mincost = 0 then
            mincost = temp

            for i = 0 to NCITIES - 1
                minpath(i) = visited(i)
            next
        end if
    else
        for i = k to NCITIES - 1
            
            swap visited(i), visited(k)

            permuteCities(k + 1)

            swap visited(i), visited(k)
            
        next
    end if
end sub



sub main()
    
    dim i as integer

    randomize

    ' Generate random cities
    for i = 0 to NCITIES - 1
        cities(i).x = rnd * (600+10)
        cities(i).y = rnd * (440+10)
        visited(i) = i
        circle (cities(i).x,cities(i).y),3,rgb(255,0,0),,,,f
        draw string (cities(i).x+4,cities(i).y),str(i)
    next
    

    mincost = 0
    
    for k as integer = 0 to NCITIES - 1
        permuteCities(k)
    next k
    

    print "Shortest Path:"
    for i = 0 to NCITIES - 1
        print minpath(i)
    next

    print "Total Cost: "; mincost

    sleep
end sub

main()
Lothar Schirm
Posts: 443
Joined: Sep 28, 2013 15:08
Location: Germany

Re: The Travelling Salesman Problem

Post by Lothar Schirm »

Seems to be a nice stuff to play with! BasicCoder2: If you increase the numbers of cities, the computation time will decrease dramatically with that brute force method, as expected.
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: The Travelling Salesman Problem

Post by BasicCoder2 »

Lothar Schirm

A brute force approach rapidly becomes unsuitable as the number of cities increases. I was just curious what the current AI would generate.

I asked for a fast good enough solution for the traveling salesman problem and it comes up with your nearest neighbor solution. I added the graphics as the AI never uses them.

Code: Select all


screenres 1024,600,32

Dim As Integer numCities = 25

Dim As Integer citiesX(numCities), citiesY(numCities)
for i as integer = 0 to numCities-1
    citiesX(i) = int(rnd(1)* 1000) + 10
    citiesY(i) = int(rnd(1)* 580) + 10
next i

for i as integer = 0 to numCities-1
    circle (citiesX(i), citiesY(i)),3,rgb(255,0,0)
next i

' Initialize variables
Dim As Integer visited(numCities), totalDistance = 0
Dim As Integer currentCity = 0, nextCity

' Mark the starting city as visited
visited(currentCity) = 1

' Visit each city based on nearest neighbor heuristic
For i As Integer = 1 To numCities - 1
    Dim As Integer minDistance = 9999 ' Initialize with a large value
    For j As Integer = 0 To numCities - 1
        If visited(j) = 0 Then
            Dim As Integer distance = SQR((citiesX(currentCity) - citiesX(j))^2 + (citiesY(currentCity) - citiesY(j))^2)
            If distance < minDistance Then
                minDistance = distance
                nextCity = j
            End If
        End If
     Next j
     
     ' Update total distance and mark city as visited
     totalDistance = totalDistance + minDistance
     visited(nextCity) = 1

     
     line (citiesX(currentCity), citiesY(currentCity))-(citiesX(nextCity), citiesY(nextCity)),rgb(0,255,0)
     
    currentCity = nextCity
     
Next i

' Return to starting city and add the distance
totalDistance = totalDistance + SQR((citiesX(currentCity) - citiesX(0))^2 + (citiesY(currentCity) - citiesY(0))^2)

Print "Total Distance Traveled: "; totalDistance
sleep


I see earlier posts on the subject.

viewtopic.php?t=8630
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The Travelling Salesman Problem

Post by dodicat »

Basiccder2/others.
Many years ago (1984), my late wife and myself and our small dog took a long Summer break in our towing caravan.
We ended up near London, and parked up in a site by the edge of Epping forest.
My wife got a temporary job, at her trade as bookkeeper, in Woodford Green, I took a job as a milkman at Hobb's Cross dairies near Theydon Bois.
I tried to optimize my path to get back early, about 8 o'clock am, and spend a few hours in the forest with our dog, while my wife set off for Woodford Green.
The previous man on the same round had his own method, I decided to to try the round in one circular around a kind of central point.
I tried never to cross any paths (roads) I had already been on.
I suppose this would be called a top down approach, where the nearest neighbour (door to door) would be a bottom up way of doing it.
Anyway, come September we made our way back North and home, and I don't think I made any great gains over the previous guys way.
I passed on my route to the guy who took over the round, but I don't know if he adopted it or made his own way.
Anyway, rare old days, and that is the closest I ever got to being a travelling salesman.
UEZ
Posts: 996
Joined: May 05, 2017 19:59
Location: Germany

Re: The Travelling Salesman Problem

Post by UEZ »

The first time I heard about the traveling salesman problem was in computer science class at university in the early 90s. The problem is NP-complete, as far as I can remember, and not solvable in polynomial time.

It is good to hear that the solution to the problem has actually found practical application.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

Re: The Travelling Salesman Problem

Post by dafhi »

dodicat i looked at your last code's output, and, while i don't feel equipped to come up with a solution, your pattern looks like donut drizzle. i got to thinkin, a donut outline would be more efficient, and i wonder how about the universality of a donut shape
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The Travelling Salesman Problem

Post by dodicat »

We'll need to get this problem solved analytically soon, and not rely on brute force, nearest neighbour or doughnuts.
If we intend eventually to visit every planet in the milky way, we shall have to do it in an orderly manner, and not just drop down hither and thither, uninvited.
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: The Travelling Salesman Problem

Post by BasicCoder2 »

I have modified Lothar Schirm's code to having a fixed number of towns and when the program is exited the town locations are saved as data statements in townsData.bas to be copied pasted into another version which reads the locations rather than making a new random selection. This data set can be used with another algorithm to compare results. I have yet to modify dodicat's version to read the same data set as a comparison.

On visual inspection of the results I often seem to see obvious changes which would make the path shorter.

'select a data set to save

Code: Select all

'===============================================================================
' Travelling_Salesman_Next_Town.bas
' Created on March 06, 2024
'===============================================================================

'Code example for the Travelling Salesman Problem:
'The salesman has to visit the towns number 0 to n in a roundtrip using the shortest 
'possible route. The algorithm is an approximate solution, i.e. always the nearest 
'city is visited as next.
Open "townsData.bas"  For Output As #1

Type Town
	x As Integer	'x, y = Pixelcoordinates of the town
	y As Integer
	flag As Integer	'flag is set to 1 when the town has been selected as next waypoint
End Type

ReDim As Town City(0)
Dim As Integer d, dmin, i, j, k, n, count
Dim As String yn	

'Open graphics screen:
ScreenRes 600, 600
WindowTitle "Travelling Salesman"
Width 600\8, 600\16
Color 0, 15

Do

	Cls

    n = 20
    
	ReDim City(n)
	
	'Draw cities as circles in random positions with number o to n:
	Randomize Timer
	For i = 0 To n
		City(i).x = 30 + 540 * Rnd
		City(i).y = 30 + 540 * Rnd
		City(i).flag = 0 'no waypoints are selected up to now
		Circle (City(i).x+2, City(i).y+2), 5, 4,,,, F
		Draw String (City(i).x+6, City(i).y+6), Str(i)
	Next
	Circle (City(0).x+2, City(0).y+2), 5, 11,,,, F
    
	k = 0 
	PSet (City(0).x, City(0).y)	'set graphics cursor to position of city(0)
	count = 0	'number of waypoints
	Do
		'After the first waypoint has ben found, set City(0).flag to 1: 
		If count > 0 Then City(0).flag = 1
		'Search for the shortest distance between City(k) and all other cities 
		'which have yet not been selected as waypoints to find the next waypoint:
		dmin = 1000
		For i = 0 To n
			If i <> k And City(i).flag = 0 Then
				d = Sqr((City(k).x - City(i).x)^2 + (City(k).y - City(i).y)^2)
				If d < dmin Then 
					dmin = d
					j = i
				End If
			End If
		Next
		'City(k) is the next waypoint:  
		k = j 
		count = count + 1	'increment number of defined waypoints
		City(k).flag = 1
		'Draw the way to the next city:
		Line - (City(k).x, City(k).y), 2
		Sleep 500
	Loop Until count = n	'Stop afte n waypoints
	
	'Close the path:
	Line - (City(0).x, City(0).y), 2
	
	Input "Again y/n? ", yn
        
	
Loop Until LCase(yn) = "n"

'save locations in data statements
dim as integer counter
counter = 0
print #1,"DATA ";
For i as integer = 0 To n
    print #1,City(i).x;",";City(i).y;
    counter = counter + 1
    if counter > 6 then
        print #1,
        print #1,"DATA ";
        counter = 0
    else
        print #1,",";
    end if
next i

close #1


This version uses a data set of locations rather than a random selection.

Code: Select all

'===============================================================================
' Travelling_Salesman_Next_Town.bas
' Created on March 06, 2024
'===============================================================================

'Code example for the Travelling Salesman Problem:
'The salesman has to visit the towns number 0 to n in a roundtrip using the shortest 
'possible route. The algorithm is an approximate solution, i.e. always the nearest 
'city is visited as next.


Type Town
	x As Integer	'x, y = Pixelcoordinates of the town
	y As Integer
	flag As Integer	'flag is set to 1 when the town has been selected as next waypoint
End Type

Dim As Town City(20)
Dim As Integer d, dmin, i, j, k, n, count
Dim As String yn	

n = 20

'Open graphics screen:
ScreenRes 600, 600
WindowTitle "Travelling Salesman"
Width 600\8, 600\16
Color 0, 15

    cls

	For i = 0 To n
		read City(i).x
		read City(i).y
		City(i).flag = 0 'no waypoints are selected up to now
		Circle (City(i).x+2, City(i).y+2), 5, 4,,,, F
		Draw String (City(i).x+6, City(i).y+6), Str(i)
	Next
	Circle (City(0).x+2, City(0).y+2), 5, 11,,,, F

Do

	k = 0 
	PSet (City(0).x, City(0).y)	'set graphics cursor to position of city(0)
	count = 0	'number of waypoints
	Do
		'After the first waypoint has ben found, set City(0).flag to 1: 
		If count > 0 Then City(0).flag = 1
		'Search for the shortest distance between City(k) and all other cities 
		'which have yet not been selected as waypoints to find the next waypoint:
		dmin = 1000
		For i = 0 To n
			If i <> k And City(i).flag = 0 Then
				d = Sqr((City(k).x - City(i).x)^2 + (City(k).y - City(i).y)^2)
				If d < dmin Then 
					dmin = d
					j = i
				End If
			End If
		Next
		'City(k) is the next waypoint:  
		k = j 
		count = count + 1	'increment number of defined waypoints
		City(k).flag = 1
		'Draw the way to the next city:
		Line - (City(k).x, City(k).y), 2
		Sleep 500
	Loop Until count = n	'Stop afte n waypoints
	
	'Close the path:
	Line - (City(0).x, City(0).y), 2
	
	Input "Again y/n? ", yn
        
	
Loop Until LCase(yn) = "n"

DATA  280, 173, 193, 111, 93, 544, 114, 109, 414, 298, 165, 545, 384, 281
DATA  100, 407, 338, 313, 328, 369, 347, 341, 343, 222, 80, 454, 250, 165
DATA  97, 389, 565, 240, 228, 348, 535, 177, 71, 89, 343, 415, 122, 107

caseih
Posts: 2159
Joined: Feb 26, 2007 5:32

Re: The Travelling Salesman Problem

Post by caseih »

UEZ wrote: Mar 08, 2024 20:52 The first time I heard about the traveling salesman problem was in computer science class at university in the early 90s. The problem is NP-complete, as far as I can remember, and not solvable in polynomial time.

It is good to hear that the solution to the problem has actually found practical application.
Yes that's the first I've heard of it being applied to a person's daily life who wasn't a salesman. haha.

This problem actually does have a lot of practical application. There's a reason it has the name it has! Companies with salespeople on the road really do need to have workable solutions to this thorny problem. Another practical application would be in generating CNC paths. Fortunately there are several heuristics that provide acceptable solutions to this problem in acceptable time, with different tradeoffs (often using a lot of memory). I think the main heuristic we used in uni was branch and bound. But it's been a long time. I learned enough to identify probable NP-complete problems, so I can avoid trying to solve them.
Post Reply