Screen 0
 0 \ Title Screen                                 22:29nda08/28/87 
 1 \ Last change:   Screen  023                   22:38nda08/28/87 
 2 \                                                               
 3 \                 VISIBLE SORT ROUTINES                         
 4 \                                                               
 5 \                      taken from                               
 6 \                                                               
 7 \               COMPUTE'S GAZETTE - MAY 1985                    
 8 \                                                               
 9 \                  "Understanding Sorts"                        
10 \                          by                                   
11 \                     Arieh Shamish                             
12 \                                                               
13 \          : =================================:                 
14 \          : Converted to FORTH by Norm Arnold:                 
15 \          : =================================:       

Screen 1
 0 \ Setup for all sorts,    BUBBLE               22:29nda08/28/87 
 1 EDITOR ALSO FORTH CREATE RN 80 ALLOT VARIABLE SEED VARIABLE N1  
 2 VARIABLE N2 VARIABLE SPEED @TIME TTT SEED ! SPEED OFF           
 3 : RND SEED @ 259 * 3 + 32767 AND DUP SEED ! 32767 */ ;          
 4 : GENERATE 79 0 DO 24 RND RN I + C! LOOP ;      \ fill array    
 5 : PLOT CLEARSCREEN 79 0 DO I RN I + C@ AT 42 EMIT LOOP ;        
 6 : TRADE ( c1 c2 -- ) 2DUP N2 @ AT 32 EMIT N1 @ AT 32 EMIT       
 7         2DUP N1 @ AT 42 EMIT N2 @ AT 42 EMIT \ erase & redraw   
 8         RN + N1 @ SWAP C! RN + N2 @ SWAP C! ; \ trade in array  
 9 : STALL SPEED @ IF 1000 0 DO LOOP THEN ; \ slow it down         
10 : 2C@   ( a1 a2 -- n1 n2 n1 n2 ) C@ SWAP C@ SWAP 2DUP ;         
11 : BUB   0 79 DO I 0 ?DO STALL RN I + DUP 1+ 2C@ \ get n & n+1   
12         > IF N2 ! N1 ! I DUP 1+ TRADE ELSE 2DROP \ trade or not 
13         THEN LOOP -1 +LOOP ;    \ next n,n+1 & dec list size    
14 : BUBBLE GENERATE PLOT BUB 0 23 AT ." Done!" ; \ bubble-sort    
15 VARIABLE FLAG VARIABLE GAP  --> \ for shell sort                

Screen 2
 0 \ SHELL,    Set up for KWIK                    22:29nda08/28/87 
 1 : SHL RECURSIVE FLAG OFF 79 GAP @ - 0 DO                        
 2       STALL RN I + DUP GAP @ + 2C@                \ get n,n+gap 
 3       > IF N2 ! N1 ! FLAG ON I DUP GAP @ + TRADE \ flag & trade 
 4       ELSE 2DROP THEN LOOP FLAG @ IF SHL \ if flag do it again  
 5       THEN GAP @ 2/ DUP GAP !         \ cut gap in half         
 6       IF SHL THEN ;                   \ if gap start over       
 7 : SHELL 39 GAP ! GENERATE PLOT SHL 0 23 AT ." Done!" ;          
 8 CREATE TS 20 ALLOT VARIABLE P           \ temp stack & pointer  
 9 VARIABLE FST VARIABLE LST               \ first & last          
10 VARIABLE C1 VARIABLE C2                 \ column numbers        
11 : INC  DUP @ 1+ SWAP ! ; : DEC  DUP @ 1- SWAP ! ; \ ( addr -- ) 
12 : INIT 0 TS 1+ DUP 1+ 79 SWAP C! C! 2 P ! 0 ; \ set stk & pntr  
13 : DN? RECURSIVE STALL RN C1 @ + C@ OVER < IF C1 INC DN? THEN ;  
14 : UP? RECURSIVE STALL RN C2 @ + C@ OVER > IF C2 DEC UP? THEN ;  
15 --> \ look below for >= & above for <=                          

