DECLARE SUB ImproveBest (BP!(), P!())
DECLARE SUB GetNextPermutation (n!, P!())
'                                                     N V Fitton
'                                                     Applied Probability
'                                                     Math 577 or so
'                                                     Univ Cincinnati
'                                                     February 1, 1996
' SALEMAN2.bas  (modified Feb 2, 1996 by W Bryc
' blind search for best traveling-salesman circuit
' through N cities

' Interesting aspects of this program:
'   permutations-generating function
'   screen controls

' subroutines
DECLARE SUB IntroAndInitialize (n)
DECLARE SUB GetCitiesAndDistances (n, x!(), y!(), d!())
DECLARE SUB CalculateDistance (n, Perm!(), d!(), nd!)
DECLARE SUB GetNewPermutation (n!, alpha!(), disp!(), Perm!(), posi!())
DECLARE SUB ReportDistanceEtc (newDistance!, bestSoFar!, runs!, totalSoFar())
DECLARE SUB ConnectDots (n, Perm!(), x!(), y!())

'on general principles
CLEAR

' how many cities?
CONST n = 8
' A constant to switch between various methods
DIM SHARED BruteForce
BruteForce = -1

' arrays used for permutation: p = d(a)
'DIM alpha(N) 'unchanging 1, 2, ..., 25 (not needed)

DIM Perm(n) 'permutation of 1, 2, ..., 25
DIM BestBlind(n)
FOR j = 1 TO n: BestBlind(j) = j: NEXT j
' x,y coords for 25 cities
REDIM x(n), y(n)
' distances between cities
DIM d(n, n), totalSoFar(1)

CALL IntroAndInitialize(n)

CALL GetCitiesAndDistances(n, x(), y(), d())

bestSoFar = 999999
TopBrute = bestSoFar
TopBlind = bestSoFar
totalSoFar = 0
runs = 0

DO
   runs = runs + 1
BruteForce = NOT BruteForce
IF BruteForce THEN
        bestSoFar = TopBrute
        CALL GetNextPermutation(n, Perm())
ELSE
        bestSoFar = TopBlind
        CALL ImproveBest(BestBlind(), Perm())
END IF
   CALL CalculateDistance(n, Perm(), d(), newDistance)
   totalSoFar(-BruteForce) = totalSoFar(-BruteForce) + newDistance
   IF newDistance < bestSoFar THEN
      bestSoFar = newDistance
      IF BruteForce THEN TopBrute = bestSoFar:  ELSE TopBlind = bestSoFar: SWAP Perm, BestBlind
      CALL ConnectDots(n, Perm(), x(), y())
   END IF
   CALL ReportDistanceEtc(newDistance, bestSoFar, runs, totalSoFar())

' keep going until user hits escape
LOOP UNTIL INKEY$ = CHR$(27)

END

' nv.fitton@uc.edu

SUB CalculateDistance (n, P(), d(), nd)
' find distance between each pair of cities in new permutation
' and get sum

nd = 0

FOR i = 1 TO (n - 1)
   nd = nd + d(P(i), P(i + 1))
NEXT i

'don't forget to go home!
nd = nd + d(P(n), P(1))

END SUB

SUB ConnectDots (n, Perm(), x(), y())

'clear graphics box
 'every other time ?


IF BruteForce THEN col = 4 ELSE XOffset = 550: col = 7
'CLEAR SCREEN
LINE (XOffset, 0)-(XOffset + 550, 350), 0, BF
LINE (XOffset, 0)-(XOffset + 550, 350), 1, B
FOR i = 1 TO (n - 1)
   p1 = Perm(i)
   p2 = Perm(i + 1)
   LINE (x(p1) + XOffset, y(p1))-(XOffset + x(p2), y(p2)), col
NEXT i

p1 = Perm(n)
p2 = Perm(1)
LINE (x(p1) + XOffset, y(p1))-(XOffset + x(p2), y(p2)), col

'draw a little box for each city (a point is too small)
FOR i = 1 TO n
   'LINE (x(i) - 1, y(i) - 1)-(x(i) + 1, y(i) + 1), , BF
   CIRCLE (x(i), y(i)), 5, 2
   CIRCLE (x(i) + 550, y(i)), 5, 2
NEXT i

END SUB

SUB GetCitiesAndDistances (n, x(), y(), di())
' fill arrays with xy coordinates of "cities"
' display them for the user's approval
' then calculate distances in usual fashion

' loop until user likes cities layout
DO
'choose cities
FOR i = 1 TO n
   x(i) = RND(1) * 500 + 1
   y(i) = RND(1) * 350 + 1
NEXT i
'clear graphics box
LINE (0, 0)-(550, 350), 0, BF
LINE (0, 0)-(550, 350), 1, B
'draw a little box for each city (a point is too small)
FOR i = 1 TO n
   LINE (x(i) - 1, y(i) - 1)-(x(i) + 1, y(i) + 1), , BF
