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

Clean up combinations a bit

db4
Aaron Schaefer 2009-05-06 20:18:21 -04:00
parent c9b97f3f92
commit 678f603aa5
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
basis/math/combinatorics/combinatorics.factor
View File

@ -46,7 +46,8 @@ PRIVATE>
[ permutation-indices ] keep nths ; [ permutation-indices ] keep nths ;
: all-permutations ( seq -- seq ) : all-permutations ( seq -- seq )
[ length factorial ] keep '[ _ permutation ] map ; [ length factorial ] keep
'[ _ permutation ] map ;
: each-permutation ( seq quot -- ) : each-permutation ( seq quot -- )
[ [ length factorial ] keep ] dip [ [ length factorial ] keep ] dip
@ -69,6 +70,9 @@ TUPLE: combo
C: <combo> combo C: <combo> combo
: choose ( combo -- nCk )
[ seq>> length ] [ k>> ] bi nCk ;
: largest-value ( a b x -- v ) : largest-value ( a b x -- v )
#! TODO: use a binary search instead of find-last #! TODO: use a binary search instead of find-last
[ [0,b) ] 2dip '[ _ nCk _ <= ] find-last nip ; [ [0,b) ] 2dip '[ _ nCk _ <= ] find-last nip ;
@ -79,26 +83,23 @@ C: <combo> combo
x v b nCk - ! x' x v b nCk - ! x'
v ; ! v == a' v ; ! v == a'
: dual-index ( combo m -- x ) : dual-index ( m combo -- m' )
[ [ seq>> length ] [ k>> ] bi nCk 1 - ] dip - ; choose 1 - swap - ;
: initial-values ( combo m -- a b x ) : initial-values ( combo m -- n k m )
[ [ seq>> length ] [ k>> ] [ ] tri ] dip dual-index ; [ [ seq>> length ] [ k>> ] bi ] dip ;
: combinadic ( combo m -- combinadic ) : combinadic ( combo m -- combinadic )
initial-values [ over 0 > ] [ next-values ] produce initial-values [ over 0 > ] [ next-values ] produce
[ 3drop ] dip ; [ 3drop ] dip ;
: combination-indices ( m combo -- seq ) : combination-indices ( m combo -- seq )
[ swap combinadic ] keep [ tuck dual-index combinadic ] keep
seq>> length 1 - swap [ - ] with map ; seq>> length 1 - swap [ - ] with map ;
: apply-combination ( m combo -- seq ) : apply-combination ( m combo -- seq )
[ combination-indices ] keep seq>> nths ; [ combination-indices ] keep seq>> nths ;
: choose ( combo -- nCk )
[ seq>> length ] [ k>> ] bi nCk ;
PRIVATE> PRIVATE>
: combination ( m seq k -- seq ) : combination ( m seq k -- seq )