Screen 3
 0 \ Internals of KWIK                            22:29nda08/28/87 
 1 : X'D?  RECURSIVE DN? UP? C1 @ C2 @ 2DUP <=     \ if c1<=c2     
 2         IF C2 @ RN + C@ N2 ! C1 @ RN + C@ N1 !  \ trade inc &   
 3         TRADE C1 INC C2 DEC ELSE 2DROP THEN     \ dec then if   
 4         C1 @ C2 @ <= IF X'D? THEN ;     \ c1<=c2 do it again    
 5 : EOL?  RECURSIVE LST @ C2 !            \ c2=last               
 6         DROP FST @ LST @ + 2/ RN + C@   \ new midpoint value    
 7         X'D? FST @ C2 @ < IF            \ at end of list?       
 8         P INC FST @ P @ TS + C!         \ put fst on temp stk   
 9         P INC C2 @ P @ TS + C! THEN     \ put c2 on temp stk    
10         C1 @ FST ! FST @ LST @ <        \ has fst reached lst?  
11         IF EOL? THEN ;                  \ if not do it again    
12 : >TS RECURSIVE P @ TS + C@ LST ! P DEC \ lst from temp stk     
13       P @ TS + C@ FST ! P DEC FST @ C1 ! \ fst from temp stk    
14       EOL? P @ IF >TS THEN ;    \ end of list? repeat till p=0  
15 : KWIK  GENERATE PLOT INIT >TS DROP 0 23 AT ." Done" ;          

Screen 4
 0 \ Discussion of sort routines                  22:29nda08/28/87 
 1 EXIT \ The editor is added to the search list in order to get   
 2 the words CLEARSCREEN and AT which are required for plotting    
 3 the screen.  Next an array RN is created to hold 80 single byte 
 4 numbers.                                                        
 5   The variable SEED is required for the random number generator 
 6 The variables N1 & N2 are the two numbers being traded. SPEED   
 7 is a flag to slow down the display. SPEED is set to on to slow  
 8 the display.                                                    
 9   The random number generator is from Jack Brown and it takes   
10 its seed value from the clock so that you wont always get the   
11 same series of random numbers.                                  
12   GENERATE fills the array RN with random 8 bit numbers from 0  
13 to 24 and PLOT draws them on the screen. The offset for the     
14 array is the column number and the value in the array is the    
15 row number. An asterisk is placed on the screen for each number.

Screen 5
 0 \ Discussion of sort routines cont'd           22:29nda08/28/87 
 1 EXIT \ TRADE is the word that updates the screen and the array. 
 2 The column number (offsets) are on the stack and the row        
 3 numbers are in variables N1 & N2. First these values are used to
 4 plot blanks over the old stars and then used in the reverse     
 5 order to plot the new stars. Finally they are used to trade the 
 6 values stored in the array RN, leaving the stack clean.         
 7   STALL only slows the display down if SPEED is ON. STALL will  
 8 be installed at each comparison not each trade.                 
 9   2C@ is defined only to conserve space. It takes two addresses 
10 from the stack and replaces them with the values found at those 
11 addresses and them duplicates both of them. This allows us to   
12 place the addresses of the two numbers in question on the stack 
13 and end up with two copies of the numbers. One set is for the   
14 comparison and the other will be stored in N1 and N2 in         
15 preparation for calling TRADE.                                  

Screen 6
 0 \ Discussion of the BUBBLE sort                22:29nda08/28/87 
 1 EXIT \ A bubble sort is accomplished by comparing the first     
 2 number with the second one. If necessary they are traded. Then  
 3 the second is compared with the third, etc. This means the      
 4 largest number in the array will eventually end up in it's      
 5 proper place at the end of the array while most others only move
 6 down one space. This means you now have an unsorted list whose  
 7 length is one less than the previous one. So decrease the list  
 8 size and do it again.                                           
 9   BUB is the word that actually does the bubble sort. The first 
10 loop sets the length of the list and the I is used in the second
11 loop to go through the list each time for the comparisons. The  
12 first address is RN I +. We dup the address and add 1 to get the
13 second address. Then 2C@ converts it to two sets of the values  
14 in those addresses. Comparing them removes one set. If a trade  
15 is required the other set is stored in N1 and N2 otherwise they 

