steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.combinatorics: fix failed find combinations/permutations.

db4
John Benediktsson 2012-04-21 20:11:47 -07:00
parent bada993f78
commit c00ddde434
2 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/math/combinatorics/combinatorics-tests.factor
View 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

12
basis/math/combinatorics/combinatorics.factor
View 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