REM Sort algorithm timings. v1.1a PD 2001.

' declare all subroutines
DECLARE SUB BubbleSort ()
DECLARE SUB ExchangeSort ()
DECLARE SUB InsertionSort ()
DECLARE SUB ShellSort ()
DECLARE SUB QuickSort (L%, H%)
DECLARE SUB HeapSort ()

DEFINT A-Z ' fastest using integers
COMMON SHARED SortArray() AS INTEGER
COMMON SHARED Num AS INTEGER, Qexit AS INTEGER
CONST ShowArray = 0 ' change to display sorted array

' display header
COLOR 15, 0
PRINT "Sorttest v1.1a: Sort algorithm timings."

' check command line
IF LEN(Command$) THEN
   Num = INT(VAL(Command$))
   IF Num >= 128 AND Num <= 32766 THEN
      GOTO Start.Sort
   END IF
   GOTO Boot.Usage
END IF

' prompt for elements
PRINT "Elements(128-32766)";
INPUT Num
IF Num >= 128 AND Num <= 32766 THEN
   GOTO Start.Sort
ELSE
   GOTO Boot.Usage
END IF

' start sorting
Start.Sort:

' assign array
REDIM SortArray(1 TO Num) AS INTEGER

' display subheader
PRINT "Sorting"; Num; "Elements:"
PRINT "Press <esc> to interrupt."
COLOR 14, 0

' loop through 6 algorithms
FOR SortNum = 1 TO 6

   ' store array
   FOR Element = 1 TO Num
      SortArray(Element) = INT(RND * Num + 1)
   NEXT

   ' start timer
   StartTime! = TIMER

   ' start sort timing in order of slowest to fastest
   SELECT CASE SortNum
   CASE 1
      PRINT "Bubble Sort: ";
      CALL BubbleSort
   CASE 2
      PRINT "Exchange Sort: ";
      CALL ExchangeSort
   CASE 3
      PRINT "Insertion Sort: ";
      CALL InsertionSort
   CASE 4
      PRINT "Shell Sort: ";
      CALL ShellSort
   CASE 5
      PRINT "Quick Sort: ";
      CALL QuickSort(1, Num)
   CASE 6
      PRINT "Heap Sort: ";
      CALL HeapSort
   END SELECT

   ' calculate elapsed time
   ElapsedTime! = TIMER - StartTime!
   IF ElapsedTime! < 0! THEN
      ElapsedTime! = ElapsedTime! + 86400! ' adjust for midnight
   END IF

   ' display time elapsed
   PRINT "Time elapsed =";
   IF ElapsedTime! <= 0! THEN
      PRINT " (unmeasurable)."
   ELSE
      PRINT ElapsedTime!; "seconds."
   END IF

   ' check showarray variable
   IF ShowArray THEN
      PRINT "Sorted array:"

      ' display sorted array
      FOR Element = 1 TO Num
         PRINT SortArray(Element);
      NEXT
      PRINT
   END IF
NEXT
COLOR 7, 0 ' exit program
PRINT "Exiting to system:"
END ' Thank you! Can I have my cookie now!?

' display usage
Boot.Usage:
 COLOR 15, 0
 PRINT "Boot usage:"
 COLOR 14, 0
 PRINT "Enter elements between 128 and 32766"
 PRINT "at command line or input prompt."
 COLOR 7, 0
 PRINT "Exiting to system:"
 END

SUB BubbleSort
   FOR L = 1 TO Num
      FOR M = L + 1 TO Num
         IF INKEY$ = CHR$(27) THEN EXIT SUB
         IF SortArray(L) > SortArray(M) THEN
            SWAP SortArray(L), SortArray(M)
         END IF
      NEXT
   NEXT
END SUB

SUB ExchangeSort
   FOR R = 1 TO Num
      S = R
      FOR J = R + 1 TO Num
         IF INKEY$ = CHR$(27) THEN EXIT SUB
         IF SortArray(J) < SortArray(S) THEN
            S = J
         END IF
      NEXT
      IF S > R THEN
         SWAP SortArray(R), SortArray(S)
      END IF
   NEXT
END SUB

SUB InsertionSort
   FOR R = 2 TO Num
      T = SortArray(R)
      FOR J = R TO 2 STEP -1
         IF INKEY$ = CHR$(27) THEN EXIT SUB
         IF SortArray(J - 1) > T THEN
            SortArray(J) = SortArray(J - 1)
         ELSE
            EXIT FOR
         END IF
      NEXT
      SortArray(J) = T
   NEXT
END SUB

SUB ShellSort
   S = INT(Num / 2)
   DO WHILE S > 0
      FOR T = S TO Num - 1
         FOR E = (T - S + 1) TO 1 STEP -S
            IF INKEY$ = CHR$(27) THEN EXIT SUB
            IF SortArray(E) <= SortArray(E + S) THEN
               EXIT FOR
            END IF
            SWAP SortArray(E), SortArray(E + S)
         NEXT
      NEXT
      S = INT(S / 2)
   LOOP
END SUB

SUB QuickSort (L, H)
   IF Qexit THEN ' recursively exit QuickSort
      EXIT SUB
   END IF
   IF L < H THEN
      IF H - L = 1 THEN
         IF SortArray(L) > SortArray(H) THEN
            SWAP SortArray(L), SortArray(H)
         END IF
      ELSE
         R = INT(RND * (H - L + 1)) + L
         SWAP SortArray(H), SortArray(R)
         P = SortArray(H)
         DO
            IF INKEY$ = CHR$(27) THEN Qexit = -1: EXIT SUB
            I = L
            J = H
            DO WHILE (I < J) AND (SortArray(I) <= P)
               I = I + 1
            LOOP
            DO WHILE (J > I) AND (SortArray(J) >= P)
               J = J - 1
            LOOP
            IF I < J THEN
               SWAP SortArray(I), SortArray(J)
            END IF
         LOOP WHILE I < J
         SWAP SortArray(I), SortArray(H)
         IF (I - L) < (H - I) THEN
            CALL QuickSort(L, I - 1)
            CALL QuickSort(I + 1, H)
         ELSE
            CALL QuickSort(I + 1, H)
            CALL QuickSort(L, I - 1)
         END IF
      END IF
   END IF
END SUB

SUB HeapSort
   FOR I = 2 TO Num
      J = I
      DO UNTIL J = 1
         P = J \ 2
         IF SortArray(J) > SortArray(P) THEN
            SWAP SortArray(P), SortArray(J)
            J = P
         ELSE
            EXIT DO
         END IF
      LOOP
   NEXT
   FOR I = Num TO 2 STEP -1
      SWAP SortArray(1), SortArray(I)
      J = 1
      DO
         IF INKEY$ = CHR$(27) THEN EXIT SUB
         ' test 2*J is safe to use as integer
         IF 2! * CSNG(J) > CSNG(I) - 1! THEN
            EXIT DO
         END IF
         C = 2 * J
         IF C + 1 <= I - 1 THEN
            IF SortArray(C + 1) > SortArray(C) THEN
               C = C + 1
            END IF
         END IF
         IF SortArray(J) < SortArray(C) THEN
            SWAP SortArray(J), SortArray(C)
            J = C
         ELSE
            EXIT DO
         END IF
      LOOP
   NEXT
END SUB
