]> gitweb.factorcode.org Git - factor.git/commitdiff
Clean up combinations a bit
authorAaron Schaefer <aaron@elasticdog.com>
Thu, 7 May 2009 00:18:21 +0000 (20:18 -0400)
committerAaron Schaefer <aaron@elasticdog.com>
Thu, 7 May 2009 00:18:21 +0000 (20:18 -0400)
basis/math/combinatorics/combinatorics.factor

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