Paste: insertion sort, C style

Author: pruned
Mode: factor
Date: Sat, 20 Jun 2009 06:39:49
Plain Text | 
( scratchpad ) 
:: rcopy ( src dst -- ) 
    src length iota <reversed> [ [ src nth ] [ dst set-nth ] bi ] each ;
:: insert-sort-at ( seq n -- )
    n seq nth :> val
    seq n head-slice :> head
    head [ val > ] find drop :> pivot
    pivot [ 
        head seq [ pivot tail-slice ] bi@ 1 tail-slice rcopy
        val pivot seq set-nth
    ] when ;
( scratchpad ) 10 [ 100 iota random ] replicate dup . [ dup length [ insert-sort-at ] with each ] keep .
{ 80 73 22 44 56 94 76 17 8 76 }
{ 8 17 22 44 56 73 76 76 80 94 }

Annotation: couting data movement

Author: pruned
Mode: factor
Date: Sat, 20 Jun 2009 06:42:49
Plain Text | 
( scratchpad ) 
:: rcopy ( src dst -- ) 
    src length iota <reversed> [ [ src nth ] [ dst set-nth ] bi "x" write ] each ;
( scratchpad ) 10 [ 100 iota random ] replicate dup . [ dup length [ insert-sort-at ] with each ] keep .
{ 19 80 55 25 12 18 8 93 4 90 }
xxxxxxxxxxxxxxxxxxxxxxxxxx
{ 4 8 12 18 19 25 55 80 90 93 }
( scratchpad ) "xxxxxxxxxxxxxxxxxxxxxxxxxx" length .
26

Annotation: My insertion sort so far

Author: yuuki
Mode: factor
Date: Sat, 20 Jun 2009 09:07:56
Plain Text | 
:: isort-c ( a -- )
    [let | i! [ f ] j! [ 1 ] key! [ f ] |
        [ j a length < ]
        [
            j a nth key!
            j 1- i!
            [ { [ i 0 >= ] [ i a nth key <=> +gt+ = ] } 0&& ]
            [
                i a nth i 1+ a set-nth
                i 1- i!
            ] while
            key i 1+ a set-nth
            j 1+ j!
        ] while
    ] ; inline

Annotation: Passing along the key

Author: yuuki
Mode: factor
Date: Sat, 20 Jun 2009 10:56:10
Plain Text | 
<PRIVATE
:: insert ( n seq key -- )
    n zero? [ key 0 seq set-nth ] [
        key n 1- seq nth <=> +lt+ = [
            n 1- seq nth n seq set-nth-unsafe
            n 1- seq key insert
        ] [ key n seq set-nth ] if
    ] if ; inline recursive
PRIVATE>

: insertion-sort ( seq -- )
    [ length ] keep [ 2dup nth insert ] curry each ; inline

Annotation: No locals

Author: yuuki
Mode: factor
Date: Sat, 20 Jun 2009 11:45:13
Plain Text | 
<PRIVATE
DEFER: insert
: (insert) ( key n seq -- )
    [ [ 1- ] dip nth ]
    [ set-nth ]
    [ [ 1- ] dip insert ] 2tri ; inline recursive

: insert ( key n seq -- )
    3dup {
        [ drop nip zero? not ]
        [ [ 1- ] dip nth <=> +lt+ = ]
    } 3&& [ (insert) ] [ set-nth ] if ; inline recursive
PRIVATE>

: isort-factor ( seq -- )
    ! quot is a transformation on elements
    [ length ] keep [ [ nth ] 2keep insert ] curry each ; inline

Annotation: Take out combinators.short-circuit

Author: yuuki
Mode: factor
Date: Sat, 20 Jun 2009 11:50:29
Plain Text | 
<PRIVATE
DEFER: insert
: (insert) ( key n seq -- )
    [ [ 1- ] dip nth ]
    [ set-nth ]
    [ [ 1- ] dip insert ] 2tri ; inline recursive

: insert ( key n seq -- )
    over zero? not [
        pick pick 1- pick nth <=> +lt+ = [ (insert) ] [ set-nth ] if
    ] [ set-nth ] if ; inline recursive
PRIVATE>

: isort-factor ( seq -- )
    [ length ] keep [ [ nth ] 2keep insert ] curry each ; inline

New Annotation

Summary:
Author:
Mode:
Body: