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.
|
2014-12-04 22:46:30 -05:00
|
|
|
USING: combinators kernel locals math math.functions math.ranges
|
|
|
|
random sequences ;
|
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 -- ? )
|
2014-12-04 22:48:32 -05:00
|
|
|
n 1 - :> n-1
|
|
|
|
n-1 factor-2s :> ( r s )
|
2009-05-06 00:25:26 -04:00
|
|
|
0 :> a!
|
2017-06-01 17:59:35 -04: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
|
|
|
|
] [
|
2017-06-01 17:59:35 -04:00
|
|
|
r <iota> [
|
2014-12-04 22:48:32 -05:00
|
|
|
2^ s * a swap n ^mod n-1 =
|
2018-02-14 14:56:31 -05:00
|
|
|
] none?
|
2009-05-06 13:21:30 -04:00
|
|
|
] if
|
2018-02-14 14:56:31 -05:00
|
|
|
] none? ;
|
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 -- ? )
|
2014-12-04 22:46:30 -05:00
|
|
|
{
|
|
|
|
{ [ over 1 <= ] [ 2drop f ] }
|
|
|
|
{ [ over even? ] [ drop 2 = ] }
|
|
|
|
[ (miller-rabin) ]
|
2007-09-20 18:09:08 -04:00
|
|
|
} cond ;
|
|
|
|
|
|
|
|
: miller-rabin ( n -- ? ) 10 miller-rabin* ;
|