add lucas-lehmer primality test
parent
79265b50d9
commit
0801dbc694
basis/math/primes/lucas-lehmer
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,25 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax kernel ;
|
||||
IN: math.primes.lucas-lehmer
|
||||
|
||||
HELP: lucas-lehmer
|
||||
{ $values
|
||||
{ "p" "a prime number" }
|
||||
{ "?" "a boolean" }
|
||||
}
|
||||
{ $description "Runs the Lucas-Lehmer test on the prime " { $snippet "p" } " and returns " { $link t } " if " { $snippet "(2 ^ p) - 1" } " is prime." }
|
||||
{ $examples
|
||||
{ $example "! Test that (2 ^ 61) - 1 is prime:"
|
||||
"USING: math.primes.lucas-lehmer prettyprint ;"
|
||||
"61 lucas-lehmer ."
|
||||
"t"
|
||||
}
|
||||
} ;
|
||||
|
||||
ARTICLE: "math.primes.lucas-lehmer" "Lucas-Lehmer Mersenne Primality test"
|
||||
"The " { $vocab-link "math.primes.lucas-lehmer" } " vocabulary tests numbers of the form " { $snippet "(2 ^ p) - 1" } " for primality, where " { $snippet "p" } " is prime." $nl
|
||||
"Run the Lucas-Lehmer test:"
|
||||
{ $subsection lucas-lehmer } ;
|
||||
|
||||
ABOUT: "math.primes.lucas-lehmer"
|
|
@ -0,0 +1,13 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test math.primes.lucas-lehmer ;
|
||||
IN: math.primes.lucas-lehmer.tests
|
||||
|
||||
[ t ] [ 2 lucas-lehmer ] unit-test
|
||||
[ t ] [ 3 lucas-lehmer ] unit-test
|
||||
[ f ] [ 4 lucas-lehmer ] unit-test
|
||||
[ t ] [ 5 lucas-lehmer ] unit-test
|
||||
[ f ] [ 6 lucas-lehmer ] unit-test
|
||||
[ f ] [ 11 lucas-lehmer ] unit-test
|
||||
[ t ] [ 13 lucas-lehmer ] unit-test
|
||||
[ t ] [ 61 lucas-lehmer ] unit-test
|
|
@ -0,0 +1,27 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators fry kernel locals math
|
||||
math.primes combinators.short-circuit ;
|
||||
IN: math.primes.lucas-lehmer
|
||||
|
||||
ERROR: invalid-lucas-lehmer-candidate obj ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: do-lucas-lehmer ( p -- ? )
|
||||
[ drop 4 ] [ 2 - ] [ 2^ 1 - ] tri
|
||||
'[ sq 2 - _ mod ] times 0 = ;
|
||||
|
||||
: lucas-lehmer-guard ( obj -- obj )
|
||||
dup { [ integer? ] [ 0 > ] } 1&&
|
||||
[ invalid-lucas-lehmer-candidate ] unless ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: lucas-lehmer ( p -- ? )
|
||||
lucas-lehmer-guard
|
||||
{
|
||||
{ [ dup 2 = ] [ drop t ] }
|
||||
{ [ dup prime? ] [ do-lucas-lehmer ] }
|
||||
[ drop f ]
|
||||
} cond ;
|
Loading…
Reference in New Issue