DECLARE SUB Search.Demo (N%, X%())
DEFINT A-Z
' Program to animate various sorting algorithms

' Author:  Tim Rolfe

' Animation can be paused in real-time and the speed of the animation
' can also be altered as the program runs:

'    The ESCAPE key is trapped by the Pause subprogram, which then
'    waits for a key press to resume execution.

'    The F1 key is enabled across the entire program --- when it is
'    pressed, the program asks for a new delay loop limit.

' ----- Miscellaneous driver routines

DECLARE SUB Fill (A%(), N%)                   ' Fill array with data
DECLARE SUB Copy (A%(), B%(), N%)             ' Copy one array to another
DECLARE FUNCTION Run.Opt ()                   ' Menu to select start point

' ----- Sorting subprograms (and function) -----

DECLARE SUB Bubble (N%, X%())                 ' Standard bubble sort
DECLARE SUB Shaker (N%, X%())                 ' Alt. direction bubble
DECLARE SUB SelSort (N%, X%())                ' Selection sort
DECLARE SUB InSort (N%, X%(), H%)             ' Insertion sort, step h
DECLARE SUB ShellSort (N%, X%())              ' Shell's opt. of InSort
DECLARE SUB HeapSort (N%, X%())               ' Heap sort, which uses:
DECLARE SUB DownHeap (Top%, Bot%, X%())       ' Regen. heap from Top to Bot
DECLARE SUB Qsort (Lo%, Hi%, X%())            ' Standard QuickSort
DECLARE FUNCTION Partition% (Lo%, Hi%, X%())  ' WITH animation calls
DECLARE SUB MsortR (Lo%, Hi%, X%())           ' Recursive merge sort
DECLARE SUB MsortI (N%, X%())                 ' Iterative merge sort
DECLARE SUB MsortN (N%, X%())                 ' "Natural" merge sort
DECLARE SUB Merge (Lo%, Mid%, Hi%, X%())      ' Merge used by above
DECLARE SUB BinSort (N%, X%())                ' Bin sort --- radix 2

' ----- Statistics of the sort, and comparison-counter -----

DECLARE SUB Stats ()                          ' Report compares, moves, swaps
DECLARE FUNCTION Compare% (X%(), Lt%, Rt%)    ' Compare AND count N compares

' ----- Animation subprograms -----

DECLARE SUB Init.Screen (X%(), N%, S$)        ' Display initial state
DECLARE SUB Pause ()                          ' Slow down the animation
DECLARE SUB SwapIt (P1%, V1%, P2%, V2%)       ' Animate swapping two cells
DECLARE SUB ToHold (Idx%, Value%, Txt$)       ' Move value TO hold area
DECLARE SUB MoveIt (Start%, Value%, Finish%)  ' Move value within array
DECLARE SUB FromHold (Psn%, Value%)           ' Move value FROM hold area
DECLARE SUB Flag (Idx%, Txt$)                 ' Attach a flag to a cell
DECLARE SUB UnFlag (Idx%, Blk$)               ' Remove such a flag
DECLARE SUB Clear.Pts (Lo%, Hi%, X%())        ' Clear a range of points
DECLARE SUB Update (Lo%, Hi%, X%())           ' Update a range of cells

DECLARE FUNCTION BinSrch% (V%, N%, X%())
DECLARE FUNCTION LinSrch% (V%, N%, X%())

DEFINT A-Z

COMMON SHARED Bottom.Position, Col.Adjust!, N.Swaps, N.Moves, N.Compares

' Note:  DATA and READ statements are here because they are illegal
'        in subprograms.  The data, though, are used in the Init.Screen
' subprogram (for the boxes containing the numbers).

CLS
LOCATE 9, 20
INPUT "How large an array?  Default -- 26  ", N.Elements
IF N.Elements <= 0 OR N.Elements > 26 THEN N.Elements = 26
LOCATE 9, 39
PRINT N.Elements; SPACE$(20);
DIM X(0 TO N.Elements), Hold(N.Elements)

LOCATE 12, 10
INPUT "Delay loop iteration count (0 for manual):  ", Loop.Lim&
IF Loop.Lim& = 0 THEN
   LOCATE , 10
   PRINT "Touch any key to single step --- CTRL works fine"
   LOCATE , 10
   PRINT "Hold the key down to move more quickly."
END IF
LOCATE 16, 10
PRINT "Touch the ESCAPE key to pause the simulation,"
LOCATE , 10
PRINT "then any key after that resumes it"
PRINT
LOCATE , 10
PRINT "Touch F1 to change the delay loop during a run."
ON KEY(1) GOSUB New.Loop.Lim
KEY(1) ON
PRINT
'WIDTH [columns%] [,rows%]

'    þ columns%        The desired width in columns. Screen display width
'                      must be 40 or 80 columns.
'    þ rows%           The desired screen-display height in rows. The value
'                      can be 25, 30, 43, 50, or 60, depending on your
'                      display adapter and screen mode.
LOCATE , 10
INPUT "Number of rows (25, 43, or 50)?  Default -- 25:  ", Bottom.Position
IF Bottom.Position = 0 THEN Bottom.Position = 25
Col.Adjust! = (Bottom.Position - 13) / 100

