From 0322b4d0284207932bd21e38be8ccea58d47065e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 18 Apr 2012 15:17:48 -0700
Subject: [PATCH] math.combinators: Add filter-permutations/combinations. Minor
 cleanup.

---
 .../combinatorics/combinatorics-tests.factor   | 12 ++++++++++++
 basis/math/combinatorics/combinatorics.factor  | 18 +++++++++++++-----
 2 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/basis/math/combinatorics/combinatorics-tests.factor b/basis/math/combinatorics/combinatorics-tests.factor
index ad10a1c8b7..bdbbece4f5 100644
--- a/basis/math/combinatorics/combinatorics-tests.factor
+++ b/basis/math/combinatorics/combinatorics-tests.factor
@@ -94,3 +94,15 @@ IN: math.combinatorics.tests
     { 2 1 1 } { 2 1 2 } { 2 2 1 } { 2 2 2 } } ]
 [ { 1 2 } 3 selections ] unit-test
 
+
+{ V{ { 1 2 } { 1 3 } } }
+[ { 1 2 3 } 2 [ { 1 } head? ] filter-combinations ] unit-test
+
+{ { 3 4 5 } }
+[ { 1 2 3 } 2 [ sum ] map-combinations ] unit-test
+
+{ V{ { 1 2 3 } { 1 3 2 } } }
+[ { 1 2 3 } [ { 1 } head? ] filter-permutations ] unit-test
+
+{ { 6 6 6 6 6 6 } }
+[ { 1 2 3 } [ sum ] map-permutations ] unit-test
diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor
index 962a2888d0..4652cd6a11 100644
--- a/basis/math/combinatorics/combinatorics.factor
+++ b/basis/math/combinatorics/combinatorics.factor
@@ -42,23 +42,29 @@ PRIVATE>
 : permutation-indices ( n seq -- permutation )
     length [ factoradic ] dip 0 pad-head >permutation ;
 
+: permutation-iota ( seq -- iota )
+    length factorial iota ; inline
+
 PRIVATE>
 
 : permutation ( n seq -- seq' )
     [ permutation-indices ] keep nths ;
 
 : all-permutations ( seq -- seq' )
-    [ length factorial iota ] keep
+    [ permutation-iota ] keep
     '[ _ permutation ] map ;
 
 : each-permutation ( seq quot -- )
-    [ [ length factorial iota ] keep ] dip
+    [ [ permutation-iota ] keep ] dip
     '[ _ permutation @ ] each ; inline
 
-: map-permutation ( seq quot -- )
-    [ [ length factorial iota ] keep ] dip
+: map-permutations ( seq quot -- seq' )
+    [ [ permutation-iota ] keep ] dip
     '[ _ permutation @ ] map ; inline
 
+: filter-permutations ( seq quot -- seq' )
+    selector [ each-permutation ] dip ; inline
+
 : reduce-permutations ( seq identity quot -- result )
     swapd each-permutation ; inline
 
@@ -142,6 +148,9 @@ PRIVATE>
 : map-combinations ( seq k quot -- )
     combinations-quot map ; inline
 
+: filter-combinations ( seq k quot -- seq' )
+    selector [ each-combination ] dip ; inline
+
 : map>assoc-combinations ( seq k quot exemplar -- )
     [ combinations-quot ] dip map>assoc ; inline
 
@@ -169,4 +178,3 @@ PRIVATE>
 : selections ( seq n -- selections )
     dup 0 > [ (selections) ] [ 2drop { } ] if ;
 
-