Paste: distribute

Author: mrjbq7
Mode: factor
Date: Wed, 24 Sep 2008 19:43:56
Plain Text | 
: distribute ( amount n -- seq )
    [ / ] keep 0 <array> [ 0 0 ] dip
    [ + [ [ dup ] dip + ] dip
      [ dup round ] dip 2dup -
      [ drop ] dip ] map 3nip ;

Annotation: distribute tests

Author: mrjbq7
Mode: factor
Date: Wed, 24 Sep 2008 19:44:13
Plain Text | 
[ { 3 } ] [ 3 1 distribute ] unit-test
[ { 1 1 1 } ] [ 3 3 distribute ] unit-test
[ { 2 1 2 } ] [ 5 3 distribute ] unit-test
[ { 1 0 1 0 1 } ] [ 3 5 distribute ] unit-test
[ { 143 143 143 142 143 143 143 } ] [ 1000 7 distribute ] unit-test

Annotation: cleaned up distribute

Author: slava
Mode: factor
Date: Wed, 24 Sep 2008 20:31:37
Plain Text | 
: (distribute) ( a b c -- a b c d )
    [ dupd + dup round dup ] dip - ;

: distribute ( amount n -- seq )
    [ / 0 0 ] keep [ (distribute) ] replicate 3nip ;

Annotation: another way

Author: erg
Mode: factor
Date: Wed, 24 Sep 2008 20:49:55
Plain Text | 
: frac ( fraction -- count comparison )
    >fraction [ mod ] keep 2dup / 1/2 <=>
    [
        {
            { +lt+ [ drop ] }
            { +gt+ [ swap - ] }
            { +eq+ [ 2drop 0 ] }
        } case
    ] keep ;

: distribute ( amount n -- seq )
    tuck / [ round '[ _ ] replicate 0 ] keep frac
    { { +lt+ [ [ 1+ ] ] } { +gt+ [ [ 1- ] ] } { +eq+ [ [ ] ] } } case
    [ pick <slice> ] dip change-each ;

Annotation: two general purpose words and distribute

Author: erg
Mode: factor
Date: Wed, 24 Sep 2008 20:58:56
Plain Text | 
: frac ( fraction -- count comparison )
    >fraction [ mod ] keep 2dup / 1/2 <=>
    [ [ drop ] [ swap - ] [ 2drop 0 ] comparator-case ] keep ;

: comparator-case ( comparator quot1 quot2 quot3 -- quot )
    3array swap
    { { +lt+ [ first ] } { +gt+ [ second ] } { +eq+ [ third ] } } case call ; inline

: distribute ( amount n -- seq )
    tuck / [ round '[ _ ] replicate 0 ] keep frac
    [ [ 1+ ] ] [ [ 1- ] ] [ [ ] ] comparator-case [ pick <slice> ] dip change-each ;

Annotation: another version

Author: slava
Mode: factor
Date: Wed, 24 Sep 2008 21:06:01
Plain Text | 
: percentages ( n -- seq ) [ [1,b] ] keep v/n ;
: steps ( amount n -- seq ) steps n*v ;
: rounded ( seq -- seq' ) [ round ] map ;
: differences ( seq -- seq' ) dup 0 prefix v- ;
: distribute ( amount n -- seq ) steps rounded differences ;

Annotation: fix a typo

Author: slava
Mode: factor
Date: Wed, 24 Sep 2008 21:10:22
Plain Text | 
: percentages ( n -- seq ) [ [1,b] ] keep v/n ;
: steps ( amount n -- seq ) percentages n*v ;
: rounded ( seq -- seq' ) [ round ] map ;
: differences ( seq -- seq' ) dup 0 prefix v- ;
: distribute ( amount n -- seq ) steps rounded differences ;

New Annotation

Summary:
Author:
Mode:
Body: