factory 0.1.0.2 → 0.1.0.3
raw patch · 6 files changed
+52/−39 lines, 6 files
Files
- changelog +4/−1
- factory.cabal +1/−1
- src/Factory/Data/PrimeWheel.hs +10/−10
- src/Factory/Math/Implementations/Primes.hs +23/−17
- src/Factory/Test/QuickCheck/Primes.hs +13/−9
- src/Main.hs +1/−1
changelog view
@@ -31,5 +31,8 @@ * Added 'Factory.Math.Primes.primorial'. * Altered 'Factory.Math.Implementations.Primes.trialDivision' to take an integer defining the size of a 'Factory.Data.PrimeWheel', from which candidates are extracted. * Removed the command-line option 'primesPerformanceGraph', which appears to memoise data from previous tests.- + * Uploaded to <http://hackage.haskell.org/packages/hackage.html>.+0.1.0.3+ * Qualified 'Factory.Math.Implementations.Primes.trialDivision' with /NOINLINE/ pragma, to block optimization which conflicts with rewrite-rule for 'Factory.Math.Implementations.Primes.sieveOfEratosthenes' !+ * Re-coded 'Factory.Data.PrimeWheel.coprimes' and 'Factory.Math.Implementations.Primes.sieveOfEratosthenes', to use a map of lists, rather than a map of lists of lists.
factory.cabal view
@@ -1,6 +1,6 @@ --Package-properties Name: factory-Version: 0.1.0.2+Version: 0.1.0.3 Cabal-Version: >= 1.6 Copyright: (C) 2011 Dr. Alistair Ward License: GPL
src/Factory/Data/PrimeWheel.hs view
@@ -79,8 +79,8 @@ -- | An infinite increasing sequence, of the multiples of a specific prime. type PrimeMultiples i = [i] --- | Defines a container for the 'PrimeMultiples' of an initial short sequence of primes.-type Repository = Data.IntMap.IntMap [PrimeMultiples Int]+-- | Defines a container for the 'PrimeMultiples'.+type Repository = Data.IntMap.IntMap (PrimeMultiples Int) {- | * Uses a /Sieve of Eratosthenes/ (<http://en.wikipedia.org/wiki/Sieve_of_Eratosthenes>), to generate an initial sequence of primes.@@ -97,13 +97,11 @@ where sieve :: Int -> Int -> Repository -> [Int] sieve candidate found repository = case Data.IntMap.lookup candidate repository of- Just primeMultiplesList -> sieve' found $ foldr insert (- Data.IntMap.delete candidate repository --Remove the matched prime-multiple.- ) primeMultiplesList+ Just primeMultiples -> sieve' found . insertUniq primeMultiples $ Data.IntMap.delete candidate repository --Re-insert subsequent multiples. Nothing -> let found' = succ found (key : values) = iterate (+ gap * candidate) $ candidate ^ (2 :: Int) --Generate a sequence of prime-multiples, starting from its square.- in candidate : sieve' found' (if found' >= required then repository else Data.IntMap.insert key [values] repository)+ in candidate : sieve' found' (if found' >= required then repository else Data.IntMap.insert key values repository) where gap :: Int gap = 2 --For efficiency, only sieve odd integers.@@ -111,9 +109,11 @@ sieve' :: Int -> Repository -> [Int] sieve' = sieve $ candidate + gap --Tail-recurse. - insert :: PrimeMultiples Int -> Repository -> Repository- insert [] = error "Factory.Data.PrimeWheel.insert:\tnull list"- insert (key : values) = Data.IntMap.insertWith (++) key [values]+ insertUniq :: PrimeMultiples Int -> Repository -> Repository+ insertUniq l m = insert (dropWhile (`Data.IntMap.member` m) l) where+ insert :: PrimeMultiples Int -> Repository+ insert [] = error "Factory.Data.PrimeWheel.findCoprimes.sieve.insertUniq.insert:\tnull list"+ insert (key : values) = Data.IntMap.insert key values m {- | * Constructs a /wheel/ from the specified number of low primes.@@ -138,7 +138,7 @@ mkPrimeWheel :: Integral i => Int -> PrimeWheel i mkPrimeWheel 0 = MkPrimeWheel [] [1] mkPrimeWheel nPrimes- | nPrimes < 0 = error $ "Factory.Data.PrimeWheel.mkPrimeWheel: unable to construct a wheel from " ++ show nPrimes ++ " primes"+ | nPrimes < 0 = error $ "Factory.Data.PrimeWheel.mkPrimeWheel: unable to construct from " ++ show nPrimes ++ " primes" | otherwise = primeWheel where (primeComponents, coprimeCandidates) = (map fromIntegral *** map fromIntegral . Data.List.genericTake (getSpokeCount primeWheel)) $ findCoprimes nPrimes
src/Factory/Math/Implementations/Primes.hs view
@@ -56,9 +56,9 @@ import qualified Data.IntMap import qualified Data.List import qualified Data.Map+import qualified Data.Numbers.Primes import Data.Sequence((|>)) import qualified Data.Sequence-import qualified Data.Numbers.Primes import qualified Factory.Data.PrimeWheel as Data.PrimeWheel import qualified Factory.Math.Power as Math.Power import qualified Factory.Math.PrimeFactorisation as Math.PrimeFactorisation@@ -79,7 +79,7 @@ instance Math.Primes.Algorithmic Algorithm where primes TurnersSieve = turnersSieve primes (TrialDivision n) = trialDivision n- primes (SieveOfEratosthenes n) = sieveOfEratosthenes n --When (n == 0), this degenerates to the unoptimised classic form.+ primes (SieveOfEratosthenes n) = sieveOfEratosthenes n --When (n == 0), this degenerates to the unoptimised classic form. primes (WheelSieve n) = Data.Numbers.Primes.wheelSieve n --Has better space-complexity than 'SieveOfEratosthenes'. -- | Uses /Trial Division/, to determine whether the specified numerator is indivisible by all the specified denominators.@@ -122,20 +122,23 @@ of parameterised, but static, size; <http://en.wikipedia.org/wiki/Wheel_factorization>. -} trialDivision :: Integral prime => Int -> [prime]-trialDivision n = Data.PrimeWheel.getPrimeComponents primeWheel ++ indivisible where+trialDivision n = Data.PrimeWheel.getPrimeComponents primeWheel ++ indivisible where primeWheel = Data.PrimeWheel.mkPrimeWheel n candidates = map fst $ Data.PrimeWheel.roll primeWheel indivisible = uncurry (++) . Control.Arrow.second (+-- filter (\candidate -> isIndivisible candidate . zipWith const indivisible . takeWhile (<= candidate) $ map Math.Power.square indivisible) filter (\candidate -> isIndivisible candidate $ takeWhile (<= Math.PrimeFactorisation.maxBoundPrimeFactor candidate) indivisible {-recurse-}) ) $ Data.List.span ( < Math.Power.square (head candidates) --The first composite candidate, is the square of the next prime after the wheel's constituent ones. ) candidates +{-# NOINLINE trialDivision #-} --Required to prevent optimization prior to firing of rewrite-rule ?!+ -- | An ordered queue of the multiples of primes. type PrimeMultiplesQueue i = Data.Sequence.Seq (Data.PrimeWheel.PrimeMultiples i) -- | A map of the multiples of primes.-type PrimeMultiplesMap i = Data.Map.Map i [Data.PrimeWheel.PrimeMultiples i]+type PrimeMultiplesMap i = Data.Map.Map i (Data.PrimeWheel.PrimeMultiples i) -- | Combine a /queue/, with a /map/, to form a repository to hold prime-multiples. type Repository i = (PrimeMultiplesQueue i, PrimeMultiplesMap i)@@ -170,9 +173,9 @@ sieve :: Integral i => Data.PrimeWheel.Distance i -> Repository i -> [i] sieve distance@(candidate, rollingWheel) repository@(primeSquares, squareFreePrimeMultiples) = case Data.Map.lookup candidate squareFreePrimeMultiples of- Just primeMultiplesList -> sieve' $ Control.Arrow.second (\m -> foldr insert (Data.Map.delete candidate m) primeMultiplesList) repository --Re-insert subsequent multiples.+ Just primeMultiples -> sieve' $ Control.Arrow.second (insertUniq primeMultiples . Data.Map.delete candidate) repository --Re-insert subsequent multiples. Nothing --Not a square-free composite.- | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insert subsequentPrimeMultiples) repository --Migrate subsequent multiples, from 'primeSquares' to 'squareFreePrimeMultiples'.+ | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insertUniq subsequentPrimeMultiples) repository --Migrate subsequent prime-multiples, from 'primeSquares' to 'squareFreePrimeMultiples'. | otherwise {-prime-} -> candidate : sieve' (Control.Arrow.first (|> Data.PrimeWheel.generatePrimeMultiples candidate rollingWheel) repository) where (smallestPrimeSquare : subsequentPrimeMultiples) = head' primeSquares@@ -180,15 +183,17 @@ -- sieve' :: Repository i -> [i] sieve' = sieve $ Data.PrimeWheel.rotate distance --Tail-recurse. - insert :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i -> PrimeMultiplesMap i- insert [] = error "Factory.Math.Implementations.Primes.sieveOfEratosthenes.sieve.insert:\tnull list"- insert (key : values) = Data.Map.insertWith (++) key [values] --i.e. key => ([values] ++ [Data.PrimeWheel.PrimeMultiples i])+ insertUniq :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i -> PrimeMultiplesMap i+ insertUniq l m = insert (dropWhile (`Data.Map.member` m) l) where+-- insert :: Ord i => Data.PrimeWheel.PrimeMultiples i -> PrimeMultiplesMap i+ insert [] = error "Factory.Math.Implementations.Primes.sieveOfEratosthenes.sieve.insertUniq.insert:\tnull list"+ insert (key : values) = Data.Map.insert key values m {-# NOINLINE sieveOfEratosthenes #-} {-# RULES "sieveOfEratosthenes/Int" sieveOfEratosthenes = sieveOfEratosthenesInt #-} --CAVEAT: doesn't fire when built with profiling enabled ?! -- | A specialisation of 'PrimeMultiplesMap'.-type PrimeMultiplesMapInt = Data.IntMap.IntMap [Data.PrimeWheel.PrimeMultiples Int]+type PrimeMultiplesMapInt = Data.IntMap.IntMap (Data.PrimeWheel.PrimeMultiples Int) -- | A specialisation of 'Repository'. type RepositoryInt = (PrimeMultiplesQueue Int, PrimeMultiplesMapInt)@@ -198,7 +203,7 @@ * CAVEAT: because the algorithm involves /squares/ of primes, this implementation will overflow when finding primes greater than @ 2^16 @ on a /32-bit/ machine;- it will exhaust the memory before that anyway.+ but it will exhaust the memory before that anyway. -} sieveOfEratosthenesInt :: Int -> [Int] sieveOfEratosthenesInt = uncurry (++) . (Data.PrimeWheel.getPrimeComponents &&& start . Data.PrimeWheel.roll) . Data.PrimeWheel.mkPrimeWheel where@@ -207,9 +212,9 @@ sieve :: Data.PrimeWheel.Distance Int -> RepositoryInt -> [Int] sieve distance@(candidate, rollingWheel) repository@(primeSquares, squareFreePrimeMultiples) = case Data.IntMap.lookup candidate squareFreePrimeMultiples of- Just primeMultiplesList -> sieve' $ Control.Arrow.second (\m -> foldr insert (Data.IntMap.delete candidate m) primeMultiplesList) repository+ Just primeMultiples -> sieve' $ Control.Arrow.second (insertUniq primeMultiples . Data.IntMap.delete candidate) repository Nothing- | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insert subsequentPrimeMultiples) repository+ | candidate == smallestPrimeSquare -> sieve' $ (tail' *** insertUniq subsequentPrimeMultiples) repository | otherwise -> candidate : sieve' (Control.Arrow.first (|> Data.PrimeWheel.generatePrimeMultiples candidate rollingWheel) repository) where (smallestPrimeSquare : subsequentPrimeMultiples) = head' primeSquares@@ -217,7 +222,8 @@ sieve' :: RepositoryInt -> [Int] sieve' = sieve $ Data.PrimeWheel.rotate distance - insert :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt -> PrimeMultiplesMapInt- insert [] = error "Factory.Math.Implementations.Primes.sieveOfEratosthenesInt.sieve.insert:\tnull list"- insert (key : values) = Data.IntMap.insertWith (++) key [values]-+ insertUniq :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt -> PrimeMultiplesMapInt+ insertUniq l m = insert (dropWhile (`Data.IntMap.member` m) l) where+ insert :: Data.PrimeWheel.PrimeMultiples Int -> PrimeMultiplesMapInt+ insert [] = error "Factory.Math.Implementations.Primes.sieveOfEratosthenesInt.sieve.insertUniq.insert:\tnull list"+ insert (key : values) = Data.IntMap.insert key values m
src/Factory/Test/QuickCheck/Primes.hs view
@@ -24,8 +24,9 @@ module Factory.Test.QuickCheck.Primes( -- * Functions- quickChecks--- isPrime+ quickChecks,+-- isPrime,+ upperBound ) where import Control.Applicative((<$>))@@ -55,19 +56,22 @@ primalityAlgorithm :: Math.Implementations.Primality.Algorithm Math.Implementations.PrimeFactorisation.Algorithm primalityAlgorithm = Defaultable.defaultValue +upperBound :: Math.Implementations.Primes.Algorithm -> Int -> Int+upperBound algorithm i = mod i $ if algorithm == Math.Implementations.Primes.TurnersSieve+ then 8192+ else 65536+ -- | Defines invariant properties. quickChecks :: IO () quickChecks =- Test.QuickCheck.quickCheckWith Test.QuickCheck.stdArgs {Test.QuickCheck.maxSuccess = 32} `mapM_` [prop_isPrime, prop_isComposite]- >> Test.QuickCheck.quickCheckWith Test.QuickCheck.stdArgs {Test.QuickCheck.maxSuccess = 32} prop_consistency where+ Test.QuickCheck.quickCheck `mapM_` [prop_isPrime, prop_isComposite]+ >> Test.QuickCheck.quickCheck prop_consistency where prop_isPrime, prop_isComposite :: Math.Implementations.Primes.Algorithm -> Int -> Test.QuickCheck.Property- prop_isPrime algorithm i = Test.QuickCheck.label "prop_isPrime" . all isPrime . take (i `mod` 4096) $ (Math.Primes.primes algorithm :: [Int])+ prop_isPrime algorithm i = Test.QuickCheck.label "prop_isPrime" . all isPrime . takeWhile (<= (upperBound algorithm i)) $ (Math.Primes.primes algorithm :: [Int]) prop_isComposite algorithm i = Test.QuickCheck.label "prop_isComposite" . not . any isPrime . Data.Set.toList . Data.Set.difference (- Data.Set.fromList [2 .. upperBound]- ) . Data.Set.fromList . takeWhile (<= upperBound) $ Math.Primes.primes algorithm where- upperBound :: Int- upperBound = i `mod` 32768+ Data.Set.fromList [2 .. upperBound algorithm i]+ ) . Data.Set.fromList . takeWhile (<= (upperBound algorithm i)) $ Math.Primes.primes algorithm prop_consistency :: Math.Implementations.Primes.Algorithm -> Math.Implementations.Primes.Algorithm -> Int -> Test.QuickCheck.Property prop_consistency l r i = l /= r ==> Test.QuickCheck.label "prop_consistency" . and . take (i `mod` 4096) $ zipWith (==) (Math.Primes.primes l) (Math.Primes.primes r :: [Int])
src/Main.hs view
@@ -106,7 +106,7 @@ packageIdentifier :: Distribution.Package.PackageIdentifier packageIdentifier = Distribution.Package.PackageIdentifier { Distribution.Package.pkgName = Distribution.Package.PackageName "factory",- Distribution.Package.pkgVersion = Distribution.Version.Version [0, 1, 0, 2] []+ Distribution.Package.pkgVersion = Distribution.Version.Version [0, 1, 0, 3] [] } printUsage = System.IO.hPutStrLn System.IO.stderr usage >> System.exitWith System.ExitSuccess