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* ;
							 |