2008-10-01 22:58:53 -04:00
|
|
|
! Copyright (C) 2008 John Benediktsson
|
|
|
|
! See http://factorcode.org/license.txt for BSD license
|
|
|
|
|
2009-11-05 23:22:21 -05:00
|
|
|
USING: sequences kernel arrays vectors accessors assocs shuffle sorting locals math math.functions ;
|
2008-10-01 22:58:53 -04:00
|
|
|
|
|
|
|
IN: math.binpack
|
|
|
|
|
|
|
|
: (binpack) ( bins item -- )
|
2008-10-02 02:44:45 -04:00
|
|
|
[ [ values sum ] map ] keep
|
|
|
|
zip sort-keys values first push ;
|
2008-10-01 22:58:53 -04:00
|
|
|
|
2009-11-05 23:22:21 -05:00
|
|
|
:: binpack ( assoc n -- bins )
|
|
|
|
assoc sort-values <reversed> :> values
|
|
|
|
values length :> #values
|
|
|
|
n #values n / ceiling <array> [ <vector> ] map :> bins
|
|
|
|
values [ bins (binpack) ] each
|
|
|
|
bins ;
|
2008-10-01 22:58:53 -04:00
|
|
|
|
|
|
|
: binpack* ( items n -- bins )
|
|
|
|
[ dup zip ] dip binpack [ keys ] map ;
|
|
|
|
|
|
|
|
: binpack! ( items quot n -- bins )
|
2009-04-15 20:03:44 -04:00
|
|
|
[ dupd map zip ] dip binpack [ keys ] map ; inline
|
2008-10-01 22:58:53 -04:00
|
|
|
|