All pastes #269439 Raw Edit

partitionQ

public text v1 · immutable
·published 2006-12-06 16:19 UTC
rendered paste body
\ could be DEFERed to allow sorting different things
: select-pivot ( first last -- pivot ) over - 2/ + aligned ;
: greater? ( addr1 addr2 -- flag ) @ swap @ < ;
: exchange ( addr1 addr2 -- ) 2dup  @ >r  @ swap !  r> swap ! ;
 
: partition ( first last  -- first1 last1 first2 last2 )
    2dup select-pivot
    over exchange
    >r dup dup begin dup r@ <= while
        dup r@ greater? 0= if 2dup exchange  swap 1 cells + swap then
    1 cells + repeat
    drop dup >r 2 cells - r> r> ;
 
: quicksort ( first last -- )
    2dup < if 2dup partition recurse recurse else 2drop then ;

: shorter-segment ( L1 R1  L2 R2 -- L1 R1  L2 R2 | L2 R2  L1 R1 )
\ Bring the shorter of the two segments to the top of the stack.
  2over 2over  -  +  > if 2swap then ;

: qsort ( L R -- )  begin  2dup < while  partition shorter-segment recurse  repeat  2drop ;

create a 5 , 4 , 2 , 1 , 9 , 8 , 3 ,
a dup 6 cells + partition
@ . @ . @ . @ .