|
Wil Baden 1999-04-13
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 )
SPRECEDES ( addr_1 addr_2 -- flag )
PRECEDESEXCHANGE ( addr_1 addr_2 -- )
-CELL ( -- n )
CELL- ( addr -- addr' )
PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 )
QSORT ( lo hi -- )
SORT ( addr n -- )
\ 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 ! ;
: -CELL ( -- n ) -1 CELLS ;
: 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 ( ) ;