2009-05-07 18:33:55 -04:00
|
|
|
! Copyright (c) 2008-2009 Doug Coleman.
|
2008-10-03 03:19:03 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-05-10 14:47:51 -04:00
|
|
|
USING: combinators combinators.short-circuit kernel locals math
|
|
|
|
math.functions math.ranges random sequences sets ;
|
2009-05-10 13:24:43 -04:00
|
|
|
IN: math.primes.miller-rabin
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-05-07 21:52:16 -04:00
|
|
|
<PRIVATE
|
2008-01-13 12:51:46 -05:00
|
|
|
|
2008-05-10 14:06:40 -04:00
|
|
|
:: (miller-rabin) ( n trials -- ? )
|
2009-05-06 00:25:26 -04:00
|
|
|
n 1 - :> n-1
|
2009-10-28 17:11:33 -04:00
|
|
|
n-1 factor-2s :> ( r s )
|
2009-05-06 00:25:26 -04:00
|
|
|
0 :> a!
|
2010-01-14 10:10:13 -05:00
|
|
|
trials iota [
|
2009-05-06 13:21:30 -04:00
|
|
|
drop
|
2009-05-06 17:26:06 -04:00
|
|
|
2 n 2 - [a,b] random a!
|
2009-05-06 00:25:26 -04:00
|
|
|
a s n ^mod 1 = [
|
2009-05-06 13:21:30 -04:00
|
|
|
f
|
|
|
|
] [
|
2009-05-06 01:54:14 -04:00
|
|
|
r iota [
|
|
|
|
2^ s * a swap n ^mod n - -1 =
|
2009-05-07 18:33:55 -04:00
|
|
|
] any? not
|
2009-05-06 13:21:30 -04:00
|
|
|
] if
|
|
|
|
] any? not ;
|
2009-05-06 01:54:14 -04:00
|
|
|
|
2008-12-26 14:58:46 -05:00
|
|
|
PRIVATE>
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: miller-rabin* ( n numtrials -- ? )
|
|
|
|
over {
|
|
|
|
{ [ dup 1 <= ] [ 3drop f ] }
|
|
|
|
{ [ dup 2 = ] [ 3drop t ] }
|
2008-01-13 01:07:49 -05:00
|
|
|
{ [ dup even? ] [ 3drop f ] }
|
2008-12-27 17:13:03 -05:00
|
|
|
[ drop (miller-rabin) ]
|
2007-09-20 18:09:08 -04:00
|
|
|
} cond ;
|
|
|
|
|
|
|
|
: miller-rabin ( n -- ? ) 10 miller-rabin* ;
|