CALL Fill(Hold(), N.Elements)

Opt = Run.Opt

WIDTH 80, Bottom.Position
Bottom.Position = Bottom.Position - 1

'  Think of the following as a C swith statement . . .
ON Opt GOTO Bubble.Sort, Select.Sort, Shell.Sort, Heap.Sort, Quick.Sort, Merge.Sort, Radix.Sort

Bubble.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Bubble Sort")
CALL Bubble(N.Elements, X())
CALL Stats

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Cocktail Shaker Sort")
CALL Shaker(N.Elements, X())
CALL Stats

Select.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Select Sort")
CALL SelSort(N.Elements, X())
CALL Stats

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Insert Sort")
CALL InSort(N.Elements, X(), 1)
CALL Stats

Shell.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Shell's Sort")
CALL ShellSort(N.Elements, X())
CALL Stats

Heap.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Heap Sort")
CALL HeapSort(N.Elements, X())
CALL Stats

Quick.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Quick Sort")
CALL Qsort(1, (N.Elements), X())   ' I.e., pass by VALUE
CALL Stats

Merge.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Recursive Merge Sort")
CALL MsortR(1, N.Elements, X())
CALL Stats

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Iterative Merge Sort")
CALL MsortI(N.Elements, X())
CALL Stats

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, " Natural  Merge Sort")
CALL MsortN(N.Elements, X())
CALL Stats

Radix.Sort:

CALL Copy(X(), Hold(), N.Elements)
CALL Init.Screen(X(), N.Elements, "Radix (Bin) Sort")
LOCATE 3, 1
PRINT "Press <Enter> for each screenful."
Hold.Lim& = Loop.Lim&
Loop.Lim& = 0
CALL BinSort(N.Elements, X())
CALL Stats
Loop.Lim& = Hold.Lim&

CALL Search.Demo(N.Elements, X())
END

New.Loop.Lim:
   LOCATE 1, 60
   PRINT Loop.Lim&; "old; new";
   INPUT Loop.Lim&
   LOCATE 1, 60
   PRINT SPACE$(19);
   RETURN

SUB BinSort (N, X())

'  Note:  the scratch array is filled from both ends; hence we
'         do not need TWO arrays to provide the necessary "bins".

   DIM Scratch(1 TO N)
 
   Div = 1
   Bit.Pos = 0
   LOCATE 1, 1
   INPUT "Press <Enter> to begin  ", A$
   LOCATE 1, 1
   PRINT SPACE$(25);
   DO
      Idx1 = 0
      Idx2 = N + 1
      FOR Idx = 1 TO N
	 Check = INT(X(Idx) / Div) AND 1    ' Check even or odd
	 IF (Check = 0) THEN                ' Evens to the front
	    Idx1 = Idx1 + 1
	    Scratch(Idx1) = X(Idx)
	 ELSE                               ' Odds to the back
	    Idx2 = Idx2 - 1
	    Scratch(Idx2) = X(Idx)
	 END IF
	 N.Moves = N.Moves + 1
      NEXT Idx
      IF (Idx2 > N) THEN EXIT DO

      CALL Clear.Pts(1, N, X())
'     Empty the two bins in a stack-like fashion.  To preserve
'     existing order, fill the array BACKWARDS to undo the inversion
'     generated by the stack discipline.
      Idx = N
      DO WHILE (Idx2 <= N)
	 X(Idx) = Scratch(Idx2)
	 Idx = Idx - 1
	 Idx2 = Idx2 + 1
	 N.Moves = N.Moves + 1
      LOOP
      DO WHILE (Idx1 >= 1)
	 X(Idx) = Scratch(Idx1)
	 Idx1 = Idx1 - 1
	 Idx = Idx - 1
	 N.Moves = N.Moves + 1
      LOOP
      CALL Update(1, N, X())
      CALL Pause
      LOCATE 1, 1
      PRINT "Bit"; Bit.Pos; "ordering"
      Div = Div * 2
      Bit.Pos = Bit.Pos + 1
   LOOP
END SUB

FUNCTION BinSrch (V, N, X())
  
'  Binary search --- without early exit on equality
'  On failure, return a negative index (which will be where the
'  item sought WOULD go to be in proper position).
 
   Lo = 1
   Hi = N
   X(0) = V
   DO WHILE Hi > Lo
      Mid = (Hi + Lo) \ 2
      CALL Flag(Mid, "M")
      IF (Compare(X(), 0, Mid) > 0) THEN
	 Lo = Mid + 1
      ELSE
	 Hi = Mid
      END IF
   LOOP
   CALL Flag(Hi, "M")
   IF Compare(X(), 0, Hi) = 0 THEN
      BinSrch = Hi
   ELSE
      BinSrch = -Hi
   END IF
END FUNCTION

