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

math.combinatorics: faster by using hints for the array common case.

db4
John Benediktsson 2013-05-01 11:18:17 -07:00
parent 55a9df63f7
commit c1ab4aab59
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs binary-search classes.tuple fry USING: accessors arrays assocs binary-search classes.tuple fry
kernel locals math math.order math.ranges memoize namespaces hints kernel locals math math.order math.ranges memoize
sequences sequences.private sorting ; namespaces sequences sequences.private sorting ;
FROM: sequences => change-nth ; FROM: sequences => change-nth ;
IN: math.combinatorics IN: math.combinatorics
@ -100,13 +100,13 @@ PRIVATE>
<PRIVATE <PRIVATE
: cut-point ( seq -- n ) : cut-point ( seq -- n )
[ last ] keep [ [ > ] keep swap ] find-last drop nip ; [ last ] keep [ [ > ] keep swap ] find-last drop nip ; inline
: greater-from-last ( n seq -- i ) : greater-from-last ( n seq -- i )
[ nip ] [ nth ] 2bi [ > ] curry find-last drop ; [ nip ] [ nth ] 2bi [ > ] curry find-last drop ; inline
: reverse-tail! ( n seq -- seq ) : reverse-tail! ( n seq -- seq )
[ swap 1 + tail-slice reverse! drop ] keep ; [ swap 1 + tail-slice reverse! drop ] keep ; inline
: (next-permutation) ( seq -- seq ) : (next-permutation) ( seq -- seq )
dup cut-point [ dup cut-point [
@ -114,6 +114,8 @@ PRIVATE>
[ exchange ] [ reverse-tail! nip ] 3bi [ exchange ] [ reverse-tail! nip ] 3bi
] [ reverse! ] if* ; ] [ reverse! ] if* ;
HINTS: (next-permutation) array ;
PRIVATE> PRIVATE>
: next-permutation ( seq -- seq ) : next-permutation ( seq -- seq )
@ -162,14 +164,14 @@ INSTANCE: combinations immutable-sequence
<PRIVATE <PRIVATE
: find-max-index ( seq n -- i ) : find-max-index ( seq n -- i )
over length - '[ _ + >= ] find-index drop ; over length - '[ _ + >= ] find-index drop ; inline
: increment-rest ( i seq -- ) : increment-rest ( i seq -- )
[ nth ] [ swap tail-slice ] 2bi [ nth ] [ swap tail-slice ] 2bi
[ drop 1 + dup ] map! 2drop ; [ drop 1 + dup ] map! 2drop ; inline
: increment-last ( seq -- ) : increment-last ( seq -- )
[ [ length 1 - ] keep [ 1 + ] change-nth ] unless-empty ; [ [ length 1 - ] keep [ 1 + ] change-nth ] unless-empty ; inline
:: next-combination ( seq n -- seq ) :: next-combination ( seq n -- seq )
seq n find-max-index [ seq n find-max-index [
@ -178,6 +180,8 @@ INSTANCE: combinations immutable-sequence
seq increment-last seq increment-last
] if* seq ; ] if* seq ;
HINTS: next-combination array fixnum ;
:: combinations-quot ( seq k quot -- seq quot' ) :: combinations-quot ( seq k quot -- seq quot' )
seq length :> n seq length :> n
n k nCk iota k iota >array seq quot n n k nCk iota k iota >array seq quot n