ANEW --QSORT--                                \  Wil Baden  1999-04-13

\          QSORT from _Forth Dimensions_ vol.5

\  Leo Wong resurrected a version of Quicksort that I published
\  in 1983. I no longer had a copy, and had forgotten it. I
\  recall that a design constraint was to fit in one screen.

\  It doesn't do median-of-three or insertion sort under a
\  threshold. It is recursive.

\  To my shock it has been 20-25 percent faster in tests than my
\  "improved" version.

\  PRECEDES            ( addr_1 addr_2 -- flag )
\      Defer-word for comparison.  Return TRUE for "lower".

\  SPRECEDES           ( addr_1 addr_2 -- flag )
\      String comparison for `PRECEDES`.

\  EXCHANGE            ( addr_1 addr_2 -- )
\      Exchange contents of two addresses.

\  -CELL               ( -- n )
\      Invert of size of cell.  1 CELLS must be a power of 2.
\      Algorithm works for 2's complement, 1's complement, and
\      sign-magnitude arithmetic.

\  CELL-               ( addr -- addr' )
\      Decrement address. 

\  PARTITION           ( lo hi -- lo_1 hi_1 lo_2 hi_2 )
\      Partition array around its median.

\  QSORT               ( lo hi -- )
\      Partition array until done.

\  SORT                ( addr n -- )
\      Setup array for recursive partitioning.

\  Set PRECEDES for different datatypes or sort order.

DEFER PRECEDES  ' < IS PRECEDES

\  For sorting character strings in increasing order:

: SPRECEDES                 ( addr addr -- flag )
    >R COUNT R> COUNT COMPARE 0< ;

  ' SPRECEDES IS PRECEDES

: EXCHANGE                  ( addr_1 addr_2 -- )
    dup @ >R  over @ SWAP !  R> SWAP ! ;

1 CELLS INVERT CONSTANT  -CELL

: CELL-  ( addr -- addr' )  1 CELLS - ;

: PARTITION                 ( lo hi -- lo_1 hi_1 lo_2 hi_2 )
    2dup over - 2/  -CELL AND +  @ >R ( R: median)
    2dup BEGIN                      ( lo_1 hi_2 lo_2 hi_1)
         SWAP BEGIN  dup @ R@  PRECEDES WHILE  CELL+  REPEAT
         SWAP BEGIN  R@ over @  PRECEDES WHILE  CELL-  REPEAT
         2dup > NOT IF  2dup EXCHANGE  >R CELL+ R> CELL-  THEN
    2dup > UNTIL                    ( lo_1 hi_2 lo_2 hi_1)
    R> DROP                         ( R: )
    SWAP ROT                        ( lo_1 hi_1 lo_2 hi_2)
    ;

: QSORT                     ( lo hi -- )
    PARTITION                       ( lo_1 hi_1 lo_2 hi_2)
    2over 2over  - +                ( . . . . lo_1 hi_1+lo_2-hi_2)
        < IF  2SWAP  THEN           ( lo_1 hi_1 lo_2 hi_2)
    2dup < IF  RECURSE  ELSE  2DROP  THEN
    2dup < IF  RECURSE  ELSE  2DROP  THEN ;

: SORT                      ( addr n -- )
    dup 2 < IF  2DROP  EXIT THEN
    1- CELLS over + ( addr addr+{n-1}cells) QSORT ( ) ;

\\  *************************  End of QSORT  *************************