diff --git a/basis/math/combinatorics/combinatorics-tests.factor b/basis/math/combinatorics/combinatorics-tests.factor index 14b662b63b..ac0933fdbe 100644 --- a/basis/math/combinatorics/combinatorics-tests.factor +++ b/basis/math/combinatorics/combinatorics-tests.factor @@ -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 diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor index 59dd83fa28..6b9075d554 100644 --- a/basis/math/combinatorics/combinatorics.factor +++ b/basis/math/combinatorics/combinatorics.factor @@ -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 PRIVATE> +: combination ( m seq k -- seq' ) + 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' ) - 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