'===========================================================================
' Subject: MERGE SORT DEMO                   Date: 03-22-00 (17:44)       
' Author:  David O. Williams                 Code: QB, QBasic, PDS        
' Origin:  david.williams@ablelink.org     Packet: ALGOR.ABC
'===========================================================================
'  merge sort demo

'  David O. Williams.   2000
'  Public domain. No price. No guarantee. But it does seem to work!
'  E-mail: david.williams@ablelink.org

'  The program demonstrates a sorting routine that is very fast,
'  especially when dealing with data that are initially in random
'  order. The program generates a lot of random strings, then
'  sorts them, measuring the time that the sort takes. It is fast!

'  The sorting subroutines can easily be modified to sort numbers,
'  or to perform sorts on disk data, instead of arrays in memory.

DEFINT A-Z

DECLARE SUB Mersort (A$(), M, N)
DECLARE SUB MSrt (A$(), T$(), M, N)

N = 2000  'number of items

DIM A$(1 TO N)
RANDOMIZE TIMER
WIDTH 80
CLS

PRINT "Generating"; N; "random strings:"
FOR X = 1 TO N
   A$(X) = ""
   FOR Y = 1 TO 3
      A$(X) = A$(X) + CHR$(INT(26 * RND) + 65)
   NEXT Y
   PRINT A$(X) + " ";
NEXT X
PRINT

PRINT
PRINT "Sorting"
T! = TIMER
CALL Mersort(A$(), 1, N)
T! = TIMER - T!
IF T! < 0 THEN T! = T! + 86400

PRINT
PRINT "Sorted list of"; N; "strings:"
FOR X = 1 TO N
   PRINT A$(X) + " ";
NEXT X
PRINT

PRINT
PRINT "Time taken to sort"; N; "initially random strings:"; T!; "seconds"

END

SUB Mersort (A$(), M, N)
  'sorts from element M to element N of array A$()
  DIM T$((N - M) \ 2)
  CALL MSrt(A$(), T$(), M, N)
END SUB

SUB MSrt (A$(), T$(), M, N)
   IF M < N THEN
      Q = (M + N) \ 2 + 1
      CALL MSrt(A$(), T$(), M, Q - 1)
      CALL MSrt(A$(), T$(), Q, N)
      P = M
      FOR X = 0 TO Q - P - 1
         SWAP A$(P + X), T$(X)
      NEXT X
      X = Q - P
      R = 0
      Y = N + 1
      DO WHILE Q < Y AND R < X
         IF A$(Q) < T$(R) THEN
            SWAP A$(Q), A$(P)
            Q = Q + 1
         ELSE
            SWAP T$(R), A$(P)
            R = R + 1
         END IF
         P = P + 1
      LOOP
      DO WHILE R < X
         SWAP T$(R), A$(P)
         P = P + 1
         R = R + 1
      LOOP
   END IF
END SUB