"dkelvey@hotmail.com" hotmail.com> writes Re: Sorting routine

[..]

Of course. Sorry that I didn't show the updated code, I only mentioned
this optimization in words to save space and my bother to explain the
notation. I am using a variant of Wil Baden's MACRO%% words in the appended
source for the benchmark results I posted earlier.

-marcel
-- ------
(*
* LANGUAGE : ANS Forth with extensions
* PROJECT : Forth Environments
* DESCRIPTION : RADIX / Distribution SORT
* CATEGORY : Utilities
* AUTHOR : Marcel Hendrix
* LAST CHANGE : September 5, 2008, Marcel Hendrix
*)

NEEDS -miscutil

REVISION -radixsort "--- Radix Sort Version 1.01 ---"

PRIVATES

DOC
(*
Make a table COUNTS ( 256 entries )
Make a table INDEX ( 256 entries )

Initialize COUNTS to zeros
FOR n = 0 to numwords ( largest entry has numwords n-bit words )
BEGIN
parse word n out of the next entry, the lowest order word that has not yet been sorted
Use this word as an index into COUNTS and increment that value
REPEAT ( for each entry )

place 0 in the first location of INDEX
FOR i = 0 to 2^n-bit - 2
INDEX[i+1] = INDEX[i] + COUNTS[i]
NEXT

BEGIN ( for each entry )
parse out word n
use this to index into INDEX
use this new index as the location in the output buffer to place the item
increment the value in the INDEX just used
REPEAT

copy output to input
NEXT n

*)
ENDDOC

8 =: nbits PRIVATE ( 16 is 261 ms, 4 is 166 ms )
nbits 2^x 1- =: mask PRIVATE
#1000000 =: #entries PRIVATE

0 VALUE #items PRIVATE

CREATE COUNTS nbits 2^x CELLS ALLOT PRIVATE
CREATE INDEX nbits 2^x CELLS ALLOT PRIVATE

#entries CELLS ALLOCATE ?ALLOCATE =: input PRIVATE
#entries CELLS ALLOCATE ?ALLOCATE =: output PRIVATE

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

: FILL-input ( bitwidth -- )
LOCAL width
." creating " #entries U>D (n,3) ." input values"
#entries 0 DO width 2^x CHOOSE ABS 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 ;

MACRO%% NEXT-BITS0 ( arg1 arg2 arg3 -- )
0 LOCAL cnt
COUNTS nbits 2^x CELLS ERASE
%% #entries 0 ?DO @+ DUP cnt OR TO cnt mask AND
COUNTS []CELL 1 SWAP +!
LOOP DROP
0 INDEX ! INDEX COUNTS nbits 2^x 1- CELLS
BOUNDS DO @+ I @ + OVER !
=CELL +LOOP DROP
%% #entries 0 ?DO @+ ( addr entry)
DUP mask AND INDEX []CELL DUP @ 1 ROT +!
( addr entry ix ) %% []CELL !
LOOP DROP
cnt LOG2 nbits / TO #items ; PRIVATE

MACRO%% NEXT-BITS ( arg1 arg2 arg3 arg4 arg5 -- )
COUNTS nbits 2^x CELLS ERASE
%% #entries 0 ?DO @+ %% RSHIFT mask AND
COUNTS []CELL 1 SWAP +!
LOOP DROP
0 INDEX ! INDEX COUNTS nbits 2^x 1- CELLS
BOUNDS DO @+ I @ + OVER !
=CELL +LOOP DROP
%% #entries 0 ?DO @+ ( addr entry)
DUP %% RSHIFT mask AND INDEX []CELL DUP @ 1 ROT +!
( addr entry ix ) %% []CELL !
LOOP DROP ; PRIVATE

: RADIX-SORT4 ( -- )
NEXT-BITS0 input input output #items 1 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output 4 output 4 input #items 2 < IF EXIT ENDIF
NEXT-BITS input 8 input 8 output #items 3 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #12 output #12 input #items 4 < IF EXIT ENDIF
NEXT-BITS input #16 input #16 output #items 5 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #20 output #20 input #items 6 < IF EXIT ENDIF
NEXT-BITS input #24 input #24 output #items 7 < IF output input #entries CELLS MOVE EXIT ENDIF
[ 64BIT? ]
[IF]
NEXT-BITS output #28 output #28 input #items 8 < IF EXIT ENDIF
NEXT-BITS input #32 input #32 output #items 9 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #36 output #36 input #items #10 < IF EXIT ENDIF
NEXT-BITS input #48 input #48 output #items #11 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #52 output #52 input #items #12 < IF EXIT ENDIF
NEXT-BITS input #56 input #56 output #items #13 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #60 output #60 input
[THEN] ;