Screen 7
 0 \ Discussion of the BUBBLE sort cont'd         22:29nda08/28/87 
 1 EXIT \ will be dropped. If a trade is required the offsets are  
 2 placed on the stack and TRADE is called. LOOP then increases    
 3 the index by one and the next pair of numbers are compared.     
 4 When the end of the list is reached, -1 +LOOP will decrement the
 5 size of the list and start over. When the size of the list      
 6 reaches 0 the sort is complete.                                 
 7   BUBBLE puts it all together. GENERATE the array; PLOT the     
 8 screen; do the sort with BUB; place the cursor in the lower left
 9 corner so it wont disturb the display and quit.                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 

Screen 8
 0 \ Discussion of the SHELL sort                 22:30nda08/28/87 
 1 EXIT \ The shell sort is similar to the bubble sort except      
 2 instead of comparing the number with the next number in the list
 3 it is compared with a number further down in the list. This     
 4 allows the small numbers to move to the front of the list       
 5 faster. When the sort is started the gap between the numbers    
 6 being compared is set equal to half the length of the list. When
 7 the routine can go through the list without trading the gap is  
 8 halved and we start over. When the gap equals 0 we are finished.
 9   FLAG is used to indicate if a trade was made. GAP is the      
10 variable containing the current distance between the numbers    
11 being compared.                                                 
12   SHL is the word that does the shell sort. It is recursive so  
13 it can call itself if the flag is set or if the gap is nonzero. 
14 Turn the flag off to indicate no trade yet. The size of the list
15 less the gap is the size of the loop. The initial value of gap  

Screen 9
 0 \ Discussion of the SHELL sort cont'd          22:30nda08/28/87 
 1 EXIT \ will be set in a later word. Again the first address is  
 2 RN I + but this time we dup the address and add GAP to it to get
 3 the second address. Once again we use 2C@ to get two copies of  
 4 the numbers. This time we set FLAG ON if a trade is required.   
 5 The rest of the trade is the same as the bubble sort except we  
 6 use I and I+GAP for our offsets. Then LOOP increments the first 
 7 address and we do it again. When we reach the end of the list   
 8 we check FLAG to see if a trade was made. If it was we go thru  
 9 the loop again. When we can get thru the loop without a trade   
10 we halve GAP and repeat the process. When GAP becomes zero the  
11 sort is complete.                                               
12   SHELL puts it all together. First set GAP to half the list    
13 size. Then GENERATE the array and PLOT it on the screen. Next   
14 SHL does the sort and then we move the cursor out of the way.   
15                                                                 

Screen 10
 0 \ Discussion of the KWIK sort                  22:30nda08/28/87 
 1 EXIT \ The kwik sort is much faster than either the bubble sort 
 2 or the shell sort, but it is also harder to understand.         
 3 Consider a deck of cards to be sorted. Go thru the deck and put 
 4 all cards above 6 in one pile and all others in a second pile.  
 5 Now put the first pile away (to be sorted later). Go thru the   
 6 second pile putting all cards above 9 in a third pile. Now put  
 7 the second pile away and go thru the third pile putting all     
 8 cards above Jacks in a fourth pile. This fourth pile now        
 9 contains only Kings and Queens and can easily be sorted. Since  