SUB Bubble (N, X())
   FOR Lim = N TO 2 STEP -1
      CALL Flag(Lim, "Lim")
      Last = 0
      FOR Idx = 1 TO Lim - 1
	 IF Compare(X(), Idx, Idx + 1) > 0 THEN
	    Last = Idx + 1
	    CALL SwapIt(Idx, X(Idx), Idx + 1, X(Idx + 1))
	 END IF
      NEXT Idx
      CALL UnFlag(Lim, "Lim")
      IF Last = 0 THEN EXIT FOR
   NEXT Lim
END SUB

SUB Clear.Pts (Lo, Hi, X())
   FOR Idx = Lo TO Hi
      Jdx = 3 * Idx - 1
      Row = INT(Bottom.Position - X(Idx) * Col.Adjust!)
      LOCATE Row, Jdx
      PRINT " ";
   NEXT Idx
END SUB

FUNCTION Compare (X(), Left, Right)
  
   SHARED Loop.Lim&
  
   N.Compares = N.Compares + 1

   IF Left > 0 THEN
      J1 = 3 * Left - 1
      R1 = 6
   ELSE
      J1 = 1
      R1 = 2
   END IF
   IF Right > 0 THEN
      J2 = 3 * Right - 1
      R2 = 6
   ELSE
      J2 = 1
      R2 = 2
   END IF

   IF J1 > J2 THEN SWAP J1, J2: SWAP R1, R2
   J3 = (J1 + J2) \ 2
   J2 = J2 + 1
   LOCATE 4, J1
   IF J1 = J2 OR J2 = J3 THEN
      PRINT "CMP"
   ELSE
      PRINT STRING$(J2 - J1 + 1, "-")
   END IF
   IF R1 = 2 THEN
      LOCATE 3, J1
   ELSE
      LOCATE 5, J1
   END IF
   PRINT "|";
   LOCATE 4, J1
   PRINT "+";
   LOCATE 5, J2
   PRINT "|";
   LOCATE 4, J2
   PRINT "+";
   LOCATE 4, J3
   PRINT "CMP";

   IF Loop.Lim& = 0 THEN
      CALL Pause
   ELSE
      FOR Idx = 1 TO 10
	 CALL Pause
      NEXT Idx
   END IF

   IF R1 = 2 THEN
      LOCATE 3, J1
      PRINT " ";
   ELSE
      LOCATE 5, J1
      PRINT " ";
   END IF
   LOCATE 5, J2
   PRINT " ";
   LOCATE 4, J1
   PRINT SPACE$(J2 - J1 + 3)
  
   Compare = X(Left) - X(Right)
END FUNCTION

SUB Copy (A(), Hold(), N)
   FOR Idx = 1 TO N
      A(Idx) = Hold(Idx)
   NEXT Idx
   CLS
END SUB

SUB DownHeap (Idx, Lim, X())
'
'  Keep a copy of the item being positioned in heap
   CALL ToHold(Idx, X(Idx), "Position")
   X(0) = X(Idx)
   This = Idx
   Child = This * 2
   More = Child <= Lim
'
'  Structure:  while position for Hold not found . . .
'
   DO WHILE More
      IF Child < Lim THEN
'        Go down the LARGER sub-heap
	 IF Compare(X(), Child, Child + 1) < 0 THEN
	    Child = Child + 1
	 END IF
      END IF
'     ?Move item up in the heap?
      IF Compare(X(), Child, 0) > 0 THEN
	 CALL MoveIt(Child, X(Child), This)
	 X(This) = X(Child)
	 This = Child
	 Child = This * 2
	 More = Child <= Lim
      ELSE
	 More = 0
      END IF
   LOOP
   CALL FromHold(This, X(0))
   X(This) = X(0)
END SUB

SUB Fill (A%(), N%)
   DIM Used(99)
   CLS
   Top = 8
   LOCATE Top, 10
   PRINT "Array fill options:  "
   LOCATE Top + 2, 15
   PRINT "1:  fill the array in forward order"
   LOCATE Top + 4, 15
   PRINT "2:  fill the array in backwards order"
   LOCATE Top + 6, 15
   PRINT "3:  fill the array with random values (default)"
   LOCATE Top + 8, 10
   INPUT "Which option (1-3)"; Opt
   DO UNTIL Opt >= 0 AND Opt <= 3
      LOCATE Top + 12, 10
      PRINT Opt; "is not between 1 and 3; please try again."
      LOCATE Top + 8, 28
      PRINT SPACE$(40);
      LOCATE , 28
      INPUT "", Opt
   LOOP
   SELECT CASE Opt
   CASE 1
      FOR Idx = 1 TO N%
	 A%(Idx) = 10 + INT(Idx * 89 / N%)
      NEXT Idx
   CASE 2
      FOR Idx = 1 TO N%
	 A%(Idx) = INT((N% + 1 - Idx) * 89 / N%) + 10
      NEXT Idx
   CASE 3, 0
      RANDOMIZE TIMER
      FOR Idx = 1 TO N%
	 DO
	    Value = INT(RND * 90) + 10
	 LOOP WHILE Used(Value)
	 Used(Value) = -1
	 A%(Idx) = Value
      NEXT Idx
   END SELECT
END SUB

SUB Flag (Idx, Txt$)

