Traveling Salesman Problem

[danbaron]

Hi Gang!

Here is an EB program that solves the Traveling Salesman Problem.

The Wikipedia problem description is at:

http://en.wikipedia.org/wiki/Traveling_salesman_problem

I put a lot of text in the code listing, explaining the program
operation, and also the problem itself.

Dan.

Code Select Expand

'----------------------------------------------------------------------

'FILE = SALESMAN.EBA
'program to solve the Traveling Salesman Problem

'Wikipedia problem description at:
' http://en.wikipedia.org/wiki/Traveling_salesman_problem

'Simpler Wikipedia problem description at:
' http://simple.wikipedia.org/wiki/Travelling_Salesman_Problem

'EMERGENCE BASIC PROGRAM
'USE "BUILD SINGLE".
'BUILD IT AS TYPE, "CONSOLE EXE".

'----------------------------------------------------------------------
'START: PROGRAM OPERATION
'----------------------------------------------------------------------
/*

Emergence Basic program

(See below, for "PROGRAM EXPLANATION".)

Use "BUILD SINGLE".

Build it as type, "CONSOLE EXE".

There are 4 constants, just below, which you can set. The important one
is NUMCITIES. It determines how many cities comprise the salesman's
route. If you set the value for RANDSEED, positive, then that value will
be used to seed the random number generator. If you set the value,
negative, then a random seed will be used. Probably, the default values
for UPDATEINTERVAL and FILESTRING, are good.

When the program begins execution, maximize the console window. (I tried
to do it programmatically, and the result was a big mess.) You may also
have to scroll to the top of the console window.

The program displays the distance table, and updates the current
statistics, in the console window.

If you get tired of watching the program run, you can press "ESC" at any
time. Then the final statistics will be displayed on the screen, and the
partial solution will be written to the out-file. Then, you press "ESC"
again, and the program will terminate.

If the program completes execution, it will write the complete solution
to the out-file, and inform you on the screen, that it is done. Then,
you press "ESC", and the program will terminate.

During each loop of the program, one systematic route permutation, and
one random route permutation, are examined. A systematic permutation, is
the next permutation in the arithmetical progression of all the possible
route permutations. A random permutation, is a permutation
constructed using the random number generator. For large problems, it is
impossible to find the shortest route, even in a million years. So, for
those problems, you are instead looking for the best route you can find.
In those cases, random permutations, may do better than systematic
permutations.

At regular intervals, the current statistics: i.e., update number;
elapsed time; current systematic permutation number (current program
loop number); current minimum, average, and maximum route lengths - for
both the systematic search and the random search; are written to the
console. Additionally, the total number of systematic permutations, is
displayed. Using it, the elapsed time, and the current systematic
permutation number, you can estimate how long the program would take to
complete execution.

When the program ends, either because it has finished, or because it has
been stopped by you, it writes the final route lengths, and the
corresponding routes, to both the console and the out-file.

The 4 constants which appear next below, are the only values you need to
set. After you set them, just compile and run the program.

*/
'----------------------------------------------------------------------
'END: PROGRAM OPERATION
'----------------------------------------------------------------------
'START: CONSTANTS SET BY USER
'----------------------------------------------------------------------

'Set the value for the number of cities, NUMCITIES, 0 < NUMCITIES < 27.

CONST NUMCITIES = 11

'Set the value to seed the random number generator, RANDSEED.
'RANDSEED cannot be 0, if it is, it will be changed to 1.
'If RANDSEED is negative, it will be set to the number of
'elapsed seconds in the current day.

CONST RANDSEED = -1

'Set the value for UPDATEINTERVAL, the interval in seconds,
'at which the current statistics are updated on the screen.

CONST UPDATEINTERVAL = 15

'When program execution ends, the final statistics are written
'to a file, by default, "SALESMAN.TXT".

CONST FILESTRING = "SALESMAN.TXT"