10 there are now no higher piles to sort we back up to the last    
11 pile (containing Tens and Jacks) and sort it. Now we back up to 
12 the next previous pile (7's, 8's, and 9's) and split it into two
13 piles. Continue in this manner until the entire deck is sorted  
14 and you have just done a kwik sort.                             
15   There are a lot of things to keep track of in this sort.      

Screen 11
 0 \ Discussion of the KWIK sort cont'd           22:30nda08/28/87 
 1 EXIT \ A temporary stack will be used to keep track of the      
 2 "piles". A pointer will be required to keep our place within the
 3 temporary stack. We will need to keep track of the first and    
 4 last offset on each "pile"; these first and last values will be 
 5 stored on the temporary stack. We will not have a loop to       
 6 control our offsets with so we will need two variables to       
 7 contain the values of the two offsets being compared.           
 8   Start by putting the first offset on the temporary stack      
 9 followed by the size of the list. These are our initial first   
10 and last offsets. Since we now have 2 numbers on the temporary  
11 stack we set the pointer at two. Next take the offsets from the 
12 temporary stack, put them into the variables FST and LST and    
13 decrement the pointer by two to indicate they are no longer on  
14 temporary stack (there are no piles yet except the one in hand).
15 Also put these values into C1 and C2 which is where the search  

Screen 12
 0 \ Discussion of the KWIK sort cont'd           22:31nda08/28/87 
 1 EXIT \ starts. Now divide the size of the pile by two and using 
 2 the result as an offset, find the value. This is the number we  
 3 will use to split the "deck" into two piles. This number will be
 4 used a lot so we will keep it on the parameter stack. Starting  
 5 at C1 search upward thru the pile until a number is found which 
 6 is greater than or equal to the number on the stack;            
 7 incrementing C1 each time. Next start at C2 and search downward 
 8 to find a number which is less than or equal to the number on   
 9 the stack; decrementing C2 each time. Now check if C1 is less   
10 than or equal to C2 if so trade the values pointed to by the    
11 offsets C1 and C2 then decrement C2 and increment C1. Check     
12 again to see if the offsets have passed each other. If they have
13 not crossed continue searching for another pair. If the offsets 
14 have crossed then you have created a pile to be sorted later.   
15 Compare FST with C2 if FST is still smaller then store FST and  

Screen 13
 0 \ Discussion of the KWIK sort cont'd           22:31nda08/28/87 
 1 EXIT \ C2 on the temporary stack and increment the pointer by   
 2 two. Now check to see if FST has reached LST. If not repeat the 
 3 process which will create another pile. Continue this way until 
 4 FST equals LST. When this happens you have reached end of the li
 5 st. Now check to see if the pointer has a value; if not you are 
 6 finished. If the pointer does have a value you are now ready to 
 7 back up. So go back to where you took the two values off the    
 8 temporary stack and repeat the process from there.              
 9   INC and DEC are used to increment and decrement variables.    
10   INIT is the word that initializes the temporary stack by      
11 putting the first two values on it and setting the pointer to 2.
12   >TS starts the sort by pulling FST and LST from the temporary 
13 stack. FST is put into C1 and then EOL? is called.              
14   EOL? stores LST in C2 and then creates a new number on the    
15 stack and then calls X'D?.                                      

Screen 14
 0 \ Discussion of the KWIK sort cont'd           22:32nda08/28/87 
 1 EXIT \ X'D? first calls DN? and UP?.                            
 2   DN? starts at C1 and searches upward thru the pile until it   
 3 finds a value equal to or greater than the number on the stack. 
 4   UP? starts at C2 and searches downward thru the pile until it 
 5 finds a value equal to or less than the number on the stack.    
 6   When control gets back to X'D? it makes the comparison, does  
 7 the trade if necessary and calls itself. It keeps doing this    
 8 until the offsets cross then it returns control to EOL?.        
 9   EOL? checks to see if the end of the list was reached if not  
10 then FST and LST are put on the temporary stack. Then if FST has
11 not reached LST yet EOL? calls itself. If FST has reached LST   
12 then control is returned to >TS.                                
13   >TS checks to see if the pointer has returned to zero. If not 
14 it calls itself and we start over. If the pointer has reached   
15 zero we clear the parameter stack and quit.                     

Screen 15
 0 \ The KWIK sort made easy                      22:32nda08/28/87 
 1 \ GENERATE, PLOT and TRADE are the same as the other sorts      
 2 \ INIT  -put first and last indexes on the temporary stack      
 3 \       -set the pointer to 2                                   
 4 \       -put a dummy test value on the parameter stack (it will 
 5 \        be replaced later)                                     
 6 \ >TS   -transfer most recent entry in temporary stack to the   
 7 \        variable LST                                           
 8 \       -transfer next most recent entry in temporary stack to  
 9 \        variable FST                                           
10 \       -decrement pointer by 2                                 
11 \       -store FST in variable C1                               
12 \       -EOL?   -store LST in variable C2                       
13 \               -drop test value from parameter stack           
14 \               -calculate new test value = RN((FST+LST)/2)     
15 \               -X'D?   -DN?    -find value of RN(C1)           

Screen 16
 0 \ The KWIK sort made easy cont'd               22:33nda08/28/87 
 1 \                               -compare RN(C1) with test value 
 2 \                               -if RN(C1) is smaller increment 
 3 \                                C1 and do DN? again            
 4 \                               -otherwise go to UP?            
 5 \                                (C1 now holds the index of a   
 6 \                                value in the list which is =>  
 7 \                                the test value)                
 8 \                       -UP?    -find value of RN(C2)           
 9 \                               -compare RN(C2) with test value 
10 \                               -if RN(C2) is greater decrement 
11 \                                C2 and do UP? again            
12 \                               -otherwise return to X'D?       
13 \                                (C2 now holds the index of a   
14 \                                value in the list which is =<  
15 \                                the test value)                

Screen 17
 0 \ The KWIK sort made easy cont'd               22:33nda08/28/87 
 1 \               -(X'D?) -compare C1 and C2                      
 2 \                       -if C1 <= C2 trade RN(C1) and RN(C2)    
 3 \                        and increment C1 and decrement C2 and  
 4 \                        if C1 still <= C2 do X'D? again        
 5 \                       -otherwise return to EOL?               
 6 \       -(EOL?) -compare FST and C2                             
 7 \               -if FST < C2 put FST and C2 on temporary stack  
 8 \                and increment the pointer by 2                 
 9 \               -otherwise just continue                        
10 \               -store C1 in FST and compare it with LST        
11 \               -if FST < LST do EOL? again                     
12 \               -otherwise return to >TS                        
13 \ (>TS) -is anything left on the temporary stack?               
14 \       -if there is do >TS again                               
15 \       -otherwise the sort is complete                         

Screen 18
 0 \ Timing the sorts   BUBBLE                    22:36nda08/28/87 
 1 FORGET TASK : TASK ;                                            
 2 EDITOR ALSO FORTH 100 CONSTANT SIZ                              
 3 CREATE RN SIZ ALLOT VARIABLE SEED VARIABLE N1                   
 4 VARIABLE N2 @TIME TTT SEED ! CREATE RR SIZ ALLOT                
 5 : RND SEED @ 259 * 3 + 32767 AND DUP SEED ! 32767 */ ;          
 6 : GENESIS SIZ 1- 0 DO 200 RND RR I + C! LOOP ;                  
 7 GENESIS                                 \ create array          
 8 : GENERATE RR RN SIZ MOVE ;            \ transfer array         
 9 : TRADE ( c1 c2 -- )                                            
10         RN + N1 @ SWAP C! RN + N2 @ SWAP C! ; \ trade in array  
11 : 2C@   ( a1 a2 -- n1 n2 n1 n2 ) C@ SWAP C@ SWAP 2DUP ;         
12 : BUB   0 SIZ 1- DO I 0 ?DO RN I + DUP 1+ 2C@ \ get n & n+1     
13         > IF N2 ! N1 ! I DUP 1+ TRADE ELSE 2DROP \ trade or not 
14         THEN LOOP -1 +LOOP ;    \ next n,n+1 & dec list size    
15 : BUBBLE GENERATE BUB ; \ bubble-sort                           

Screen 19
 0 \ Timing the sorts  SHELL & KWIK               22:36nda08/28/87 
 1 VARIABLE FLAG VARIABLE GAP      \ for shell sort                
 2 : SHL RECURSIVE FLAG OFF SIZ 1- GAP @ - 0 DO                    
 3       RN I + DUP GAP @ + 2C@                \ get n,n+gap       
 4       > IF N2 ! N1 ! FLAG ON I DUP GAP @ + TRADE \ flag & trade 
 5       ELSE 2DROP THEN LOOP FLAG @ IF SHL \ if flag do it again  
 6       THEN GAP @ 2/ DUP GAP !         \ cut gap in half         
 7       IF SHL THEN ;                   \ if gap start over       
 8 : SHELL SIZ 2/ GAP ! GENERATE SHL ;                             
 9 CREATE TS 200 ALLOT VARIABLE P          \ temp stack & pointer  
10 VARIABLE FST VARIABLE LST               \ first & last          
11 VARIABLE C1 VARIABLE C2                 \ column numbers        
12 : INC  DUP @ 1+ SWAP ! ; : DEC  DUP @ 1- SWAP ! ; \ ( addr -- ) 
13 : INIT 0 TS 2+ DUP 2+ SIZ 1- SWAP ! ! 4 P ! 0 ; \ set stk\ptr   
14 : DN? RECURSIVE RN C1 @ + C@ OVER < IF C1 INC DN? THEN ;        
15 : UP? RECURSIVE RN C2 @ + C@ OVER > IF C2 DEC UP? THEN ;        

Screen 20
 0 \ Timing the sorts    KWIK cont'd              22:37nda08/28/87 
 1 : X'D?  RECURSIVE DN? UP? C1 @ C2 @ 2DUP <=   \ if c1<=c2       
 2         IF C2 @ RN + C@ N2 ! C1 @ RN + C@ N1 !  \ trade inc &   
 3         TRADE C1 INC C2 DEC ELSE 2DROP THEN     \ dec then if   
 4         C1 @ C2 @ <= IF X'D? THEN ;     \ c1<=c2 do it again    
 5 : EOL?  RECURSIVE LST @ C2 !            \ c2=last               
 6         DROP FST @ LST @ + 2/ RN + C@   \ new midpoint value    
 7         X'D? FST @ C2 @ < IF            \ at end of list?       
 8  P INC  P INC FST @ P @ TS + !         \ put fst on temp stk    
 9  P INC  P INC C2 @ P @ TS + ! THEN     \ put c2 on temp stk     
10         C1 @ FST ! FST @ LST @ <        \ has fst reached lst?  
11         IF EOL? THEN ;                  \ if not do it again    
12 : >TS RECURSIVE P @ TS + @ LST ! P DEC P DEC \ lst from temp sk 
13   P @ TS + @ FST ! P DEC P DEC FST @ C1 !    \ fst from temp stk
14   EOL? P @ 0> IF >TS THEN ;    \ end of list? repeat till p=0   
15 : KWIK  GENERATE INIT >TS DROP ;                                

Screen 21
 0 \ Timer module   ( from Jack Brown's Notes     22:37nda08/28/87 
 1 ONLY EDITOR ALSO FORTH ALSO DEFINITIONS                         
 2   2VARIABLE TICKS                                               
 3 \ Return current time in ticks as a double integer.             
 4 \ ( 18.2 ticks/second ) .                                       
 5   CODE @TICKS ( --  dn )                                        
 6        0 # AH MOV  IP PUSH RP PUSH 26 INT  RP POP IP POP        
 7                           DX PUSH CX PUSH NEXT END-CODE         
 8 \ Save current time in ticks.                                   
 9 : !TIMER ( --  -- )                                             
10         @TICKS TICKS 2! ;                                       
11 \ Fetch elapsed time in ticks.                                  
12 : @TIMER  ( --  dn )                                            
13            @TICKS TICKS 2@ D- ;                                 
14 : TIMEIT ;                                                      
15                                                                 

Screen 22
 0 \ Timing the sorts   Timer Template            22:38nda08/28/87 
 1 FORGET TIMEIT                                                   
 2 : TIMEIT                                                        
 3         !TIMER                                                  
 4                                                                 
 5      BUBBLE                                                     
 6 \    SHELL                                                      
 7 \    KWIK                                                       
 8              @TIMER DROP CR                                     
 9         500  91 */ . ." SECONDS FOR ONE HUNDRED SORTS." ;       
10                                                                 
11                                                                 
12 : TEST CLEARSCREEN 5 0 DO TIMEIT LOOP ;                         
13                                                                 
14                                                                 
15                                                                 

Screen 23
 0 \ Results of timed sorts                       22:38nda08/28/87 
 1                                                                 
 2                                                                 
 3 \    | ITEMS IN LIST   | BUBBLE | SHELL  |  KWIK  |             
 4 \    ----------------------------------------------             
 5 \    | 25              | 0.10   | 0.11   |  0.07  |             
 6 \    | 50              | 0.41   | 0.23   |  0.18  |             
 7 \    | 100             | 1.70   | 0.71   |  0.39  |             
 8 \    | 125             | 2.69   | 0.92   |  0.54  |             
 9 \    | 150             | 4.01   | 1.24   |  0.69  |             
10 \    | 175             | 5.30   | 1.39   |  0.76  |             
11 \    ----------------------------------------------             
12 \                                                               
13 \  NOTE: KWIK sort wont work in the timed routine if the array  
14 \   has 200 or more elements. Too many calls to return stack!   
15 \                                       Norm