'  Attach a flag (with Txt$ as label) to a cell

   Jdx = 3 * Idx - 1
   LOCATE 8, Jdx
   PRINT "|";
   LOCATE 9, Jdx
   PRINT "|";
   LOCATE 10, Jdx
   PRINT Txt$
END SUB

SUB FromHold (Psn, Value)

'  Move the indicated Value from the Hold area (screen row 2) and
'  place it in the Idx cell.

'  In the animation, propagate the value rightward into position,
'  then drop it from row 2 to row 6

   SHARED Loop.Lim&
  
   N.Moves = N.Moves + 1

   Jdx = 3 * Psn - 1
   D$ = STR$(Value)
   IF LEN(D$) > 2 THEN D$ = RIGHT$(D$, 2)
   LOCATE 2, 6
   PRINT SPACE$(20);
 
   Half.Lim! = Loop.Lim& / 2
   Loop.Lim& = INT(Half.Lim!)
   FOR Idx = 2 TO Jdx
      LOCATE 2, Idx - 1
      PRINT " " + D$
      CALL Pause
   NEXT Idx
   IF INT(Half.Lim!) = Loop.Lim& THEN Loop.Lim& = Half.Lim! * 2
  
   FOR Row = 2 TO 5
      LOCATE Row, Jdx
      PRINT "  ";
      LOCATE Row + 1, Jdx
      PRINT D$
      CALL Pause
   NEXT Row
   Row = INT(Bottom.Position - Value * Col.Adjust!)
   LOCATE Row, Jdx
   PRINT "*";
END SUB

SUB HeapSort (N, X())
   FOR Top = N \ 2 TO 1 STEP -1
      CALL Flag(Top, "Top")
      CALL DownHeap(Top, N, X())
      CALL UnFlag(Top, "Top")
   NEXT Top
   FOR Lim = N - 1 TO 1 STEP -1
      CALL Flag(Lim, "Lim")
      CALL SwapIt(1, X(1), Lim + 1, X(Lim + 1))
      CALL DownHeap(1, Lim, X())
      CALL UnFlag(Lim, "Lim")
   NEXT Lim
END SUB

SUB Init.Screen (X(), N, Title$)

   Size = N * 3 + 1
   CLS
   LOCATE 1, INT((80 - LEN(Title$)) / 2)
   PRINT Title$;
   LOCATE 6, 1
   PRINT " "
   PRINT "+"
   FOR Idx = 1 TO N
      Jdx = 3 * Idx - 1
      D$ = STR$(X(Idx))
      IF LEN(D$) > 2 THEN D$ = RIGHT$(D$, 2)
      D$ = D$ + " "
      LOCATE 6, Jdx
      PRINT D$
      LOCATE , Jdx
      PRINT "--+"
      Row = INT(Bottom.Position - X(Idx) * Col.Adjust!)
      LOCATE Row, Jdx
      PRINT "*";
   NEXT Idx
END SUB

SUB InSort (N, X(), H)
   FOR Lim = H + 1 TO N
      CALL Flag(Lim, "Lim")
      Hole = Lim
      X(0) = X(Hole)
      CALL ToHold(Hole, X(Hole), "Position")
      Test = Hole - H
      DO WHILE Compare(X(), Test, 0) > 0
	 CALL MoveIt(Test, X(Test), Hole)
	 X(Hole) = X(Test)
	 Hole = Test
	 Test = Hole - H
	 IF Test < 1 THEN EXIT DO
      LOOP
      CALL FromHold(Hole, X(0))
      X(Hole) = X(0)
      CALL UnFlag(Lim, "Lim")
   NEXT Lim
END SUB

FUNCTION LinSrch (V, N, X())

'  Linear alias sequential search.  Negative result on failure.
 
   X(0) = V
   FOR Idx = 1 TO N
      Tst = Compare(X(), 0, Idx)
      IF (Tst = 0) THEN EXIT FOR
   NEXT Idx
   IF Idx > N THEN
      LinSrch = -1
   ELSE
      LinSrch = Idx
   END IF
END FUNCTION

SUB Merge (Lo, Mid, Hi, X())
   DIM Scratch(1 TO Hi)

   Idx0 = Lo
   Idx1 = Lo
   Idx2 = Mid
   CALL Flag(Lo, "L")
   CALL Flag(Mid, "M")
   CALL Flag(Hi, "H")
   DO WHILE (Idx1 < Mid AND Idx2 <= Hi)
      IF (Compare(X(), Idx1, Idx2) <= 0) THEN
	 Scratch(Idx0) = X(Idx1)
	 Idx1 = Idx1 + 1
      ELSE
	 Scratch(Idx0) = X(Idx2)
	 Idx2 = Idx2 + 1
      END IF
      Idx0 = Idx0 + 1
      N.Moves = N.Moves + 1
   LOOP
   DO WHILE (Idx1 < Mid)
      Scratch(Idx0) = X(Idx1)
      Idx1 = Idx1 + 1
      Idx0 = Idx0 + 1
      N.Moves = N.Moves + 1
   LOOP
   DO WHILE (Idx2 <= Hi)
      Scratch(Idx0) = X(Idx2)
      Idx2 = Idx2 + 1
      Idx0 = Idx0 + 1
      N.Moves = N.Moves + 1
   LOOP
   CALL Clear.Pts(Lo, Hi, X())
   CALL Update(Lo, Hi, Scratch())
   FOR Idx0 = Lo TO Hi
      X(Idx0) = Scratch(Idx0)
      N.Moves = N.Moves + 1
   NEXT Idx0
   CALL UnFlag(Lo, "L")
   CALL UnFlag(Mid, "M")
   CALL UnFlag(Hi, "H")