'----------------------------------------------------------------------
'END: CONSTANTS SET BY USER
'----------------------------------------------------------------------
'NOTHING SHOULD NEED TO BE CHANGED BELOW THIS POINT (I HOPE).
'----------------------------------------------------------------------
'START: PROGRAM EXPLANATION
'----------------------------------------------------------------------
/*

The problem can be described like this. A traveling salesman will leave
his home city and travel once to each city in a certain set of cities,
and then return to his home city. He wants to order the sequence of his
visits, so that the total distance for the trip is minimized. He has a
chart (like the kind that appear in a road atlas) that gives the
distance from each city to all of the others.

-----------------------------------------------------------------------
   "PERMUTATION", means, "ORDERING".
-----------------------------------------------------------------------

The problem has been studied a lot. I think the reason is, that the
problem is very simple to describe, and very difficult to solve. No
foolproof shortcut has been found to determine the shortest route. The
only method which has been determined, that guarantees success for every
case, is that of "brute force", i.e., examining every unique route
permutation.

-----------------------------------------------------------------------

In the program, the cities have the names of the uppercase letters of
the alphabet, A-Z. The salesman's home city is A; he starts and ends his
trip at city A. You choose how many cities there are to be for a
particular program execution. Let's say, you choose 5 cities. Then, the
cities would consist of A-E. One route would be,

ACBEDA.

He would start from A, and then travel in order to C, B, E, D, and then
back to A.

The program calculates a distance table, like the one below. For 5
cities, the table has 25 entries. But, 5 of the entries are 0: AA, BB,
CC, DD, EE; the distance from a city to itself. Also, the table is
symmetric, i.e., AB = BA, AC = CA, etc. So, for 5 cities, the program
only needs to provide 10 values for the distance table. For "n" cities,
the program provides n*(n-1)/2 values.

Let j = n*(n-1)/2.

The program randomly fills the required locations in the table with the
values, 1 to j.

DISTANCE TABLE
   A   B   C   D   E
A 000 007 010 004 003
B 007 000 006 008 005
C 010 006 000 002 001
D 004 008 002 000 009
E 003 005 001 009 000

Back to the permutation, ACBEDA. Using the distance table above, the trip
length is 34.

AC    = 010
CB    = 006
BE    = 005
ED    = 009
DA    = 004
-----------
total = 034

Notice something else about permutation ACBEDA. There are 5 cities, but
the permutation length is only 4. "A" appears at each end of every
permutation. In the case of 5 cities, B-E are permuted in between. So,
for n cities, there are (n-1)! permutations (See the definition of
"factorial", just below.).

Notice another thing about permutation ACBEDA. How does it resemble
permutation ADEBCA? Each, is the reverse of the other, right? And both
have the same lengths. Both, are the same routes, but traveled in
opposite directions. That is why a distance table is symmetric.

So, once permutation ACBEDA is examined, there is no need to examine its
reverse, ADEBCA. There is never a need to examine the reverse of a
previous permutation.

Therefore, for n cities, there are ((n-1)!)/2 unique permutations, and
those are all that the program looks at.

-----------------------------------------------------------------------

Let's define the meaning of "factorial". For an integer, n, n factorial,
written "n!", is defined as

n! = 1*2*3.. *n.
So,
1! = 1
2! = 1*2, = 2
3! = 1*2*3, = 6
10! = 1*2*3*4*5*6*7*8*9*10, = 3628800


(The factorial formula only works for integers. Interestingly,
mathematicians have determined the Gamma function, which is valid for
any positive number, and gives the same answer as the factorial formula,
for every positive integer. The factorial formula plots as isolated
points. The Gamma function is continuous and smoothly fills in the
intervals between the factorial points.

Wikipedia Gamma function description at:
http://en.wikipedia.org/wiki/Gamma_function )

-----------------------------------------------------------------------

"n" objects can be permuted (ordered), in n! ways. How do we know this?
Say, we have 3 objects, an apple, an orange, and a pear. We want to
count all of the ways that they can be ordered. When we choose which one
will be in the first position, we have three choices. Then, when we
choose which one will be in the second position, we will have two
choices, because we already used one of the fruits in the first
position, and we cannot use that fruit again. Then, when we choose which
one will be in the third position, we will only have one choice, because
we already used the other two fruits in positions one and two, and we
cannot use either again. So, in the first position we have three
choices, in the second position we have two choices, and in the third
position we have one choice. The total number of combinations is 3*2*1,
= 3!, = 6. So, for n objects, there are n! permutations. For the 3
fruits, they are,

apple orange pear
apple pear orange
orange apple pear
orange pear apple
pear apple orange
pear orange apple

-----------------------------------------------------------------------

Let t(i) equal the time required to determine the complete solution for
i cities. Let t(j) equal the time required to determine the complete
solution for j cities. Then, I think the following relation, is
approximately correct.

t(j)/t(i) = (j-1)/(i-1) * (j-1)!/(i-1)!  [01]

The factor, (j-1)/(i-1), accounts for the difference in permutation
lengths. As the permutation length increases, so does the number of
calculations for each permutation.

The factor, (j-1)!/(i-1)!, accounts for the difference in the number of
permutations.

From Equation [01],

t(j) = (j-1)/(i-1) * (j-1)!/(i-1)! * t(i) [02]

On my machine, it took 120 minutes to determine the complete solution
for 13 cities. Therefore, according to Equation [02], on my machine, to
determine the complete solution for 26 cities, should take approximately
15 trillion years. So, probably, for most machines, the program
limitation of a maximum of 26 cities, is not a terrible detriment.

The huge time required to determine the complete solution for most
problems, is the main reason I included the random search along with the
systematic search. For a problem with a relatively large number of
cities, the systematic search could spend a hundred years on just one
tiny twig of the permutation tree.

-----------------------------------------------------------------------

Let "S.R." mean, the "shortest route".

Let P(S.R.) mean, the probability that you have found the shortest
route.

For n cities, if you have examined 0 permutations, then,

P(S.R.) = 0.

For n cities, if you have examined all (n-1)!/2 permutations, then,

P(S.R.) = 1.

For n cities, and every other number of permutations,

0 < P(S.R.) < 1.

In other words, even if you cannot examine all of the permutations, as
the number of permutations you do examine, increases; statistically, the
difference between your best solution and the S.R., will decrease.

-----------------------------------------------------------------------

The distance table in the output file will not print correctly if the
table is too wide. But, I was able to fix the problem, by choosing
"Editor Options..." in the "File" menu, and changing the "Courier New"
size, to "8 pt".

-----------------------------------------------------------------------

Have a pen and paper ready, and when the distance table appears on the
screen, try to beat the computer! Remember, when you see the distance
table, the solution is staring you in the face. All you need to do, is
recognize it..

*/
'----------------------------------------------------------------------
'END: PROGRAM EXPLANATION
'----------------------------------------------------------------------
'START: GLOBAL CONSTANTS
'----------------------------------------------------------------------

CONST PERMUTATIONLENGTH = NUMCITIES - 1
CONST MAXCITIES    = 26
CONST MAXBASE10    = 14
CONST NUMDISTANCES = NUMCITIES * (PERMUTATIONLENGTH) / 2
CONST TABLETOP     = 5
CONST TABLEBOT     = TABLETOP + 2 * NUMCITIES + 1
CONST BIGINT = 1000000
CONST PARTIAL = 0
CONST COMPLETE = 1

'----------------------------------------------------------------------
'END: GLOBAL CONSTANTS
'----------------------------------------------------------------------
'START: SUBROUTINE CONSTANTS AND STATIC VARIABLES
'----------------------------------------------------------------------

'FOR FUNCTION RAN2() *******************************************

