2009-01-07 14:57:49 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2007-2009 Samuel Tardieu.
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-26 21:59:39 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-07 14:57:49 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: combinators kernel math math.functions math.miller-rabin
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								math.order math.primes.erato math.ranges sequences ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-26 21:59:39 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: math.primes
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-26 14:58:46 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: look-in-bitmap ( n -- ? ) >index 4999999 sieve nth ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-26 21:59:39 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-26 14:58:46 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: really-prime? ( n -- ? )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup 5000000 < [ look-in-bitmap ] [ miller-rabin ] if ; foldable
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-26 21:59:39 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-26 14:58:46 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-26 21:59:39 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: prime? ( n -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-26 14:58:46 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    {
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { [ dup 2 < ] [ drop f ] }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        { [ dup even? ] [ 2 = ] }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ really-prime? ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    } cond ; foldable
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: next-prime ( n -- p )
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-17 20:19:49 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    next-odd [ dup really-prime? ] [ 2 + ] until ; foldable
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-26 21:59:39 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: primes-between ( low high -- seq )
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-28 05:43:13 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ dup 3 max dup even? [ 1 + ] when ] dip
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    2 <range> [ prime? ] filter
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap 3 < [ 2 prefix ] when ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: primes-upto ( n -- seq ) 2 swap primes-between ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-28 00:09:29 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
							 |