steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math-binpack: Some cleanups recommended on IRC.

db4
John Benediktsson 2008-10-01 23:44:45 -07:00
parent 9cd9a98ce9
commit 1c76a6865a
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
extra/math/binpack/binpack.factor
View File

@ -6,16 +6,17 @@ USING: sequences kernel arrays vectors accessors assocs sorting math math.functi
IN: math.binpack IN: math.binpack
: (binpack) ( bins item -- ) : (binpack) ( bins item -- )
swap dup [ [ second ] map sum ] map swap zip sort-keys values first push ; [ [ values sum ] map ] keep
zip sort-keys values first push ;
: binpack ( assoc n -- bins ) : binpack ( assoc n -- bins )
[ sort-values reverse [ length ] keep swap ] dip [ sort-values <reversed> dup length ] dip
[ / ceiling ] keep swap <array> [ <vector> ] map tuck / ceiling <array> [ <vector> ] map
swap [ dupd (binpack) ] each ; tuck [ (binpack) ] curry each ;
: binpack* ( items n -- bins ) : binpack* ( items n -- bins )
[ dup zip ] dip binpack [ keys ] map ; [ dup zip ] dip binpack [ keys ] map ;
: binpack! ( items quot n -- bins ) : binpack! ( items quot n -- bins )
[ dup ] 2dip [ map zip ] dip binpack [ keys ] map ; [ dupd map zip ] dip binpack [ keys ] map ;