CONST IM1       = 2147483563
CONST IM2       = 2147483399
CONST IMM1      = IM1 - 1
CONST IA1       = 40014
CONST IA2       = 40692
CONST IQ1       = 53668
CONST IQ2       = 52774
CONST IR1       = 12211
CONST IR2       = 3791
CONST NTAB      = 32
CONST NDIV      = 1 + IMM1 / NTAB
CONST DEPS      = 1.0E-16
INT   RAN2SEED  = 0
INT   IDUM2     = 0
INT   IY        = 0
CHAR  RAN2FLAG  = 0
INT   IV[NTAB]
INT   INITIALRAN2SEEDVAL

'FOR FUNCTION RAN2() *******************************************

'----------------------------------------------------------------------

'FOR SUBROUTINE SHOWSTATISTICS() *******************************

INT LASTTIME = FALSE

STRING CPSTRING = "CURRENT PERMUTATION = "
INT LCPSTRING = LEN(CPSTRING)
STRING TPSTRING = "TOTAL PERMUTATIONS  = "
INT LTPSTRING = LEN(TPSTRING)

STRING SSSTRING = "S.S."
INT LSSSTRING = LEN(SSSTRING)
STRING RSSTRING = "R.S."
INT LRSSTRING = LEN(RSSTRING)

STRING MIRSTRING = "MIN. PATH"
INT LMIRSTRING = LEN(MIRSTRING)
STRING ARSTRING = "AVG. PATH"
INT LARSTRING = LEN(ARSTRING)
STRING MARSTRING = "MAX. PATH"
INT LMARSTRING = LEN(MARSTRING)

STRING UNSTRING = "UPDATE NUMBER = "
INT LUNSTRING = LEN(UNSTRING)

STRING ETSTRING = "ELAPSED TIME (min.) = "
INT LETSTRING = LEN(ETSTRING)

INT FIRSTCYCLES = 50000

'FOR SUBROUTINE SHOWSTATISTICS() *******************************

'----------------------------------------------------------------------
'END: SUBROUTINE CONSTANTS AND STATIC VARIABLES
'----------------------------------------------------------------------
'START GLOBAL VARIABLES
'----------------------------------------------------------------------

INT        DISTANCEVALUES[NUMDISTANCES + 1]
INT        DISTANCETABLE[NUMCITIES + 1, NUMCITIES + 1]
INT        GENERICPERMUTATIONARRAY1[NUMCITIES]
INT        GENERICPERMUTATIONARRAY2[NUMCITIES]
INT        SYSTEMATICPERMUTATIONARRAY[NUMCITIES + 2]
INT        RANDOMPERMUTATIONARRAY[NUMCITIES + 2]
CHAR       CITYARRAY[MAXCITIES + 1]
CHAR       MINSYSTEMATICPATH[NUMCITIES + 1]
CHAR       MAXSYSTEMATICPATH[NUMCITIES + 1]
CHAR       MINRANDOMPATH[NUMCITIES + 1]
CHAR       MAXRANDOMPATH[NUMCITIES + 1]
INT64      MINSYSTEMATICPATHLENGTH = BIGINT
INT64      MAXSYSTEMATICPATHLENGTH = 0
INT64      AVGSYSTEMATICPATHLENGTH = 0
INT64      MINRANDOMPATHLENGTH = BIGINT
INT64      MAXRANDOMPATHLENGTH = 0
INT64      AVGRANDOMPATHLENGTH = 0
INT64      CURRENTSYSTEMATICPATHLENGTH = 0
INT64      CURRENTRANDOMPATHLENGTH = 0
DOUBLE     CYCLENUMBER = 0
DOUBLE     TOTALSYSTEMATICPATHLENGTH = 0
DOUBLE     TOTALRANDOMPATHLENGTH = 0
INT        TIME
INT        TIME0
DOUBLE     TOTALPERMUTATIONS
INT        TIMEINTERVAL
INT        UPDATENUMBER = 0
FILE       OUTFILE
STRING     BASE19[19]
INT        SOLUTION = PARTIAL

'----------------------------------------------------------------------
'END: GLOBAL VARIABLES
'----------------------------------------------------------------------
'START PROGRAM
'----------------------------------------------------------------------

$MAIN
OPENCONSOLE

PROGRAMINITIALIZATION()
PROGRAMLOOP()
PROGRAMFINISH()

CLOSECONSOLE
END

'----------------------------------------------------------------------
'END PROGRAM
'----------------------------------------------------------------------
'START: SUBROUTINES
'----------------------------------------------------------------------

SUB PROGRAMINITIALIZATION()

GETINITIALTIME()
IF NUMCITIES < 1 THEN END
IF NUMCITIES > MAXCITIES THEN END
SETRAN2SEED(RANDSEED)
SETCITYARRAY()
SETBASE19()
CALCTOTALPERMUTATIONS()
GETRANDOMPERMUTATION(DISTANCEVALUES, NUMDISTANCES)
FILLDISTANCETABLE()
SHOWDISTANCETABLE()
INITIALIZEPERMUTATIONARRAYS()
TIMEINTERVAL = UPDATEINTERVAL
STARTCLOCK()

ENDSUB

'----------------------------------------------------------------------

SUB PROGRAMLOOP()

WHILE TRUE
CYCLENUMBER += 1
TIMEINTERVAL = UPDATEINTERVAL

IF !GETNEXTPERMUTATION(GENERICPERMUTATIONARRAY1, PERMUTATIONLENGTH)
SOLUTION = COMPLETE
RETURN
ENDIF

SETSYSTEMATICPERMUTATIONARRAY()
GETMODIFIEDRANDOMPERMUTATION(GENERICPERMUTATIONARRAY2, PERMUTATIONLENGTH)
SETRANDOMPERMUTATIONARRAY()
CURRENTSYSTEMATICPATHLENGTH = GETPATHLENGTH(SYSTEMATICPERMUTATIONARRAY)
CURRENTRANDOMPATHLENGTH     = GETPATHLENGTH(RANDOMPERMUTATIONARRAY)
CALCULATESTATISTICS()
SHOWSTATISTICS()