: RADIX-SORT ( -- )
NEXT-BITS0 input input output #items 1 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output 8 output 8 input #items 2 < IF EXIT ENDIF
NEXT-BITS input #16 input #16 output #items 3 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #24 output #24 input #items 4 < IF EXIT ENDIF
[ 64BIT? ]
[IF]
NEXT-BITS input #32 input #32 output #items 5 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #40 output #40 input #items 6 < IF EXIT ENDIF
NEXT-BITS input #48 input #48 output #items 7 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #56 output #56 input
[THEN] ;

: RADIX-SORT12 ( -- )
NEXT-BITS0 input input output #items 1 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #12 output #12 input #items 2 < IF EXIT ENDIF
NEXT-BITS input #24 input #24 output #items 3 < IF output input #entries CELLS MOVE EXIT ENDIF
[ 64BIT? 0= ]
[IF]
NEXT-BITS output 0 output 0 input
[ELSE]
NEXT-BITS output #36 output #36 input #items 4 < IF EXIT ENDIF
NEXT-BITS input #48 input #48 output #items 5 < IF output input #entries CELLS MOVE EXIT ENDIF
NEXT-BITS output #60 output #60 input
[THEN] ;

: TEST ( bitwidth -- )
CR ." Bitwidth of data = " DUP 2 .R ." , "
FILL-input PRINT-input
." , sorting, nbits = " nbits DEC. ." .. "
TIMER-RESET
[ nbits 4 = ] [IF] RADIX-SORT4 [THEN]
[ nbits 8 = ] [IF] RADIX-SORT [THEN]
[ nbits #12 = ] [IF] RADIX-SORT12 [THEN]
.ELAPSED
PRINT-output ;

: TESTS ( -- ) -1 #BITS 8 DO I TEST 8 +LOOP ;

:ABOUT CR ." Try: u TEST -- u is the width in bits of the random values to generate" ;

DOC
(* ( 3 GHz AMD X2 )

Bitwidth of data = 8, creating 1,000,000 input values, sorting, nbits = 8 .. 0.020 seconds elapsed.
Bitwidth of data = 16, creating 1,000,000 input values, sorting, nbits = 8 .. 0.030 seconds elapsed.
Bitwidth of data = 24, creating 1,000,000 input values, sorting, nbits = 8 .. 0.050 seconds elapsed.
Bitwidth of data = 32, creating 1,000,000 input values, sorting, nbits = 8 .. 0.059 seconds elapsed.
Bitwidth of data = 40, creating 1,000,000 input values, sorting, nbits = 8 .. 0.079 seconds elapsed.
Bitwidth of data = 48, creating 1,000,000 input values, sorting, nbits = 8 .. 0.089 seconds elapsed.
Bitwidth of data = 56, creating 1,000,000 input values, sorting, nbits = 8 .. 0.108 seconds elapsed. ok

Bitwidth of data = 8, creating 1,000,000 input values, sorting, nbits = 12 .. 0.020 seconds elapsed.
Bitwidth of data = 16, creating 1,000,000 input values, sorting, nbits = 12 .. 0.031 seconds elapsed.
Bitwidth of data = 24, creating 1,000,000 input values, sorting, nbits = 12 .. 0.041 seconds elapsed.
Bitwidth of data = 32, creating 1,000,000 input values, sorting, nbits = 12 .. 0.061 seconds elapsed.
Bitwidth of data = 40, creating 1,000,000 input values, sorting, nbits = 12 .. 0.073 seconds elapsed.
Bitwidth of data = 48, creating 1,000,000 input values, sorting, nbits = 12 .. 0.083 seconds elapsed.
Bitwidth of data = 56, creating 1,000,000 input values, sorting, nbits = 12 .. 0.103 seconds elapsed. ok

Bitwidth of data = 8, creating 1,000,000 input values, sorting, nbits = 4 .. 0.021 seconds elapsed.
Bitwidth of data = 16, creating 1,000,000 input values, sorting, nbits = 4 .. 0.041 seconds elapsed.
Bitwidth of data = 24, creating 1,000,000 input values, sorting, nbits = 4 .. 0.061 seconds elapsed.
Bitwidth of data = 32, creating 1,000,000 input values, sorting, nbits = 4 .. 0.081 seconds elapsed.
Bitwidth of data = 40, creating 1,000,000 input values, sorting, nbits = 4 .. 0.101 seconds elapsed.
Bitwidth of data = 48, creating 1,000,000 input values, sorting, nbits = 4 .. 0.119 seconds elapsed.
Bitwidth of data = 56, creating 1,000,000 input values, sorting, nbits = 4 .. 0.139 seconds elapsed. ok
*)
ENDDOC

.ABOUT -radixsort CR
DEPRIVE

(* End of Source *)