_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

View File

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