IF INKEY$ = CHR$(27) THEN RETURN
WEND

ENDSUB

'----------------------------------------------------------------------

SUB PROGRAMFINISH()

LASTTIME = TRUE
TIMEINTERVAL = 0

'FOR PATHOLOGICAL CASE, OF ONE CITY.
IF NUMCITIES = 1 THEN CALCULATESTATISTICS()

SHOWSTATISTICS()
WRITEOUTFILE()

COLOR 10, 0
LOCATE TABLEBOT + 17, 1
WRITETERMINATIONMESSAGE(SOLUTION)

WHILE TRUE
IF INKEY$ = CHR$(27) THEN GOTO PF
WEND

LABEL PF

ENDSUB

'----------------------------------------------------------------------

SUB CALCULATESTATISTICS()

IF CURRENTSYSTEMATICPATHLENGTH < MINSYSTEMATICPATHLENGTH
MINSYSTEMATICPATHLENGTH = CURRENTSYSTEMATICPATHLENGTH
SETPERMUTATIONPATH(MINSYSTEMATICPATH, SYSTEMATICPERMUTATIONARRAY)
ENDIF

'FOR PATHOLOGICAL CASE, OF ONE CITY,
'USE ">=", INSTEAD OF ">".
IF CURRENTSYSTEMATICPATHLENGTH >= MAXSYSTEMATICPATHLENGTH

MAXSYSTEMATICPATHLENGTH = CURRENTSYSTEMATICPATHLENGTH
SETPERMUTATIONPATH(MAXSYSTEMATICPATH, SYSTEMATICPERMUTATIONARRAY)
ENDIF

IF CURRENTRANDOMPATHLENGTH < MINRANDOMPATHLENGTH
MINRANDOMPATHLENGTH = CURRENTRANDOMPATHLENGTH
SETPERMUTATIONPATH(MINRANDOMPATH, RANDOMPERMUTATIONARRAY)
ENDIF

'FOR PATHOLOGICAL CASE, OF ONE CITY,
'USE ">=", INSTEAD OF ">".
IF CURRENTRANDOMPATHLENGTH >= MAXRANDOMPATHLENGTH

MAXRANDOMPATHLENGTH = CURRENTRANDOMPATHLENGTH
SETPERMUTATIONPATH(MAXRANDOMPATH, RANDOMPERMUTATIONARRAY)
ENDIF

TOTALSYSTEMATICPATHLENGTH += CURRENTSYSTEMATICPATHLENGTH
TOTALRANDOMPATHLENGTH += CURRENTRANDOMPATHLENGTH

AVGSYSTEMATICPATHLENGTH = TOTALSYSTEMATICPATHLENGTH / CYCLENUMBER
AVGRANDOMPATHLENGTH = TOTALRANDOMPATHLENGTH / CYCLENUMBER

ENDSUB

'----------------------------------------------------------------------

SUB CALCTOTALPERMUTATIONS()

TOTALPERMUTATIONS = FACTORIAL(PERMUTATIONLENGTH) / 2

ENDSUB

'----------------------------------------------------------------------

SUB FILLDISTANCETABLE()

INT I, J, K
FOR I = 1 TO NUMCITIES
DISTANCETABLE[I, I] = 0
NEXT I
FOR I = 1 TO PERMUTATIONLENGTH
FOR J =I + 1 TO NUMCITIES
K= (I - 1) * NUMCITIES + J - I * (I + 1) / 2
DISTANCETABLE[I, J] = DISTANCEVALUES[K]
DISTANCETABLE[J, I] = DISTANCEVALUES[K]
NEXT J
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB INITIALIZEPERMUTATIONARRAYS()

'CITY "A"=1, CITY "B"=2, ETC.
'WANT P[0] AND P[NUMCITIES + 1] TO REPRESENT "A",
'BECAUSE EVERY ROUTE STARTS AND ENDS WITH "A".
'FOR INSTANCE, "ADBECFA".
'SO, JUST INITIALIZE ALL ELEMENTS OF P[] TO 1, i.e., "A".

INT I
FOR I = 0 TO NUMCITIES + 1
SYSTEMATICPERMUTATIONARRAY[I] = 1
RANDOMPERMUTATIONARRAY[I] = 1
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB SETSYSTEMATICPERMUTATIONARRAY()

'THIS SUBROUTINE DOES NOT TOUCH P[0] AND P[NUMCITIES + 1],
'WHICH WERE SET TO 1, IN INITIALIZEPERMUTATIONARRAYS().
'THE ADDITION "+1" APPEARS, SO THAT THE PERMUTED CITIES
'BEGIN WITH 2, CORRESPONDING TO CITY "B".

INT I
FOR I = 1 TO PERMUTATIONLENGTH
SYSTEMATICPERMUTATIONARRAY[I] = GENERICPERMUTATIONARRAY1[I] + 1
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB SETRANDOMPERMUTATIONARRAY()

'THIS SUBROUTINE DOES NOT TOUCH P[0] AND P[NUMCITIES + 1],
'WHICH WERE SET TO 1, IN INITIALIZEPERMUTATIONARRAYS().
'THE ADDITION "+1" APPEARS, SO THAT THE PERMUTED CITIES
'BEGIN WITH 2, CORRESPONDING TO CITY "B".

INT I
FOR I = 1 TO PERMUTATIONLENGTH
RANDOMPERMUTATIONARRAY[I] = GENERICPERMUTATIONARRAY2[I] + 1
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB GETPATHLENGTH(P[] AS INT), INT

