QUICKSORT

Wil Baden 1981-07-04 1983-11-26

This is the sort used in most Forth benchmarks. It has an environmental dependency that 1 CELLS is a power of 2.

It was originally written for figForth and Forth-83, before Standard Forth.

The basic method of [Quicksort] is to take one record, say R[1], and to move it to the final position that it should occupy in the sorted file, say position s. While determining this final position, we will also rearrange the other records so there will be none with greater keys to the left of position s, and none with smaller keys to the right. Thus the file will have been partitioned in such a way that the original sorting problem is reduced to two simpler problems, namely to sort R[1] ... R[s-1], and (independently) R[s+1] ... R[N]. We can apply the same technique to each of these subfiles, until the job is done.

This implementation uses several improvements to Hoare's original formulation.

SORT                ( a n -- )

Order array a n.

PRECEDES            ( pointer pointer -- flag )

Deferred comparison routine. This will usually be used to sort pointers.

Example.

    : CPRECEDES  ( ptr ptr -- flag )
        >R COUNT R> COUNT COMPARE 0< ;
        ' CPRECEDES IS PRECEDES

THRESHOLD           ( -- <n cells> )

The boundary where QUICKSORT should not be used. When sorting pointers to strings, for me 8 CELLS has tested a little better than the original 7 CELLS.

EXCHANGE            ( addr1 addr2 -- )

Exchange contents of two addresses. As a macro it is 5 percent faster.

Both-Ends           ( f l pivot -- f l )

Put lower values on left, higher values on right.

Order3              ( f l -- f l pivot )

Order the first, last, and middle elements before doing a partition. The pivot for the partition is the median of these three.

Partition           ( f l -- f l' f' l )

Split array into two partitions.

Sink                ( f key where -- f )

The innermost loop of insertion sort.

Insertion           ( f l -- )

Insertion sort to be used with small sets.

Hoarify             ( f l -- ... )

Partition until size is less than THRESHOLD. The smaller partition is taken next.

QUICK               ( f l -- f l' f' l )

Partition until done.

CELL                ( -- <1 cells> )

Used in address arithmetic.

-CELL               ( -- <-1 cells> )

Used in address arithmetic.

8 CELLS CONSTANT THRESHOLD

DEFER PRECEDES   ' U< IS PRECEDES

 1 CELLS CONSTANT CELL
-1 CELLS CONSTANT -CELL

: EXCHANGE  ( a a -- )  2DUP  @ SWAP @ ROT !  SWAP ! ;

: Both-Ends         ( f l pivot -- f l )
    >R                    ( f l)( R: pivot)
        BEGIN  OVER @ R@ PRECEDES WHILE
               CELL 0 D+
        REPEAT
        BEGIN  R@ OVER @ PRECEDES WHILE
               CELL -
        REPEAT
    R> DROP ;

: Order3            ( f l -- f l pivot )
    2DUP OVER - 2/ -CELL AND + >R ( R: pivot)
        DUP @ R@ @ PRECEDES IF
            DUP R@ EXCHANGE
        THEN

        OVER @ R@ @ SWAP PRECEDES IF
            OVER R@ EXCHANGE
            DUP @ R@ @ PRECEDES IF
                DUP R@ EXCHANGE
        THEN THEN
    R> ;

: Partition         ( f l -- f l' f' l )
    Order3 @ >R
        2DUP  CELL -CELL D+  ( f l f' l')
        BEGIN  R@ Both-Ends 2DUP 1+ U< IF
                  2DUP EXCHANGE
                  CELL -CELL D+
               THEN
        2DUP SWAP U< UNTIL
        SWAP ROT             ( f l' f' l)
    R> DROP ;

: Sink              ( f key where -- f )
    ROT >R                ( key where)( R: f)
        BEGIN  CELL -  2DUP @ PRECEDES WHILE
               DUP @ OVER CELL+ !
               DUP R@ = IF
                   ! R>   ( f)
               EXIT THEN  ( key where -- )
        REPEAT
        CELL+ !           ( )
    R> ( f) ;

: Insertion         ( f l -- )
    2DUP U< IF
         CELL+ OVER CELL+ DO ( f)
               I @ I Sink
         CELL +LOOP DROP
    ELSE 2DROP
    THEN ( ) ;

: Hoarify           ( f l -- ... )
    BEGIN  2DUP THRESHOLD 0 D+ U< WHILE
           Partition ( ... f l' f' l)
           2DUP - >R  2OVER - R> > IF
                2SWAP
           THEN
    REPEAT           ( ... f l)
    Insertion ( ...) ;

: QUICK             ( f l -- )
    DEPTH >R
        BEGIN  Hoarify  DEPTH R@ < UNTIL
    R> DROP ;

: SORT              ( a n -- )
    DUP 0= ABORT" Nothing to sort "
    1- CELLS  OVER + ( f l) QUICK ;

Go back to Neil Bawd's home page.