## 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

"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

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
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

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

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

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

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
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

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

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

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

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

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 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

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

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

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

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
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

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.