INT SUM = 0
FOR I = 0 TO PERMUTATIONLENGTH
SUM += DISTANCETABLE[P[I], P[I + 1]]
NEXT I
RETURN SUM

ENDSUB

'----------------------------------------------------------------------

SUB SETPERMUTATIONPATH(PATH[] AS CHAR, P[] AS INT)

'ANSI CODE 65 CORRESPONDS TO "A".

INT I
FOR I = 0 TO NUMCITIES
PATH[I] = P[I] + 64
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB SETCITYARRAY()

'ANSI CODE 65 CORRESPONDS TO "A".

INT I, J
CITYARRAY[0] = CHR$(0)
FOR I = 1 TO MAXCITIES
J = I + 64
CITYARRAY[I] = CHR$(J)
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB GETBASE10REP(INT I), STRING

'THIS FUNCTION IS USED IN THE CONSOLE DISTANCE TABLE,
'WHEN NO DISTANCE IS GREATER THAN 99 (BASE 10).

STRING BASE10REP
I = ABS(I)
IF I > 99
BASE10REP = "XX"
RETURN BASE10REP
ENDIF
BASE10REP = USING("0##", I)
RETURN BASE10REP

ENDSUB

'----------------------------------------------------------------------

SUB GETBASE10REP3(INT I), STRING

'THIS FUNCTION IS USED IN THE OUTFILE.

STRING BASE10REP
I = ABS(I)
IF I > 999
BASE10REP = "XXX"
RETURN BASE10REP
ENDIF
BASE10REP = USING("0###", I)
RETURN BASE10REP

ENDSUB

'----------------------------------------------------------------------

SUB GETBASE19REP(INT I), STRING

'THIS FUNCTION IS USED IN THE CONSOLE DISTANCE TABLE,
'WHEN AT LEAST ONE DISTANCE IS GREATER THAN 99 (BASE 10).

INT DIGIT1, DIGIT2
STRING BASE19REP
I = ABS(I)
IF I > 360
BASE19REP = "XX"
RETURN BASE19REP
ENDIF
DIGIT1 = I / 19
DIGIT2 = I % 19
BASE19REP = APPEND$(BASE19[DIGIT1], BASE19[DIGIT2])
RETURN BASE19REP

ENDSUB

'----------------------------------------------------------------------

SUB SETBASE19()

INT I
FOR I = 0 TO 9
BASE19[I] = CHR$(I + 48)
NEXT I
FOR I = 10 TO 18
BASE19[I] = CHR$(I + 87)
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB GETMODIFIEDRANDOMPERMUTATION(A[] AS INT, INT N)

'THIS SUBROUTINE IS MODIFIED SO THAT NO REVERSE
'OF A NUMERICALLY LOWER PERMUTATION IS RETURNED.
'FOR INSTANCE, IF N EQUALS 3, THEN THE POSSIBLE
'PERMUTATIONS ARE -->
'123
'132
'213
'231
'312
'321.

'321 IS THE REVERSE OF 123.
'312 IS THE REVERSE OF 213.
'231 IS THE REVERSE OF 132.

'123 < 321
'213 < 312
'132 < 231.

'SO, THE SUBROUTINE WOULD ONLY RETURN EITHER
'123, 213, OR 132.

INT I, TEST
FOR I = 1 TO N
A[I] = 0
NEXT I
FOR I = 1 TO N
LABEL GMRP
TEST = IRAN2(1, N)
IF A[TEST] = 0
A[TEST] = I
ELSE
GOTO GMRP
ENDIF
NEXT I
IF A[N] < A[1]
FOR I = 1 TO N / 2
SWAP(A[I], A[N + 1 - I])
NEXT I
ENDIF

ENDSUB

'----------------------------------------------------------------------

SUB GETRANDOMPERMUTATION(A[] AS INT, INT N)

'PUTS A RANDOM PERMUTATION OF THE INTEGERS 1 TO N, IN A[1] TO A[N].

INT I, TEST
FOR I = 1 TO N
A[I] = 0
NEXT I
FOR I = 1 TO N
LABEL GRP
TEST = IRAN2(1, N)
IF A[TEST] = 0
A[TEST] = I
ELSE
GOTO GRP
ENDIF
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB GETNUMSECONDS(), INT

'RETURNS TOTAL NUMBER OF SECONDS, SINCE MIDNIGHT OF CURRENT DAY.

INT TOTSECS = 0
STRING TIMENOW = TIME$
STRING TEMP
TEMP = MID$(TIMENOW, 1, 2)
TOTSECS += VAL(TEMP) * 3600
TEMP = MID$(TIMENOW, 4, 2)
TOTSECS += VAL(TEMP) * 60
TEMP = MID$(TIMENOW, 7, 2)
TOTSECS += VAL(TEMP)
RETURN TOTSECS

ENDSUB

'----------------------------------------------------------------------

SUB TIMEINTERVALDONE(INT SECS), INT

INT NEWTIME = TIMER
INT ELAPSEDTIME = NEWTIME - TIME
IF ELAPSEDTIME < SECS
RETURN FALSE
ELSE
STARTCLOCK()
RETURN TRUE
ENDIF

'THIS STATEMENT NEVER EXECUTES.
'ADDED, SO COMPILER DOESN'T WARN THAT A RETURN VALUE IS EXPECTED.
RETURN TRUE

ENDSUB

'----------------------------------------------------------------------

SUB GETELAPSEDTIME(), INT

'RETURNS ELAPSED MINUTES SINCE PROGRAM BEGAN RUNNING.

INT TIME1 = TIMER
RETURN (TIME1 - TIME0) / 60

ENDSUB

'----------------------------------------------------------------------

SUB GETINITIALTIME()

TIME0 = TIMER

ENDSUB

'----------------------------------------------------------------------

SUB STARTCLOCK()

TIME = TIMER

ENDSUB

'----------------------------------------------------------------------

SUB SETRAN2SEED(INT I)