END SUB

SUB MoveIt (Start, Value, Finish)
  
'  Move the indicated Value from the Start cell to the Finish cell.

'  In the animation, levitate the value from row 6 to row 3, then
'  propagate it in the appropriate direction until it stands over
'  the Finish cell.  Drop it from row 3 to row 6.

   N.Moves = N.Moves + 1

   IF Start = Finish THEN EXIT SUB
 
   Jdx = 3 * Start - 1
   Row = INT(Bottom.Position - Value * Col.Adjust!)
   LOCATE Row, Jdx
   PRINT " ";
   D$ = STR$(Value)
   IF LEN(D$) > 2 THEN D$ = RIGHT$(D$, 2)
   FOR Row = 5 TO 3 STEP -1
      LOCATE Row + 1, Jdx
      PRINT "  ";
      LOCATE Row, Jdx
      PRINT D$;
      CALL Pause
   NEXT Row
   Incr = SGN(Finish - Start)
   FOR Idx = Jdx TO 3 * Finish - 1 STEP Incr
      LOCATE 3, Idx - 1
      PRINT " " + D$ + " ";
      CALL Pause
   NEXT Idx
   Jdx = 3 * Finish - 1
   FOR Row = 3 TO 5
      LOCATE Row, Jdx
      PRINT "  ";
      LOCATE Row + 1, Jdx
      PRINT D$;
      CALL Pause
   NEXT Row
   Row = INT(Bottom.Position - Value * Col.Adjust!)
   LOCATE Row, Jdx
   PRINT "*";
END SUB

SUB MsortI (N, X())
 
   H = 1
   DO WHILE H < N
      Lo = 1
      DO WHILE Lo < N
	 Mid = Lo + H
	 IF (Mid > N) THEN EXIT DO
	 Hi = Mid - 1 + H
	 IF (Hi > N) THEN Hi = N
	 CALL Merge(Lo, Mid, Hi, X())
	 Lo = Lo + 2 * H
      LOOP
      H = H * 2
   LOOP
END SUB

SUB MsortN (N, X())

'  I.e., take advantage of existing order within the data ---
'        many more comparisons are often required, but the number
'        of data movements is reduced.

'  Also, as the data becomes closer to ordered this approaches an
'  Order(N) algorithm.

   Idx = 1
   Lo = 1
   CALL Flag(Lo, "L")
   DO
      Continue = -1
      DO
	 Idx = Idx + 1
	 IF Idx > N THEN EXIT DO
	 IF (Compare(X(), Idx - 1, Idx) > 0) THEN
	    EXIT DO
	 END IF
      LOOP
      IF (Idx > N) THEN
	 IF (Lo > 1) THEN
	    CALL UnFlag(Lo, "L")
	    Lo = 1
	    Idx = 1
	    CALL Flag(Lo, "L")
	    Continue = 0
	 ELSE
	    EXIT DO
	 END IF
      END IF
      IF Continue THEN
	 Mid = Idx
	 CALL Flag(Mid, "M")
	 DO
	    Idx = Idx + 1
	    IF Idx > N THEN EXIT DO
	    IF (Compare(X(), Idx - 1, Idx) > 0) THEN
	       EXIT DO
	    END IF
	 LOOP
	 Hi = Idx - 1
	 CALL Flag(Hi, "H")
	 CALL Merge(Lo, Mid, Hi, X())
	 CALL UnFlag(Lo, "L")
	 CALL UnFlag(Mid, "M")
	 CALL UnFlag(Hi, "H")
	 IF (Idx <= N) THEN
	    Lo = Idx
	 ELSEIF Lo > 1 THEN
	    Lo = 1
	    Idx = 1
	 ELSE
	    EXIT DO
	 END IF
	 CALL Flag(Lo, "L")
      END IF
   LOOP
   CALL UnFlag(Lo, "L")
END SUB

SUB MsortR (Lo, Hi, X())
 
   IF (Hi <= Lo) THEN EXIT SUB
   Mid = (Lo + Hi + 1) / 2
   CALL MsortR(Lo, Mid - 1, X())
   CALL MsortR(Mid, Hi, X())
   CALL Merge(Lo, Mid, Hi, X())
END SUB

FUNCTION Partition (Lo, Hi, X())
'
'  Rearrange the X() array so that a single element is properly
'  positioned:  all elements to the left of the "partitioning
'  element" (or pivot) belong on the left; all to the right
'  belong on the right.  The position of this partitioning
'  element is then the value of the Partition function.
'
'  This version of partition based on Thomas Naps, "Introduction
'  to Data Structures and Algorithm Analysis"; the Median of Three
'  improvement is taken from Robert Sedgewick, "Algorithms."

   CALL Flag(Lo, "Lo")
   CALL Flag(Hi, "Hi")
   L0 = Lo
   H1 = Hi

