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

Generalize factor-2s to eliminate special case exception

db4
Aaron Schaefer 2008-01-14 15:04:21 -05:00
parent 8bc631f5ed
commit 76558babf4
2 changed files with 4 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/math/miller-rabin/miller-rabin.factor
View File

@ -26,10 +26,8 @@ TUPLE: positive-even-expected n ;
dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ; dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
: factor-2s ( n -- r s ) : factor-2s ( n -- r s )
#! factor an even number into s * 2 ^ r #! factor an integer into s * 2^r
dup even? over 0 > and [ 0 swap (factor-2s) ;
positive-even-expected construct-boa throw
] unless 0 swap (factor-2s) ;
:: (miller-rabin) | n prime?! | :: (miller-rabin) | n prime?! |
n 1- factor-2s s set r set n 1- factor-2s s set r set

7
extra/project-euler/common/common.factor
View File

@ -34,9 +34,6 @@ IN: project-euler.common
: propagate ( bottom top -- newtop ) : propagate ( bottom top -- newtop )
[ over 1 tail rot first2 max rot + ] map nip ; [ over 1 tail rot first2 max rot + ] map nip ;
: reduce-2s ( n -- r s )
dup even? [ factor-2s >r 1+ r> ] [ 1 swap ] if ;
: shift-3rd ( seq obj obj -- seq obj obj ) : shift-3rd ( seq obj obj -- seq obj obj )
rot 1 tail -rot ; rot 1 tail -rot ;
@ -92,7 +89,7 @@ PRIVATE>
! Optimized brute-force, is often faster than prime factorization ! Optimized brute-force, is often faster than prime factorization
: tau* ( m -- n ) : tau* ( m -- n )
reduce-2s [ perfect-square? -1 0 ? ] keep factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
dup sqrt >fixnum [1,b] [ dup sqrt >fixnum [1,b] [
dupd mod zero? [ >r 2 + r> ] when dupd mod zero? [ [ 2 + ] dip ] when
] each drop * ; ] each drop * ;