'FOR A RANDOM SEED, SET I NEGATIVE.

IF I < 0
RAN2SEED = GETNUMSECONDS()
ELSE
RAN2SEED = I
ENDIF

INITIALRAN2SEEDVAL = RAN2SEED
IF INITIALRAN2SEEDVAL = 0 THEN INITIALRAN2SEEDVAL = 1

ENDSUB

'----------------------------------------------------------------------

SUB IRAN2(INT BOT, INT TOP), INT

'RANDOM INT GENERATOR
'BOT <= IRAN2() <= TOP

INT TEMP
IF BOT > TOP
TEMP = BOT
BOT = TOP
TOP = TEMP
ENDIF
INT RANGE = TOP - BOT
RETURN BOT + RANGE * RAN2()

ENDSUB

'----------------------------------------------------------------------

SUB RAN2(), DOUBLE

'RANDOM DOUBLE GENERATOR
'FROM "NUMERICAL RECIPES IN C", 2ND EDITION, P.282.
'0 < RAN2() < 1

DOUBLE AM   = 1.0 / IM1
DOUBLE RNMX = 1.0 - DEPS
INT J, K
DOUBLE TEMP

IF RAN2FLAG = 0
RAN2SEED = ABS(RAN2SEED)
IF RAN2SEED < 1 THEN RAN2SEED = 1
IDUM2 = RAN2SEED
FOR J = NTAB + 7 TO 0 STEP -1
K = RAN2SEED / IQ1
RAN2SEED = IA1 * (RAN2SEED - K * IQ1) - K * IR1
IF RAN2SEED < 0 THEN RAN2SEED += IM1
IF J < NTAB THEN IV[J] = RAN2SEED
NEXT J
IY = IV[0]
RAN2FLAG = 1
ENDIF

K = RAN2SEED / IQ1
RAN2SEED = IA1 * (RAN2SEED - K * IQ1) - K * IR1
IF RAN2SEED < 0 THEN RAN2SEED += IM1
K = IDUM2 / IQ2
IDUM2 = IA2 * (IDUM2 - K * IQ2) - K * IR2
IF IDUM2 < 0 THEN IDUM2 += IM2
J = IY / NDIV
IY = IV[J] - IDUM2
IV[J] = RAN2SEED
IF IY < 1 THEN IY += IMM1
TEMP = AM * IY
IF TEMP > RNMX
RETURN RNMX
ELSE
RETURN TEMP
ENDIF

'THIS STATEMENT NEVER EXECUTES.
'ADDED, SO COMPILER DOESN'T WARN THAT A RETURN VALUE IS EXPECTED.
RETURN 0

ENDSUB

'----------------------------------------------------------------------

SUB GETNEXTPERMUTATION(P[] AS INT, INT N), INT

'RETURNS FALSE, WHEN THERE ARE NO MORE PERMUTATIONS.

INT I, LEFT, RIGHT

'FOR PATHOLOGICAL CASE, OF ONE CITY.
IF N = 0 THEN RETURN FALSE

IF CYCLENUMBER = 1
FOR I = 1 TO N
P[I] = I
NEXT I
RETURN TRUE
ENDIF

LABEL GNP1

RIGHT = N
LEFT = RIGHT

WHILE TRUE
LEFT -= 1

IF LEFT = 0
CYCLENUMBER -= 1
RETURN FALSE
ENDIF

FOR I = N TO LEFT +1 STEP -1
IF P[I] > P[LEFT]
RIGHT = I
GOTO GNP2
ENDIF
NEXT I
WEND

LABEL GNP2
SWAP(P[LEFT], P[RIGHT])
SORT(P, LEFT + 1, N)

'ONLY NEED TO DO HALF THE PERMUTATIONS OF (NUMCITIES - 1)!.
'SO, DO NOT PERMIT REVERSALS OF NUMERICALLY LOWER PERMUTATIONS.
IF P[N] < P[1] THEN GOTO GNP1

RETURN TRUE

ENDSUB

'------------------------------------------------------------

SUB SORT(A[] AS INT, INT INDEX, INT N)

'SORTS VALUES OF A[], FROM A[INDEX]
'TO A[N], IN ASCENDING ORDER.

INT I, J, IMIN, MIN
FOR I = INDEX TO N - 1
MIN = A[I]
IMIN = I
FOR J = I + 1 TO N
IF A[J] < MIN
MIN = A[J]
IMIN = J
ENDIF
NEXT J
SWAP(A[I], A[IMIN])
NEXT I

ENDSUB

'------------------------------------------------------------

SUB SWAP(I AS INT BYREF, J AS INT BYREF)

INT TEMP
TEMP = I
I = J
J = TEMP

ENDSUB

'------------------------------------------------------------

SUB FACTORIAL(INT N), DOUBLE

INT I
DOUBLE PROD = 1
FOR I = 1 TO N
PROD *= I
NEXT I
RETURN PROD

ENDSUB

'------------------------------------------------------------

SUB SHOWDISTANCETABLE()

INT I, J
STRING DISTANCE

COLOR 9, 15

LOCATE 1, 5
PRINT "TRAVELING SALESMAN PROBLEM"

LOCATE 1, 37
COLOR 9, 0
IF NUMCITIES = 1
PRINT "(", NUMCITIES, " city)"
ELSE
PRINT "(", NUMCITIES, " cities)"
ENDIF

COLOR 14, 9

LOCATE 3, 5
PRINT "DISTANCE TABLE"

COLOR 9, 0

IF NUMCITIES > MAXBASE10
LOCATE 3, 24
PRINT "(values shown in Base 19)"
ENDIF

COLOR 10, 0

LOCATE TABLEBOT + 17, 1
PRINT "PRESS 'ESC' TO QUIT, WITH PARTIAL SOLUTION."

COLOR 14, 0