'  "Median of Three" --- middle element becomes the actual element.
'                        Insure that ends up in X(Lo).

   Mid = (Lo + Hi) / 2
   IF Compare(X(), Lo, Hi) < 0 THEN         ' abc acb bac
      IF Compare(X(), Lo, Mid) < 0 THEN     ' otherwise bac
	 IF Compare(X(), Mid, Hi) < 0 THEN  ' abc
	    CALL SwapIt(Lo, X(Lo), Mid, X(Mid))
	 ELSE                               ' acb
	    CALL SwapIt(Lo, X(Lo), Hi, X(Hi))
	 END IF
      END IF
   ELSE                                     ' bca cab cba
      IF Compare(X(), Lo, Mid) > 0 THEN     ' otherwise bca
	 IF Compare(X(), Mid, Hi) > 0 THEN  ' cba
	    CALL SwapIt(Lo, X(Lo), Mid, X(Mid))
	 ELSE                               ' cab
	    CALL SwapIt(Lo, X(Lo), Hi, X(Hi))
	 END IF
      END IF
   END IF

'  Open up a "hole" at X(Lo), with X(Mid) as pivot value.
  
   CALL ToHold(Lo, X(Lo), "Pivot")
   X(0) = X(Lo)
  
'  The loop has two exits:  the two places where the Lo and the Hi
'  indexes have come together.  In lieu of extra flags or logical
'  comparisons, this code uses an explicit EXIT DO at those two places.

   DO
'     Search for the value from Hi downward to plug the hole at X(Lo)
      DO WHILE Compare(X(), 0, Hi) < 0 AND Lo < Hi
	 Hi = Hi - 1
      LOOP
'     If we've come together, we're done
      IF Lo = Hi THEN EXIT DO
'     Otherwise plug the hole at Lo with the value at Hi
      CALL MoveIt(Hi, X(Hi), Lo)
      X(Lo) = X(Hi)
'     The hole is now at Hi and Lo is guaranteed good w.r.t. Pivot
      Lo = Lo + 1

'     Search for the value from Lo upward to plug the hole at X(Hi)
      DO WHILE Compare(X(), Lo, 0) < 0 AND Lo < Hi
	 Lo = Lo + 1
      LOOP
'     If we've come together, we're done
      IF Lo = Hi THEN EXIT DO
'     Otherwise plug the hole at Hi with the value at Lo
      CALL MoveIt(Lo, X(Lo), Hi)
      X(Hi) = X(Lo)
'     The hole is now at Lo and Hi is guaranteed good w.r.t. Pivot
      Hi = Hi - 1
   LOOP
  
'  Plug the remaining hole (which is guaranteed to be in Hi = Lo)
'  with the pivot value, making this the partitioning element.
  
   CALL FromHold(Hi, X(0))
   X(Hi) = X(0)
   Partition = Hi

   CALL UnFlag(L0, "  ")
   CALL UnFlag(H1, "  ")
  
   CALL Flag(Hi, "#")
END FUNCTION

SUB Pause

'  Subprogram to pause the simulation.

'  If the delay loop has a zero value, use manual control:
'  SLEEP pauses the machine until a key is touched --- including
'  the CTL and ALT keys.

   SHARED Loop.Lim&

   IF Loop.Lim& <> 0 THEN
      FOR Idx& = 1 TO Loop.Lim&
	 S$ = STR$(VAL(STR$(Idx&)))
      NEXT Idx&
   ELSE
      SLEEP          ' Wait for key stroke --- including CTL or ALT
   END IF
   IF INKEY$ = CHR$(27) THEN
      LOCATE Bottom.Position, 40
      PRINT "Touch any key to resume";
      DO
      LOOP UNTIL LEN(INKEY$) > 0
      LOCATE Bottom.Position, 40
      PRINT SPACE$(25);
   END IF
   EXIT SUB

END SUB

SUB Qsort (Lo, Hi, X())
'
'  Basic QuickSort algorithm:
'
'     1)  Check for exit condition:  if Hi does not come after Lo,
'         there is nothing left to sort.
'     2)  Let the "Partition" function position one element to its
'         exact position:  everything to its left belongs on the
'         left, everything to its right belongs on its right.
'     3)  QuickSort can then call itself to sort everything to the
'         left as a sub-array.
'     4)  Rather than recursively calling itself for the right
'         sub-array, QuickSort can just update Lo and stay within
'         the current call.
'
'  Note:  Almost _all_ of the work for Qsort is embedded in the
'         Partition routine.
'
   DO UNTIL Lo >= Hi

'  Note:  pass Lo and Hi always as VALUE parameters
      Mid = Partition((Lo), (Hi), X())
      CALL Qsort((Lo), (Mid - 1), X())    ' Recursive part for left
      Lo = Mid + 1                        ' "Tail" recursion on right

   LOOP
   IF Lo = Hi THEN CALL Flag(Hi, "o")

END SUB

