add lucas-lehmer primality test

db4
Doug Coleman 2009-05-10 12:59:35 -05:00
parent 79265b50d9
commit 0801dbc694
4 changed files with 66 additions and 0 deletions

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -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"

View File

@ -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

View File

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