Counting sort routine

http://www.osix.net/modules/article/?id=850 speaks about the Fastest
Sort Ever. Neglecting to benchmark is universal :-)

It works somewhat like radix-sort but the (implicit) assumptions
are such that only a single pass is necessary. Be warned that this
sort needs memory proportional to the largest differential value in
the input (a very limiting horse's foot). I think the code has a
cache issue, it slows down enormously when counts grows over 8K.

-marcel
-- ------------
(*
* LANGUAGE : ANS Forth with extensions
* PROJECT : Forth Environments
* DESCRIPTION : Counting SORT
* CATEGORY : Utilities
* AUTHOR : Sk, http://www.osix.net/modules/article/?id=850
* LAST CHANGE : September 6, 2008, Marcel Hendrix
*)


NEEDS -miscutil

REVISION -countsort "--- Counting sort Version 1.00 ---"

PRIVATES

0 VALUE minimum PRIVATE
0 VALUE maximum PRIVATE
#1000000 =: #entries PRIVATE

#entries CELLS ALLOCATE ?ALLOCATE =: input PRIVATE
#entries CELLS ALLOCATE ?ALLOCATE =: output PRIVATE
0 VALUE counts PRIVATE

: RESTORE ( xt -- )
DROP
input FREE ?ALLOCATE
output FREE ?ALLOCATE
counts FREE ?ALLOCATE ; PRIVATE

: FILL-input ( bitwidth -- )
LOCAL width
CR ." Creating " #entries U>D (n,3) ." input values."
#entries 0 DO width 2^x CHOOSE input I CELL[] ! LOOP ;

' RESTORE IS-FORGET FILL-input

: PRINT-input ( -- )
#entries #10 > ?EXIT
CR ." input : " #entries 0 DO input I CELL[] @ DEC. LOOP ;

: PRINT-output ( -- ) PRINT-input ;

-- Translation of input to an interval [0, k]
-- Search maximum = max(input) and min = min(input).
-- Subtract minimum from all input elements.
: TRANSLATE ( -- )
input @ DUP TO maximum TO minimum
input #entries 0 ?DO @+ DUP maximum MAX TO maximum
minimum MIN TO minimum
LOOP DROP
minimum 0= ?EXIT
minimum -TO maximum
input #entries 0 ?DO minimum OVER -! CELL+
LOOP DROP ; PRIVATE

: INITIALIZE ( -- )
TRANSLATE
output #entries 0 ?DO minimum 1- OVER ! CELL+ LOOP DROP
maximum 1+ CELLS ALLOCATE ?ALLOCATE TO counts ; PRIVATE

: COUNT&INTEGRATE ( -- )
input #entries 0 ?DO @+ counts []CELL 1 SWAP +! LOOP DROP
counts maximum 0 ?DO @+ OVER +! LOOP DROP ; PRIVATE

: CONSTRUCT-OUTPUT ( -- )
input #entries 0 ?DO @+ DUP >R
counts []CELL @ 1- output []CELL R@ minimum + SWAP !
-1 counts R> CELL[] +!
LOOP DROP
output input #entries CELLS MOVE ; PRIVATE

: COUNT-SORT ( -- ) INITIALIZE COUNT&INTEGRATE CONSTRUCT-OUTPUT ;

: TEST ( bitwidth -- )
FILL-input PRINT-input
CR ." Sorting .. " TIMER-RESET COUNT-SORT .ELAPSED
PRINT-output ;

:ABOUT CR ." Try: u TEST -- u is the width in bits of the random values to generate."
CR ." -- becomes quite (too) slow for u > 10."
CR ." -- Note: needs memory proportionally to 2^u." ;

DOC
(* ( 3 GHz PIV )
FORTH> 8 test \ Sorting .. 0.043 seconds elapsed. ok
FORTH> 9 test \ Sorting .. 0.040 seconds elapsed. ok
FORTH> 10 test \ Sorting .. 0.044 seconds elapsed. ok
FORTH> 11 test \ Sorting .. 0.044 seconds elapsed. ok
FORTH> 12 test \ Sorting .. 0.059 seconds elapsed. ok
FORTH> 13 test \ Sorting .. 0.092 seconds elapsed. ok
FORTH> 16 test \ Sorting .. 0.171 seconds elapsed. ok
FORTH> 20 test \ Sorting .. 0.383 seconds elapsed. ok
FORTH> 22 test \ Sorting .. 0.418 seconds elapsed. ok
*)
ENDDOC

.ABOUT -countsort CR
DEPRIVE

(* End of Source *)

On Sep 6, 2:51*pm, m...@iae.nl (Marcel Hendrix) wrote:
> http://www.osix.net/modules/article/?id=850speaks about the Fastest
> Sort Ever. Neglecting to benchmark is universal :-)
>
> It works somewhat like radix-sort but the (implicit) assumptions


Hi
I believe this is a straight distribution sort.
Without the advantages of radixing, it is quite
limited.
Dwight