extra/math/binpack/binpack.factor

   1 ! Copyright (C) 2008 John Benediktsson
   2 ! See https://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs kernel math sequences sorting ;
   5
   6 IN: math.binpack
   7
   8 <PRIVATE
   9
  10 TUPLE: bin items total ;
  11
  12 : <bin> ( -- bin )
  13     V{ } clone 0 bin boa ; inline
  14
  15 : smallest-bin ( bins -- bin )
  16     [ total>> ] infimum-by ; inline
  17
  18 : add-to-bin ( item weight bin -- )
  19     [ + ] change-total items>> push ;
  20
  21 :: (binpack) ( alist #bins -- bins )
  22     alist sort-values <reversed> :> items
  23     #bins [ <bin> ] replicate :> bins
  24     items [ bins smallest-bin add-to-bin ] assoc-each
  25     bins [ items>> ] map ;
  26
  27 PRIVATE>
  28
  29 : binpack ( items #bins -- bins )
  30     [ dup zip ] dip (binpack) ;
  31
  32 : map-binpack ( items quot: ( item -- weight ) #bins -- bins )
  33     [ dupd map zip ] dip (binpack) ; inline