' following lines draw tiny diamond instead of box
'   PSET (x(i) - 1, y(i))
'   PSET (x(i), y(i))
'   PSET (x(i) + 1, y(i))
'   PSET (x(i), y(i) - 1)
'   PSET (x(i), y(i) + 1)
NEXT i
' talk to user
LOCATE 22, 1: PRINT
LOCATE 22, 4
INPUT "Do you like these"; yn$
LOOP UNTIL LCASE$(yn$) = "y"
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 25, 4: PRINT "      Hit escape when you've had enough."

' calculate distances
FOR i = 1 TO (n - 1)
   FOR j = (i + 1) TO n
      distance = SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2)
      ' round to nearest integer
      distance = INT(distance + .5)
      di(i, j) = distance
      di(j, i) = distance
   NEXT j
NEXT i
'clear print area
FOR j = 1 TO 5
PRINT
NEXT j
'test result of distance calculations
'VIEW PRINT 1 TO 30
'LOCATE 1, 1
'FOR i = 1 TO N
'FOR j = 1 TO N
'PRINT USING " ##"; INT((di(i, j) + 5) / 10);
'NEXT j
'PRINT
'NEXT i

END SUB

SUB GetNextPermutation (n, P())
'Go over all permuatations!!!!

' generate a "displacement" to be used in Munro's function
'initialize two arrays
DIM a(n)
STATIC d() 'remember this
STATIC f, h
FOR i = 1 TO n
   a(i) = i
NEXT i

IF f = 0 THEN GOSUB FirstTime

'compute permutations
h = h + 1
IF h > f THEN
FOR j = 1 TO 2: PRINT : NEXT j
BEEP: PRINT "All permatations checked": END
END IF
   'position array
   REDIM po(25)
   FOR i = 1 TO n: po(i) = i: NEXT i
      
   'generate displacement
   i = n - 1
   WHILE ((d(i) = n - i) AND (i <> 0))
      d(i) = 0
      i = i - 1
   WEND
   IF i > 0 THEN
      d(i) = d(i) + 1
   END IF
      
   'generate new perm
   FOR i = 1 TO n
      w = d(i) + 1
    
      'find w-th unfilled position
      ww = 0
      FOR k = 1 TO w
         DO
            ww = ww + 1
            IF po(ww) <> (-1) THEN
               EXIT DO
            END IF
         LOOP
      NEXT k
    
      'fill it and mark it used
      P(ww) = a(i)
      po(ww) = -1
   NEXT i

EXIT SUB

FirstTime:
'compute factorial for number of permutations

f = 1
DIM d(n)
FOR i = n TO 1 STEP (-1)
   f = f * i
NEXT i

RETURN

END SUB

SUB ImproveBest (BP(), P())
'randomly improve best
'Modify bestPath BP() at some number of random locations
'n = UBOUND(P)
'choose random number of changes
k = INT((RND(1) * n) + 1)

'copy BP() over P()
FOR j = 1 TO n
        P(j) = BP(j)
NEXT j

'make random changes
FOR tr = 1 TO k
        i = INT(RND(1) * n + 1)
        j = INT(RND(1) * n + 1)
        SWAP P(i), P(j)
NEXT tr

END SUB

SUB IntroAndInitialize (n)
' print program's introduction to screen
CLS
LOCATE 5, 1
PRINT "  This program does a traveling salesman's circuit around"
PRINT "  "; n; "abstract cities on the screen."
PRINT "  You will be shown"; n; "dots.  If you don't like them,"
PRINT "  hit return and you'll get"; n; "more."
PRINT "  Enter the letter Y and return when you like the layout,"
PRINT "  and the program will proceed."
PRINT : PRINT "  You can change the number of cities by changing"
PRINT "  the value of constant N near the top of the program."
PRINT : PRINT "  Hit any key to continue..."
DO
LOOP UNTIL INKEY$ > ""

' initialize the array that is permuted
'RANDOMIZE TIMER (commented out for tests)

'set up VGA screen for graphics:
'  make a box for drawing (500h x 350v pixels)
'  and a box for text
CLS
SCREEN 9
WINDOW (0, 0)-(1100, 350)
VIEW (70, 20)-(600, 220), , 1
'LINE (0, 0)-(550, 350), 15, BF
VIEW PRINT 20 TO 25

END SUB

SUB ReportDistanceEtc (newDistance, bestSoFar, runs, totalSoFar())
COLOR 7 + 3 * BruteForce
P$ = "(Blind)"
IF BruteForce THEN P$ = "(Brute)"
LOCATE 21 + BruteForce, 5
PRINT P$; USING " Best so far is  #,###"; bestSoFar;
LOCATE 21 + BruteForce, 50
PRINT USING "  Mean so far is #,###"; (2 * totalSoFar(-BruteForce) / runs);
LOCATE 24 + BruteForce, 50
PRINT USING "         runs: ###,###"; runs;
LOCATE 24 + BruteForce, 5
PRINT USING "     Total this run: #,###"; newDistance;

END SUB