require random.fs
\ provides random ( n -- 0..n-1 )
$abcdef0123456789 seed !

\ for dealing with input from shuf(1)
\ gforth badsort.fs -e "`shuf -i 1-20` makearray 2dup badsort printarray cr bye"
: makearray ( nu..n1 -- addr u )
    align here >r begin
        depth while
            ,
    repeat
    r@ here r> - 1 cells / ;

: printarray ( addr u -- )
    0 do
        dup i cells + @ . loop
    drop ;

variable steps 0 steps !

: sorted? ( addr u -- f )
    assert( dup 1 u> )
    1- cells over + swap do
        i @ i cell+ @ u> if
            unloop false exit then
    1 cells +loop
    true ;

: exchange ( addr1 addr2 -- )
    over @ over @ >r swap ! r> swap ! ;

: badsort { addr u -- }
    u 2 u< if
        2drop exit then \ ensure assertion in sorted?
    begin
        addr u sorted? 0= while
            addr u random th addr u random th exchange
            1 steps +!
            \ addr u printarray cr
    repeat ;

: maybe-exchange ( addr1 addr2 -- )
    2dup u<= >r over @ over @ 2dup u<= r> = if
        2drop 2drop
    else
        >r swap ! r> swap !
    then ;

: so-so-sort { addr u -- }
    u 2 u< if
        2drop exit then \ ensure assertion in sorted?
    begin
        addr u sorted? 0= while
            addr u random th addr u random th maybe-exchange
            1 steps +!
            \ addr u printarray cr
    repeat ;

: mediocre-sort { addr u -- }
    u 2 u< if
        2drop exit then \ ensure assertion in sorted?
    begin
        addr u sorted? 0= while
            u 8 * 0 do \ only check for sortedness now and then
                addr u random th addr u random th maybe-exchange
                1 steps +!
            loop 
            \ addr u printarray cr
    repeat ;