FUNCTION Run.Opt
   CLS
   Top = 4
   LOCATE Top, 10
   PRINT "Execution start-points:"
   LOCATE Top + 2, 15
   PRINT "1:  Bubble and Shaker sorts"
   LOCATE Top + 4, 15
   PRINT "2:  Select and Insert sorts"
   LOCATE Top + 6, 15
   PRINT "3:  Shell's sort"
   LOCATE Top + 8, 15
   PRINT "4:  Heap sort"
   LOCATE Top + 10, 15
   PRINT "5:  Quick sort"
   LOCATE Top + 12, 15
   PRINT "6:  Merge sorts"
   LOCATE Top + 14, 15
   PRINT "7:  Radix sort (default)"
   LOCATE Top + 16, 10
   INPUT "Which option (1-7)"; Opt
   IF Opt = 0 THEN Opt = 7
   DO UNTIL Opt >= 1 AND Opt <= 7
      LOCATE Top + 19, 10
      PRINT Opt; "is not between 1 and 6; please try again."
      LOCATE Top + 16, 28
      PRINT SPACE$(40);
      LOCATE , 28
      INPUT "", Opt
      IF Opt = 0 THEN Opt = 7
   LOOP
   Run.Opt = Opt
END FUNCTION

SUB Search.Demo (N, X())

'  Using the sorted data on the screen, demonstrate the two kinds of
'  searches ---linear / sequential AND binary.
 
   SHARED Loop.Lim&

   Title$ = "Search Demonstration"

   CALL Init.Screen(X(), N, Title$)
   DO
'     Wipe out all tick marks and values below the line
      FOR L.Pos = 8 TO Bottom.Position
	 LOCATE L.Pos, 1
	 PRINT SPACE$(80);
      NEXT L.Pos

      LOCATE 12, 1
      INPUT "Item sought:  "; V
      N.Compares = 0
      PRINT "Doing a linear/sequential search"
      LOCATE 2, 1
      PRINT USING "##  <== Sought"; V
      Idx = LinSrch(V, N, X())
      LOCATE 14, 1
      IF (Idx > 0) THEN
	 PRINT N.Compares; "required to find at index"; Idx
      ELSE
	 PRINT N.Compares; "required to fail"
      END IF

      INPUT "Press Enter to continue: ", A$

      LOCATE 15, 1
      PRINT SPACE$(40);
      N.Compares = 0
      Loop.Hold = Loop.Lim&
      Loop.Lim& = 0
      PRINT "Doing a binary search --- <Enter> to advance"
      Idx = BinSrch(V, N, X())
      Loop.Lim& = Loop.Hold
      LOCATE 17, 1
      IF (Idx > 0) THEN
	 PRINT N.Compares; "required to find at index"; Idx
      ELSE
	 PRINT N.Compares; "required to fail"
      END IF
      PRINT
      INPUT "Press Q <Enter> to quit, <Enter> to continue  ", A$
      LOCATE 2, 1
      PRINT SPACE$(15);
   LOOP WHILE UCASE$(A$) <> "Q"
   LOCATE 22, 1
END SUB

SUB SelSort (N, X())
   FOR Lim = N TO 2 STEP -1
      CALL Flag(Lim, "Lim")
      Hi = 1
      FOR Idx = 2 TO Lim
	 IF Compare(X(), Idx, Hi) > 0 THEN Hi = Idx
      NEXT Idx
      CALL SwapIt(Lim, X(Lim), Hi, X(Hi))
      CALL UnFlag(Lim, "Lim")
   NEXT Lim
END SUB

SUB Shaker (N, X())
   Inc = 1
   Top = 1
   Lim = N
   DO WHILE Lim > Top
      Last = 0
      IF Inc = 1 THEN
	 Lo = Top
	 Hi = Lim - 1
      ELSE
	 Lo = Lim - 1
	 Hi = Top
      END IF
      CALL Flag(Top, "Lo")
      CALL Flag(Lim, "Hi")
      FOR Idx = Lo TO Hi STEP Inc
	 IF Compare(X(), Idx, Idx + 1) > 0 THEN
	    Last = Idx
	    CALL SwapIt(Idx, X(Idx), Idx + 1, X(Idx + 1))
	 END IF
      NEXT Idx
      CALL UnFlag(Top, "Lo")
      CALL UnFlag(Lim, "Hi")
      IF Last = 0 THEN EXIT DO
      IF Inc = 1 THEN
	 Lim = Last
      ELSE
	 Top = Last + 1
      END IF
      Inc = -Inc
   LOOP
END SUB

SUB ShellSort (N, X())
   H = 1
   DO WHILE H <= N
      H = H * 2 + 1
   LOOP
   IF H > 4 THEN
      H = H \ 4
   ELSE
      H = 1
   END IF
   DO WHILE H > 0
      CALL InSort(N, X(), H)
      H = H \ 2
   LOOP
END SUB

SUB Stats

   LOCATE 11, 1
   PRINT USING "##### comparisons"; N.Compares
   PRINT USING "##### data swaps"; N.Swaps
   PRINT USING "##### single moves"; N.Moves
   N.Compares = 0
   N.Swaps = 0
   N.Moves = 0

   LOCATE Bottom.Position - 1, 20
   INPUT "Press Enter to continue:  ", Dmy$