FOR I = 1 TO NUMCITIES
LOCATE 5, 3 * I + 2
PRINT CITYARRAY[I]
NEXT I

FOR I = 1 TO NUMCITIES
LOCATE 5 + 2 * I, 1
PRINT CITYARRAY[I]
NEXT I

FOR I = 1 TO NUMCITIES
FOR J = 1 TO NUMCITIES
COLOR 11, 0
IF NUMCITIES <= MAXBASE10
DISTANCE = GETBASE10REP(DISTANCETABLE[I, J])
ELSE
DISTANCE = GETBASE19REP(DISTANCETABLE[I, J])
ENDIF
LOCATE 5 + 2 * I, 1 + 3 * J
IF I = J THEN COLOR 4, 0
PRINT DISTANCE
NEXT J
NEXT I

LOCATE 1, 1

ENDSUB

'----------------------------------------------------------------------

SUB SHOWSTATISTICS()

INT I, ET
STRING S

IF !LASTTIME
IF CYCLENUMBER < FIRSTCYCLES THEN TIMEINTERVAL = 1
ENDIF

IF TIMEINTERVALDONE(TIMEINTERVAL)
ET = GETELAPSEDTIME()

UPDATENUMBER += 1

LOCATE TABLEBOT + 1, 1
DRAWSEPARATOR(9)

COLOR 9, 0

LOCATE TABLEBOT + 2, 1 + LUNSTRING + 16
PRINT "(S.S. = SYSTEMATIC SEARCH, R.S. = RANDOM SEARCH)"

LOCATE TABLEBOT + 2, 1
PRINT UNSTRING

LOCATE TABLEBOT + 4, 1
PRINT ETSTRING

LOCATE TABLEBOT + 6, 1
PRINT CPSTRING

LOCATE TABLEBOT + 8, 1
PRINT TPSTRING

LOCATE TABLEBOT + 10, 2 + LSSSTRING
PRINT MIRSTRING
LOCATE TABLEBOT + 10, 2 + LSSSTRING + 33
PRINT ARSTRING
LOCATE TABLEBOT + 10, 2 + LSSSTRING + 33 + LARSTRING + 1
PRINT MARSTRING

LOCATE TABLEBOT + 12, 1
PRINT SSSTRING
LOCATE TABLEBOT + 14, 1
PRINT RSSTRING

COLOR 12, 0

LOCATE TABLEBOT + 2, 1 + LUNSTRING
PRINT UPDATENUMBER

LOCATE TABLEBOT + 4, 1 + LETSTRING
PRINT ET

LOCATE TABLEBOT + 6, LCPSTRING + 1
S = USING("%d##########################", CYCLENUMBER)
PRINT S

LOCATE TABLEBOT + 8, LTPSTRING + 1
S = USING("%d##########################", TOTALPERMUTATIONS)
PRINT S

LOCATE TABLEBOT + 12, 2 + LSSSTRING
PRINT MINSYSTEMATICPATHLENGTH
LOCATE TABLEBOT + 12, 2 + LSSSTRING + 33
PRINT AVGSYSTEMATICPATHLENGTH
LOCATE TABLEBOT + 12, 2 + LSSSTRING + 33 + LARSTRING + 1
PRINT MAXSYSTEMATICPATHLENGTH

LOCATE TABLEBOT + 14, 2 + LSSSTRING
PRINT MINRANDOMPATHLENGTH
LOCATE TABLEBOT + 14, 2 + LSSSTRING + 33
PRINT AVGRANDOMPATHLENGTH
LOCATE TABLEBOT + 14, 2 + LSSSTRING + 33 + LARSTRING + 1
PRINT MAXRANDOMPATHLENGTH

LOCATE TABLEBOT + 15, 1
DRAWSEPARATOR(9)

IF TIMEINTERVAL = 0
COLOR 13, 0

LOCATE TABLEBOT + 12, 2 + LSSSTRING + 5
FOR I = 0 TO NUMCITIES
PRINT MINSYSTEMATICPATH[I],
NEXT I

LOCATE TABLEBOT + 12, 2 + LSSSTRING + 33 + LARSTRING + 1 + 5
FOR I = 0 TO NUMCITIES
PRINT MAXSYSTEMATICPATH[I],
NEXT I

LOCATE TABLEBOT + 14, 2 + LSSSTRING + 5
FOR I = 0 TO NUMCITIES
PRINT MINRANDOMPATH[I],
NEXT I

LOCATE TABLEBOT + 14, 2 + LSSSTRING + 33 + LARSTRING + 1 + 5
FOR I = 0 TO NUMCITIES
PRINT MAXRANDOMPATH[I],
NEXT I
ENDIF

LOCATE 1, 1

ENDIF

ENDSUB

'----------------------------------------------------------------------

SUB DRAWSEPARATOR(INT C)

INT I
COLOR C, 0
FOR I = 1 TO 80
PRINT "-",
NEXT I

ENDSUB

'----------------------------------------------------------------------

SUB WRITEOUTFILE()
INT I, J, ET
STRING S, S1, S2
STRING B0 = ""
STRING B1 = " "
STRING B3 = "   "
STRING B6 = "      "
STRING POINT = ", -->  "
STRING TABLE[NUMCITIES + 1]

STRING ESR  = "(EXACT SHORTEST ROUTE)"
STRING EARL = "(EXACT AVERAGE ROUTE LENGTH)"
STRING ELR  = "(EXACT LONGEST ROUTE)"
STRING SRF  = "(SHORTEST ROUTE FOUND)"
STRING ARLF = "(AVERAGE ROUTE LENGTH FOUND)"
STRING LRF  = "(LONGEST ROUTE FOUND)"

STRING SSSR = ESR
STRING SSAR = EARL
STRING SSLR = ELR
STRING RSSR = SRF
STRING RSAR = ARLF
STRING RSLR = LRF

