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