]> gitweb.factorcode.org Git - factor.git/commitdiff
math.combinatorics: fix failed find combinations/permutations.
authorJohn Benediktsson <mrjbq7@gmail.com>
Sun, 22 Apr 2012 03:11:47 +0000 (20:11 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 22 Apr 2012 03:11:47 +0000 (20:11 -0700)
basis/math/combinatorics/combinatorics-tests.factor
basis/math/combinatorics/combinatorics.factor

index 14b662b63b8103b559e66afecacbf0030bebf2b5..ac0933fdbe96fefa42a1b202ae065d51dc6ccdd7 100644 (file)
@@ -107,6 +107,8 @@ IN: math.combinatorics.tests
 { { 6 6 6 6 6 6 } }
 [ { 1 2 3 } [ sum ] map-permutations ] unit-test
 
+{ f } [ { 1 2 3 } 2 [ last 4 = ] find-combination ] unit-test
 { { 2 3 } } [ { 1 2 3 } 2 [ first 2 = ] find-combination ] unit-test
 
+{ f } [ { 1 2 3 } [ last 4 = ] find-permutation ] unit-test
 { { 2 1 3 } } [ { 1 2 3 } [ first 2 = ] find-permutation ] unit-test
index 59dd83fa282a8b27f6c81e4a2e714806ea8e1acd..6b9075d554649ac1370aa386ab137615b43b5d09 100644 (file)
@@ -67,7 +67,8 @@ PRIVATE>
 
 : find-permutation ( seq quot -- elt )
     [ dup [ permutation-iota ] keep ] dip
-    '[ _ permutation @ ] find drop swap permutation ; inline
+    '[ _ permutation @ ] find drop
+    [ swap permutation ] [ drop f ] if* ; inline
 
 : reduce-permutations ( seq identity quot -- result )
     swapd each-permutation ; inline
@@ -146,6 +147,9 @@ C: <combo> combo
 
 PRIVATE>
 
+: combination ( m seq k -- seq' )
+    <combo> apply-combination ;
+
 : each-combination ( seq k quot -- )
     combinations-quot each ; inline
 
@@ -158,14 +162,12 @@ PRIVATE>
 : map>assoc-combinations ( seq k quot exemplar -- )
     [ combinations-quot ] dip map>assoc ; inline
 
-: combination ( m seq k -- seq' )
-    <combo> apply-combination ;
-
 : all-combinations ( seq k -- seq' )
     [ ] map-combinations ;
 
 : find-combination ( seq k quot -- i elt )
-    [ combinations-quot find drop ] [ drop combination ] 3bi ; inline
+    [ combinations-quot find drop ]
+    [ drop pick [ combination ] [ 3drop f ] if ] 3bi ; inline
 
 : reduce-combinations ( seq k identity quot -- result )
     [ -rot ] dip each-combination ; inline