Generalize factor-2s to eliminate special case exception
parent
8bc631f5ed
commit
76558babf4
|
@ -26,10 +26,8 @@ TUPLE: positive-even-expected n ;
|
|||
dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
|
||||
|
||||
: factor-2s ( n -- r s )
|
||||
#! factor an even number into s * 2 ^ r
|
||||
dup even? over 0 > and [
|
||||
positive-even-expected construct-boa throw
|
||||
] unless 0 swap (factor-2s) ;
|
||||
#! factor an integer into s * 2^r
|
||||
0 swap (factor-2s) ;
|
||||
|
||||
:: (miller-rabin) | n prime?! |
|
||||
n 1- factor-2s s set r set
|
||||
|
|
|
@ -34,9 +34,6 @@ IN: project-euler.common
|
|||
: propagate ( bottom top -- newtop )
|
||||
[ 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 )
|
||||
rot 1 tail -rot ;
|
||||
|
||||
|
@ -92,7 +89,7 @@ PRIVATE>
|
|||
|
||||
! Optimized brute-force, is often faster than prime factorization
|
||||
: tau* ( m -- n )
|
||||
reduce-2s [ perfect-square? -1 0 ? ] keep
|
||||
factor-2s [ 1+ ] dip [ perfect-square? -1 0 ? ] keep
|
||||
dup sqrt >fixnum [1,b] [
|
||||
dupd mod zero? [ >r 2 + r> ] when
|
||||
dupd mod zero? [ [ 2 + ] dip ] when
|
||||
] each drop * ;
|
||||
|
|
Loading…
Reference in New Issue