IF SOLUTION = PARTIAL
SSSR = SRF
SSAR = ARLF
SSLR = LRF
ENDIF

OPENFILE(OUTFILE, FILESTRING, "W")

S = APPEND$("DATE = ", DATE$("ddd', 'yyyy'-'MM'-'dd"))
WRITE OUTFILE, S
S = APPEND$("TIME = ", TIME$)
WRITE OUTFILE, S
WRITE OUTFILE, B0

S = APPEND$("NUMCITIES   = ", STR$(NUMCITIES))
WRITE OUTFILE, S
S = APPEND$("RANDOM SEED = ", STR$(INITIALRAN2SEEDVAL))
WRITE OUTFILE, S
WRITE OUTFILE, B0
WRITE OUTFILE, B0

S = "DISTANCE TABLE"
WRITE OUTFILE, S
WRITE OUTFILE, B0

S = B0
S = APPEND$(S, B1)
FOR I = 1 TO NUMCITIES
S = APPEND$(S, B3, CHR$(I + 64))
NEXT I
WRITE OUTFILE, S

FOR I = 1 TO NUMCITIES
TABLE[I] = CHR$(I + 64)
FOR J = 1 TO NUMCITIES
TABLE[I] = APPEND$(TABLE[I], B1, GETBASE10REP3(DISTANCETABLE[I, J]))
NEXT J
NEXT I

FOR I = 1 TO NUMCITIES
WRITE OUTFILE, TABLE[I]
NEXT I
WRITE OUTFILE, B0
WRITE OUTFILE, B0

S = B0
ET = GETELAPSEDTIME()
S = APPEND$(S, ETSTRING, STR$(ET))
WRITE OUTFILE, S
WRITE OUTFILE, B0

S = "SYSTEMATIC PERMUTATIONS COMPLETED = "
S1 = USING("%d##########################", CYCLENUMBER)
S = APPEND$(S, S1)
WRITE OUTFILE, S
S = "TOTAL SYSTEMATIC PERMUTATIONS     = "
S1 = USING("%d##########################", TOTALPERMUTATIONS)
S = APPEND$(S, S1)
WRITE OUTFILE, S
WRITE OUTFILE, B0
WRITE OUTFILE, B0

S = "SOLUTION = "
IF SOLUTION = COMPLETE
S1 = "COMPLETE"
ELSE
S1 = "PARTIAL"
ENDIF
S = APPEND$(S, S1)
WRITE OUTFILE, S
WRITE OUTFILE, B0
WRITE OUTFILE, B0

S = "SYSTEMATIC SEARCH"
WRITE OUTFILE, S
WRITE OUTFILE, B0

S ="MINIMUM ROUTE = "
S1 = USING("%q####", MINSYSTEMATICPATHLENGTH)
S2 = B0
FOR I = 0 TO NUMCITIES
S2 = APPEND$(S2, CHR$(MINSYSTEMATICPATH[I]))
NEXT I

S = APPEND$(S, S1, POINT, S2, B1, SSSR)
WRITE OUTFILE, S

S = "AVERAGE ROUTE = "
S1 = USING("%q####", AVGSYSTEMATICPATHLENGTH)
S = APPEND$(S, S1, B6, SSAR)
WRITE OUTFILE, S

S ="MAXIMUM ROUTE = "
S1 = USING("%q####", MAXSYSTEMATICPATHLENGTH)
S2 = B0
FOR I = 0 TO NUMCITIES
S2 = APPEND$(S2, CHR$(MAXSYSTEMATICPATH[I]))
NEXT I

S = APPEND$(S, S1, POINT, S2, B1, SSLR)
WRITE OUTFILE, S

WRITE OUTFILE, B0
WRITE OUTFILE, B0

S = "RANDOM SEARCH"
WRITE OUTFILE, S
WRITE OUTFILE, B0

S ="MINIMUM ROUTE = "
S1 = USING("%q####", MINRANDOMPATHLENGTH)
S2 = B0
FOR I = 0 TO NUMCITIES
S2 = APPEND$(S2, CHR$(MINRANDOMPATH[I]))
NEXT I

S = APPEND$(S, S1, POINT, S2, B1, RSSR)
WRITE OUTFILE, S

S = "AVERAGE ROUTE = "
S1 = USING("%q####", AVGRANDOMPATHLENGTH)
S = APPEND$(S, S1, B6, RSAR)
WRITE OUTFILE, S

S ="MAXIMUM ROUTE = "
S1 = USING("%q####", MAXRANDOMPATHLENGTH)
S2 = B0
FOR I = 0 TO NUMCITIES
S2 = APPEND$(S2, CHR$(MAXRANDOMPATH[I]))
NEXT I

S = APPEND$(S, S1, POINT, S2, B1, RSLR)
WRITE OUTFILE, S

CLOSEFILE(OUTFILE)

ENDSUB

'----------------------------------------------------------------------

SUB WRITETERMINATIONMESSAGE(INT I)

STRING SPACES = "                  "
IF I = COMPLETE
PRINT "PROGRAM EXECUTION FINISHED.", SPACES
PRINT "COMPLETE SOLUTION DETERMINED."
ELSE
PRINT "PROGRAM EXECUTION HALTED.", SPACES
PRINT "PARTIAL SOLUTION DETERMINED."
ENDIF
PRINT
PRINT "PRESS 'ESC' TO QUIT."

ENDSUB

'----------------------------------------------------------------------
'END: SUBROUTINES
'----------------------------------------------------------------------


[tbohon]

Dan:

What a great, clear, concise explanation of this classic Operations Research problem.  And the solution is quite elegant as well.

Thank you!!!

Tom

[danbaron]

Thank you very  much  Tom.
I will try to remain calm.
Your  words  are  a  balm.
Like a rest 'neath a palm..

Dan.