Re: Forth Insertion sort (Research Paper)

\ INSERTION-SORT sample.

\ COMPARE: returns...
\ -1 if array[i] < array[j]
\ 0 if array[i] = array[j]
\ +1 if array[i] > array[j]
defer compare-key ( array i j -- result )

\ EXCHANGE array[i], array[j].
defer swap-data ( array i j -- )

\ TOOL: in a DO..LOOP, II returns the descendant index.
: ii ( -- index )
    postpone i'
    postpone i
    postpone -
    postpone 1- ; immediate

\ ---------------------------------

\ WHILE array[i+1]<array[i] AND i>=0, Swap(array[i], array[i+1]), i=i-1
\ There is another, faster way; not using SWAP-DATA:
\ TEMP=array[i+1]
\ WHILE I>=0 AND array[i+1]<array[i] DO array[i+1]=array[i], i=i-1
\ array[i+1]=TEMP
: move-key-down ( array index -- )
    0 ?do
        dup ii dup 1+ ( array i i+1 )
        compare-key 0< ( array pair-sorted? )
        if leave then
        dup ii dup 1+ swap-data
    loop drop ;

\ Find the first non-sorted pair, then MOVE-KEY-DOWN.
: insertion-sort ( array count -- )
    1 ?do
        dup i dup 1- compare-key 0< if
            dup i move-key-down
        then
    loop drop ;

\ -----------------------
\ Test a bit complicated because I don't use specialized array access
word.

create myarray
    here
    9 , 3 , 4 , 12 , 7 , 1 , 4 , 3 , 2 ,
    here swap - cell / constant mycount

:noname [ is compare-key ] ( array i j-- result )
    cells third + @ >r cells + @ r>
    ( a b ) 2dup > if 2drop 1 else < then ;

:noname [ is swap-data ] ( array i j -- )
    cells third + >r cells + r> ( a' b' )
    2dup @ >r @ swap ! r> swap ! ;

: test
    myarray mycount insertion-sort
    cr
    myarray mycount 0 ?do @+ . loop drop
    cr ;

----- Original Message -----
From: <bnhcomputing_at_yahoo.com>
To: <sftalk_at_forth.com>
Sent: Monday, May 01, 2006 3:25 AM
Subject: [sftalk] Forth Insertion sort (Research Paper)

> Hello:
>
> I am a college student working on a research paper. Does anyone know
> where I can find an example of an insertion sort written in FORTH?
>
> Thank you in advance,
>
> Hubert Hoffman
> N5449 Sobkowiak Rd.
> Onalaska, WI 54650
> 608-779-4381
>
>
> ---------------------------------
> New Yahoo! Messenger with Voice. Call regular phones from your PC and
> save big.

----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Mon May 01 2006 - 05:41:39 PDT