From 0801dbc6940ffb52600724abcc9518b7f0660d57 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Sun, 10 May 2009 12:59:35 -0500
Subject: [PATCH] add lucas-lehmer primality test
---
basis/math/primes/lucas-lehmer/authors.txt | 1 +
.../lucas-lehmer/lucas-lehmer-docs.factor | 25 +++++++++++++++++
.../lucas-lehmer/lucas-lehmer-tests.factor | 13 +++++++++
.../primes/lucas-lehmer/lucas-lehmer.factor | 27 +++++++++++++++++++
4 files changed, 66 insertions(+)
create mode 100644 basis/math/primes/lucas-lehmer/authors.txt
create mode 100644 basis/math/primes/lucas-lehmer/lucas-lehmer-docs.factor
create mode 100644 basis/math/primes/lucas-lehmer/lucas-lehmer-tests.factor
create mode 100644 basis/math/primes/lucas-lehmer/lucas-lehmer.factor
diff --git a/basis/math/primes/lucas-lehmer/authors.txt b/basis/math/primes/lucas-lehmer/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/basis/math/primes/lucas-lehmer/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/basis/math/primes/lucas-lehmer/lucas-lehmer-docs.factor b/basis/math/primes/lucas-lehmer/lucas-lehmer-docs.factor
new file mode 100644
index 0000000000..582b59b69a
--- /dev/null
+++ b/basis/math/primes/lucas-lehmer/lucas-lehmer-docs.factor
@@ -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"
diff --git a/basis/math/primes/lucas-lehmer/lucas-lehmer-tests.factor b/basis/math/primes/lucas-lehmer/lucas-lehmer-tests.factor
new file mode 100644
index 0000000000..b114fa8553
--- /dev/null
+++ b/basis/math/primes/lucas-lehmer/lucas-lehmer-tests.factor
@@ -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
diff --git a/basis/math/primes/lucas-lehmer/lucas-lehmer.factor b/basis/math/primes/lucas-lehmer/lucas-lehmer.factor
new file mode 100644
index 0000000000..a8bf097dbe
--- /dev/null
+++ b/basis/math/primes/lucas-lehmer/lucas-lehmer.factor
@@ -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 ;