END SUB

SUB SwapIt (P1, V1, P2, V2)

'  Swap V1 in position P1 with V2 in position P2

'  In the animation, levitate Val1 from row 6 to row 3 and Val2 from
'  for 6 to row 2 (choosing the left-most as Val1).  Then propagate
'  both in the appropriate directions until they stand over their
'  target cells.  Drop them row 6.

   N.Swaps = N.Swaps + 1

   IF P1 = P2 THEN EXIT SUB
 
   IF P1 < P2 THEN
      Pos1 = P1: Val1 = V1: Pos2 = P2: Val2 = V2
   ELSE
      Pos1 = P2: Val1 = V2: Pos2 = P1: Val2 = V1
   END IF
   J1 = 3 * Pos1 - 1
   D1$ = STR$(Val1)
   IF LEN(D1$) > 2 THEN D1$ = RIGHT$(D1$, 2)
   J2 = 3 * Pos2 - 1
   D2$ = STR$(Val2)
   IF LEN(D2$) > 2 THEN D2$ = RIGHT$(D2$, 2)
   FOR Row = 5 TO 3 STEP -1
      LOCATE Row + 1, J1
      PRINT "  ";
      LOCATE Row, J1
      PRINT D1$;
      LOCATE Row + 1, J2
      PRINT "  ";
      LOCATE Row, J2
      PRINT D2$;
      CALL Pause
   NEXT Row
   LOCATE Row + 1, J2
   PRINT "  ";
   LOCATE Row, J2
   PRINT D2$;
   CALL Pause

   Lim = J2
   FOR Idx = J1 TO Lim
      LOCATE 3, J1 - 1
      PRINT " " + D1$;
      LOCATE 2, J2
      PRINT D2$ + " ";
      J1 = J1 + 1
      J2 = J2 - 1
      CALL Pause
   NEXT Idx
   J1 = J1 - 1
   J2 = J2 + 1
   LOCATE Row, J2
   PRINT "  ";
   LOCATE Row + 1, J2
   PRINT D2$;
   FOR Row = 3 TO 5
      LOCATE Row, J1
      PRINT "  ";
      LOCATE Row + 1, J1
      PRINT D1$;
      LOCATE Row, J2
      PRINT "  ";
      LOCATE Row + 1, J2
      PRINT D2$;
      CALL Pause
   NEXT Row
  
   J1 = 3 * P1 - 1
   J2 = 3 * P2 - 1
   R1 = INT(Bottom.Position - V1 * Col.Adjust!)
   R2 = INT(Bottom.Position - V2 * Col.Adjust!)
   LOCATE R1, J1
   PRINT " ";
   LOCATE R2, J2
   PRINT " ";
   LOCATE R1, J2
   PRINT "*";
   LOCATE R2, J1
   PRINT "*";
   SWAP V1, V2                ' Do the actual data swap

END SUB

SUB ToHold (Idx, Value, Txt$)

'  Move the indicated Value from the Idx cell and place it in the
'  Hold area (screen row 2), labeling it with the indicated Txt$.

'  In the animation, levitate the value from row 6 to row 2, then
'  propagate it leftward into position.

   SHARED Loop.Lim&

   N.Moves = N.Moves + 1

   Jdx = 3 * Idx - 1
   D$ = STR$(Value)
   IF LEN(D$) > 2 THEN D$ = RIGHT$(D$, 2)
   FOR Row = 5 TO 2 STEP -1
      LOCATE Row + 1, Jdx
      PRINT "  ";
      LOCATE Row, Jdx
      PRINT D$
      CALL Pause
   NEXT Row
   Row = INT(Bottom.Position - Value * Col.Adjust!)
   LOCATE Row, Jdx
   PRINT " ";
  
   Hold.Lim& = Loop.Lim&
   Loop.Lim& = (Loop.Lim& + 1) / 2
   DO WHILE Jdx > 1
      Jdx = Jdx - 1
      LOCATE 2, Jdx
      PRINT D$ + " "
      CALL Pause
   LOOP
   Loop.Lim& = Hold.Lim&
   LOCATE 2, 6
   PRINT SPACE$(40);
   LOCATE 2, 6
   PRINT "<--- "; Txt$
END SUB

SUB UnFlag (Idx, Txt$)

'  Remove an earlier flag from a cell (Txt$ has proper size for label)

   Jdx = 3 * Idx - 1
   LOCATE 8, Jdx
   PRINT " ";
   LOCATE 9, Jdx
   PRINT " ";
   LOCATE 10, Jdx
   PRINT SPACE$(LEN(Txt$));
END SUB

SUB Update (Lo, Hi, X())
   FOR Idx = Lo TO Hi
      Jdx = 3 * Idx - 1
      LOCATE 6, Jdx
      PRINT USING "##"; X(Idx);
      LOCATE 7, Jdx
      PRINT "--+";
      Row = INT(Bottom.Position - X(Idx) * Col.Adjust!)
      LOCATE Row, Jdx
      PRINT "*";
   NEXT
END SUB