packages feed

nth-prime 1.0 → 1.1

raw patch · 5 files changed

+241/−8 lines, 5 files

Files

nth-prime.cabal view
@@ -1,5 +1,5 @@ name: nth-prime-version: 1.0+version: 1.1 category: Number Theory synopsis: Computing the nth prime license: MIT@@ -16,21 +16,21 @@     base >= 4.0 && < 5.0,     opentheory-primitive >= 1.0 && < 2.0,     opentheory-prime >= 1.0 && < 2.0-   hs-source-dirs: src-   ghc-options: -Wall-   main-is: Main.hs+  other-modules:+    GenuineSieve,+    Heap,+    NaiveSieve,+    OptimizedSieve -executable nth-prime-test+test-suite nth-prime-test+  type: exitcode-stdio-1.0   build-depends:     base >= 4.0 && < 5.0,     opentheory-primitive >= 1.0 && < 2.0,     opentheory-prime >= 1.0 && < 2.0-   hs-source-dirs: src-   ghc-options: -Wall-   main-is: Test.hs
+ src/GenuineSieve.hs view
@@ -0,0 +1,53 @@+{- |+module: GenuineSieve+description: A simple implementation of the genuine sieve of Eratosphenes+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module GenuineSieve+  ( primes )+where++import OpenTheory.Primitive.Natural+import qualified Heap++newtype Sieve = Sieve { unSieve :: Heap.Heap (Natural,Natural) }++instance Show Sieve where+  show s = show (unSieve s)++initial :: Sieve+initial =+    Sieve (Heap.empty lep)+  where+    lep (kp1,_) (kp2,_) = kp1 <= kp2++-- let p = 2 * m + 1+-- 2m' + 1 = p * p = (2m + 1) * (2m + 1) = 2(((2m + 1) + 1) * m) + 1+-- Therefore, m' = ((2m + 1) + 1) * m = (p + 1) * m+add :: Natural -> Sieve -> (Natural,Sieve)+add m (Sieve ps) =+    (p, Sieve (Heap.add (m',p) ps))+  where+    p = 2 * m + 1+    m' = (p + 1) * m++bump :: Sieve -> (Natural,Sieve)+bump (Sieve ps) =+    case Heap.remove ps of+      Nothing -> error "GenuineSieve.bump"+      Just ((kp,p),ps') -> (kp, Sieve (Heap.add (kp + p, p) ps'))++advance :: Natural -> Natural -> Sieve -> [Natural]+advance m n s =+    if m < n+      then let (p,s') = add m s in p : advance m' n s'+      else let (n',s') = bump s in advance (if m == n then m' else m) n' s'+  where+    m' = m + 1++primes :: [Natural]+primes = 2 : advance 1 4 initial
+ src/Heap.hs view
@@ -0,0 +1,84 @@+{- |+module: Heap+description: Leftist heaps+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module Heap+  ( Heap,+    size,+    isEmpty,+    empty,+    add,+    remove,+    toList )+where++data Node a =+    E+  | T Int a (Node a) (Node a)+  deriving Show++data Heap a =+    Heap (a -> a -> Bool) Int (Node a)++singleton :: a -> Node a+singleton a = T 1 a E E++rank :: Node a -> Int+rank E = 0+rank (T r _ _ _) = r++mkT :: a -> Node a -> Node a -> Node a+mkT a x y =+    if rx <= ry+      then T (rx + 1) a y x+      else T (ry + 1) a x y+  where+    rx = rank x+    ry = rank y++merge :: (a -> a -> Bool) -> Node a -> Node a -> Node a+merge le =+    mrg+  where+    mrg n1 n2 =+      case n1 of+        E -> n2+        T _ a1 x1 y1 ->+          case n2 of+            E -> n1+            T _ a2 x2 y2 ->+              if le a1 a2+                then mkT a1 x1 (mrg y1 n2)+                else mkT a2 x2 (mrg n1 y2)++size :: Heap a -> Int+size (Heap _ k _) = k++isEmpty :: Heap a -> Bool+isEmpty h = size h == 0++empty :: (a -> a -> Bool) -> Heap a+empty le = Heap le 0 E++add :: a -> Heap a -> Heap a+add a (Heap le k n) = Heap le (k + 1) (merge le (singleton a) n)++remove :: Heap a -> Maybe (a, Heap a)+remove (Heap le k n) =+    case n of+      E -> Nothing+      T _ a x y -> Just (a, Heap le (k - 1) (merge le x y))++toList :: Heap a -> [a]+toList h =+    case remove h of+      Nothing -> []+      Just (a,h') -> a : toList h'++instance Show a => Show (Heap a) where+  show = show . toList
+ src/NaiveSieve.hs view
@@ -0,0 +1,46 @@+{- |+module: NaiveSieve+description: A straightforward implementation of the naive sieve algorithm+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}+module NaiveSieve+  ( primes )+where++import qualified Data.List as List+import OpenTheory.Primitive.Natural++newtype Sieve =+  Sieve { unSieve :: (Natural,[(Natural,Natural)]) }++perimeter :: Sieve -> Natural+perimeter s = fst (unSieve s)++initial :: Sieve+initial = Sieve (1,[])++next :: Sieve -> (Natural,Sieve)+next s =+    let (b, s') = increment s in+    if b then (perimeter s', s') else next s'++increment :: Sieve -> (Bool,Sieve)+increment =+  \s ->+    let (n,ps) = unSieve s in+    let n' = n + 1 in+    let ps' = inc ps in+    let b = check ps' in+    let ps'' = if b then ps' ++ [(n',0)] else ps' in+    (b, Sieve (n', ps''))+  where+    inc = map (\(p,k) -> (p, (k + 1) `mod` p))++    check = List.all (\(_,k) -> k /= 0)++primes :: [Natural]+primes = List.unfoldr (Just . next) initial
+ src/OptimizedSieve.hs view
@@ -0,0 +1,50 @@+{- |+module: $Header$+description: Prime natural numbers+license: MIT++maintainer: Joe Leslie-Hurd <joe@gilith.com>+stability: provisional+portability: portable+-}++module OptimizedSieve+where++import qualified Data.List as List+import OpenTheory.Primitive.Natural++newtype Sieve =+  Sieve { unSieve :: (Natural,[(Natural,(Natural,Natural))]) }++initial :: Sieve+initial = Sieve (1,[])++increment :: Sieve -> (Bool,Sieve)+increment =+  \s ->+    let (n,ps) = unSieve s in+    let n' = n + 1 in+    let (b,ps') = inc n' 1 ps in+    (b, Sieve (n',ps'))+  where+  {-inc ::+        Natural -> Natural -> [(Natural,(Natural,Natural))] ->+          (Bool,[(Natural,(Natural,Natural))])-}+    inc n _ [] = (True, (n,(0,0)) : [])+    inc n i ((p,(k,j)) : ps) =+      let k' = (k + i) `mod` p in+      let j' = j + i in+      if k' == 0 then (False, (p,(0,j')) : ps)+      else let (b,ps') = inc n j' ps in (b, (p,(k',0)) : ps')++perimeter :: Sieve -> Natural+perimeter s = fst (unSieve s)++next :: Sieve -> (Natural,Sieve)+next s =+  let (b,s') = increment s in+  if b then (perimeter s', s') else next s'++primes :: [Natural]+primes = List.unfoldr (Just . next) initial