From b0ad7dfebc5d176c303f482d643fdccbe724ec18 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 1 Oct 2008 19:58:53 -0700
Subject: [PATCH] Adding bin-packing routines in extra/math/binpack.

---
 extra/math/binpack/authors.txt          |  1 +
 extra/math/binpack/binpack-docs.factor  | 19 +++++++++++++++++++
 extra/math/binpack/binpack-tests.factor | 11 +++++++++++
 extra/math/binpack/binpack.factor       | 21 +++++++++++++++++++++
 extra/math/binpack/summary.txt          |  1 +
 5 files changed, 53 insertions(+)
 create mode 100644 extra/math/binpack/authors.txt
 create mode 100644 extra/math/binpack/binpack-docs.factor
 create mode 100644 extra/math/binpack/binpack-tests.factor
 create mode 100644 extra/math/binpack/binpack.factor
 create mode 100644 extra/math/binpack/summary.txt

diff --git a/extra/math/binpack/authors.txt b/extra/math/binpack/authors.txt
new file mode 100644
index 0000000000..e091bb8164
--- /dev/null
+++ b/extra/math/binpack/authors.txt
@@ -0,0 +1 @@
+John Benediktsson
diff --git a/extra/math/binpack/binpack-docs.factor b/extra/math/binpack/binpack-docs.factor
new file mode 100644
index 0000000000..36a29c7aa1
--- /dev/null
+++ b/extra/math/binpack/binpack-docs.factor
@@ -0,0 +1,19 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: help.syntax help.markup kernel assocs sequences quotations ;
+
+IN: math.binpack 
+
+HELP: binpack
+{ $values { "assoc" assoc } { "n" "number of bins" } { "bins" "packed bins" } }
+{ $description "Packs the (key, value) pairs into the specified number of bins, using the value as a weight." } ;
+
+HELP: binpack*
+{ $values { "items" sequence } { "n" "number of bins" } { "bins" "packed bins" } } 
+{ $description "Packs a sequence of numbers into the specified number of bins." } ;
+
+HELP: binpack!
+{ $values { "items" sequence } { "quot" quotation } { "n" "number of bins" } { "bins" "packed bins" } } 
+{ $description "Packs a sequence of items into the specified number of bins, using the quotatino to determine the weight." } ;
+
diff --git a/extra/math/binpack/binpack-tests.factor b/extra/math/binpack/binpack-tests.factor
new file mode 100644
index 0000000000..6f94b8ce22
--- /dev/null
+++ b/extra/math/binpack/binpack-tests.factor
@@ -0,0 +1,11 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel tools.test ;
+
+[ t ] [ { { 3 } { 2 1 } } { 1 2 3 } 2 binpack-numbers = ] unit-test
+
+[ t ] [ { { 1000 } { 100 30 } { 70 40 23 } { 60 60 7 3 } } 
+        { 100 23 40 60 1000 30 60 07 70 03 } 3 binpack-numbers = ] unit-test
+
+
diff --git a/extra/math/binpack/binpack.factor b/extra/math/binpack/binpack.factor
new file mode 100644
index 0000000000..6885789ee1
--- /dev/null
+++ b/extra/math/binpack/binpack.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: sequences kernel arrays vectors accessors assocs sorting math math.functions ;
+
+IN: math.binpack 
+
+: (binpack) ( bins item -- )
+    swap dup [ [ second ] map sum ] map swap zip sort-keys values first push ;
+
+: binpack ( assoc n -- bins )
+    [ sort-values reverse [ length ] keep swap ] dip 
+    [ / ceiling ] keep <array> [ <vector> ] map 
+    swap [ dupd (binpack) ] each ;
+
+: binpack* ( items n -- bins )
+    [ dup zip ] dip binpack [ keys ] map ;
+
+: binpack! ( items quot n -- bins ) 
+    [ dup ] 2dip [ map zip ] dip binpack [ keys ] map ;
+
diff --git a/extra/math/binpack/summary.txt b/extra/math/binpack/summary.txt
new file mode 100644
index 0000000000..c8b91966bb
--- /dev/null
+++ b/extra/math/binpack/summary.txt
@@ -0,0 +1 @@
+Bin-packing algorithms.