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

_finally_ cleaned up miller-rabin. it's passable now

db4
Doug Coleman 2009-05-05 23:25:26 -05:00
parent 8e8623aef0
commit 3e16463f28
1 changed files with 15 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
basis/math/miller-rabin/miller-rabin.factor
View File

@ -6,31 +6,28 @@ IN: math.miller-rabin
<PRIVATE <PRIVATE
: >odd ( n -- int ) dup even? [ 1+ ] when ; foldable : >odd ( n -- int ) dup even? [ 1 + ] when ; foldable
TUPLE: positive-even-expected n ; TUPLE: positive-even-expected n ;
:: (miller-rabin) ( n trials -- ? ) :: (miller-rabin) ( n trials -- ? )
[let | r [ n 1- factor-2s drop ] n 1 - :> n-1
s [ n 1- factor-2s nip ] n-1 factor-2s :> s :> r
prime?! [ t ] 0 :> a!
a! [ 0 ]
count! [ 0 ] |
trials [ trials [
n 1- [1,b] random a! drop
n-1 [1,b] random a!
a s n ^mod 1 = [ a s n ^mod 1 = [
0 count! f
r [ ] [
2^ s * a swap n ^mod n - -1 = r [ 2^ s * a swap n ^mod n - -1 = ] any?
[ count 1+ count! r + ] when ] if
] each ] any? ;
count zero? [ f prime?! trials + ] when
] unless drop
] each prime? ] ;
PRIVATE> PRIVATE>
: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ; : next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ;
: miller-rabin* ( n numtrials -- ? ) : miller-rabin* ( n numtrials -- ? )
over { over {