module Factory.Data.PrimeWheel(
Distance,
NPrimes,
PrimeMultiples,
PrimeWheel(getPrimeComponents, getSpokeGaps),
estimateOptimalSize,
generateMultiples,
roll,
rotate,
mkPrimeWheel,
getCircumference,
getSpokeCount
) where
import Control.Arrow((&&&), (***))
import qualified Data.IntMap
import qualified Data.List
data PrimeWheel i = MkPrimeWheel {
PrimeWheel i -> [i]
getPrimeComponents :: [i],
PrimeWheel i -> [i]
getSpokeGaps :: [i]
} deriving Int -> PrimeWheel i -> ShowS
[PrimeWheel i] -> ShowS
PrimeWheel i -> String
(Int -> PrimeWheel i -> ShowS)
-> (PrimeWheel i -> String)
-> ([PrimeWheel i] -> ShowS)
-> Show (PrimeWheel i)
forall i. Show i => Int -> PrimeWheel i -> ShowS
forall i. Show i => [PrimeWheel i] -> ShowS
forall i. Show i => PrimeWheel i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimeWheel i] -> ShowS
$cshowList :: forall i. Show i => [PrimeWheel i] -> ShowS
show :: PrimeWheel i -> String
$cshow :: forall i. Show i => PrimeWheel i -> String
showsPrec :: Int -> PrimeWheel i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> PrimeWheel i -> ShowS
Show
getCircumference :: Integral i => PrimeWheel i -> i
getCircumference :: PrimeWheel i -> i
getCircumference = [i] -> i
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([i] -> i) -> (PrimeWheel i -> [i]) -> PrimeWheel i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimeWheel i -> [i]
forall i. PrimeWheel i -> [i]
getPrimeComponents
getSpokeCount :: Integral i => PrimeWheel i -> i
getSpokeCount :: PrimeWheel i -> i
getSpokeCount = (i -> i -> i) -> i -> [i] -> i
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (i -> i -> i
forall a. Num a => a -> a -> a
(*) (i -> i -> i) -> (i -> i) -> i -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> i
forall a. Enum a => a -> a
pred) i
1 ([i] -> i) -> (PrimeWheel i -> [i]) -> PrimeWheel i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimeWheel i -> [i]
forall i. PrimeWheel i -> [i]
getPrimeComponents
type PrimeMultiples i = [i]
type Repository = Data.IntMap.IntMap (PrimeMultiples Int)
type NPrimes = Int
findCoprimes :: NPrimes -> ([Int], [Int])
findCoprimes :: Int -> ([Int], [Int])
findCoprimes Int
0 = ([], [])
findCoprimes Int
required
| Int
required Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> ([Int], [Int])
forall a. HasCallStack => String -> a
error (String -> ([Int], [Int])) -> String -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ String
"Factory.Data.PrimeWheel.findCoprimes: invalid number of coprimes; " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
required
| Bool
otherwise = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
required ([Int] -> ([Int], [Int])) -> [Int] -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ Int
2 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Int -> Repository -> [Int]
sieve Int
3 Int
0 Repository
forall a. IntMap a
Data.IntMap.empty
where
sieve :: Int -> NPrimes -> Repository -> [Int]
sieve :: Int -> Int -> Repository -> [Int]
sieve Int
candidate Int
found Repository
repository = case Int -> Repository -> Maybe [Int]
forall a. Int -> IntMap a -> Maybe a
Data.IntMap.lookup Int
candidate Repository
repository of
Just [Int]
primeMultiples -> Int -> Repository -> [Int]
sieve' Int
found (Repository -> [Int])
-> (Repository -> Repository) -> Repository -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Repository -> Repository
insertUniq [Int]
primeMultiples (Repository -> [Int]) -> Repository -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> Repository -> Repository
forall a. Int -> IntMap a -> IntMap a
Data.IntMap.delete Int
candidate Repository
repository
Maybe [Int]
Nothing -> let
found' :: Int
found' = Int -> Int
forall a. Enum a => a -> a
succ Int
found
(Int
key : [Int]
values) = (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gap Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
candidate) (Int -> [Int]) -> Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Int
candidate Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)
in Int
candidate Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Repository -> [Int]
sieve' Int
found' (
if Int
found' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
required
then Repository
repository
else Int -> [Int] -> Repository -> Repository
forall a. Int -> a -> IntMap a -> IntMap a
Data.IntMap.insert Int
key [Int]
values Repository
repository
)
where
gap :: Int
gap :: Int
gap = Int
2
sieve' :: NPrimes -> Repository -> [Int]
sieve' :: Int -> Repository -> [Int]
sieve' = Int -> Int -> Repository -> [Int]
sieve (Int -> Int -> Repository -> [Int])
-> Int -> Int -> Repository -> [Int]
forall a b. (a -> b) -> a -> b
$ Int
candidate Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gap
insertUniq :: PrimeMultiples Int -> Repository -> Repository
insertUniq :: [Int] -> Repository -> Repository
insertUniq [Int]
l Repository
m = [Int] -> Repository
insert ([Int] -> Repository) -> [Int] -> Repository
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Int -> Repository -> Bool
forall a. Int -> IntMap a -> Bool
`Data.IntMap.member` Repository
m) [Int]
l where
insert :: PrimeMultiples Int -> Repository
insert :: [Int] -> Repository
insert [] = String -> Repository
forall a. HasCallStack => String -> a
error String
"Factory.Data.PrimeWheel.findCoprimes.sieve.insertUniq.insert:\tnull list"
insert (Int
key : [Int]
values) = Int -> [Int] -> Repository -> Repository
forall a. Int -> a -> IntMap a -> IntMap a
Data.IntMap.insert Int
key [Int]
values Repository
m
estimateOptimalSize :: Integral i => i -> NPrimes
estimateOptimalSize :: i -> Int
estimateOptimalSize i
maxPrime = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (([Int], [Int]) -> Int) -> ([Int], [Int]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Int)
-> (([Int], [Int]) -> [Integer]) -> ([Int], [Int]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
optimalCircumference) ([Integer] -> [Integer])
-> (([Int], [Int]) -> [Integer]) -> ([Int], [Int]) -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer) -> [Integer] -> [Integer]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) ([Integer] -> [Integer])
-> (([Int], [Int]) -> [Integer]) -> ([Int], [Int]) -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Integer) -> [Int] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Integer])
-> (([Int], [Int]) -> [Int]) -> ([Int], [Int]) -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int], [Int]) -> [Int]
forall a b. (a, b) -> a
fst (([Int], [Int]) -> Int) -> ([Int], [Int]) -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ([Int], [Int])
findCoprimes Int
10 where
optimalCircumference :: Integer
optimalCircumference :: Integer
optimalCircumference = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ i -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
maxPrime :: Double)
mkPrimeWheel :: Integral i => NPrimes -> PrimeWheel i
mkPrimeWheel :: Int -> PrimeWheel i
mkPrimeWheel Int
0 = [i] -> [i] -> PrimeWheel i
forall i. [i] -> [i] -> PrimeWheel i
MkPrimeWheel [] [i
1]
mkPrimeWheel Int
nPrimes
| Int
nPrimes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> PrimeWheel i
forall a. HasCallStack => String -> a
error (String -> PrimeWheel i) -> String -> PrimeWheel i
forall a b. (a -> b) -> a -> b
$ String
"Factory.Data.PrimeWheel.mkPrimeWheel: unable to construct from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nPrimes String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" primes"
| Bool
otherwise = PrimeWheel i
primeWheel
where
([i]
primeComponents, [i]
coprimeCandidates) = ((Int -> i) -> [Int] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [i]) -> ([Int] -> [i]) -> ([Int], [Int]) -> ([i], [i])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (Int -> i) -> [Int] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [i]) -> ([Int] -> [Int]) -> [Int] -> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> [Int] -> [Int]
forall i a. Integral i => i -> [a] -> [a]
Data.List.genericTake (PrimeWheel i -> i
forall i. Integral i => PrimeWheel i -> i
getSpokeCount PrimeWheel i
primeWheel)) (([Int], [Int]) -> ([i], [i])) -> ([Int], [Int]) -> ([i], [i])
forall a b. (a -> b) -> a -> b
$ Int -> ([Int], [Int])
findCoprimes Int
nPrimes
primeWheel :: PrimeWheel i
primeWheel = [i] -> [i] -> PrimeWheel i
forall i. [i] -> [i] -> PrimeWheel i
MkPrimeWheel [i]
primeComponents ([i] -> PrimeWheel i) -> [i] -> PrimeWheel i
forall a b. (a -> b) -> a -> b
$ (i -> i -> i) -> [i] -> [i] -> [i]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [i]
coprimeCandidates ([i] -> [i]) -> [i] -> [i]
forall a b. (a -> b) -> a -> b
$ i
1 i -> [i] -> [i]
forall a. a -> [a] -> [a]
: [i]
coprimeCandidates
type Distance i = (i, [i])
rotate :: Integral i => Distance i -> Distance i
rotate :: Distance i -> Distance i
rotate (i
candidate, [i]
rollingWheel) = (i
candidate i -> i -> i
forall a. Num a => a -> a -> a
+) (i -> i) -> ([i] -> i) -> [i] -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [i] -> i
forall a. [a] -> a
head ([i] -> i) -> ([i] -> [i]) -> [i] -> Distance i
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [i] -> [i]
forall a. [a] -> [a]
tail ([i] -> Distance i) -> [i] -> Distance i
forall a b. (a -> b) -> a -> b
$ [i]
rollingWheel
{-# INLINE rotate #-}
roll :: Integral i => PrimeWheel i -> [Distance i]
roll :: PrimeWheel i -> [Distance i]
roll PrimeWheel i
primeWheel = [Distance i] -> [Distance i]
forall a. [a] -> [a]
tail ([Distance i] -> [Distance i]) -> [Distance i] -> [Distance i]
forall a b. (a -> b) -> a -> b
$ (Distance i -> Distance i) -> Distance i -> [Distance i]
forall a. (a -> a) -> a -> [a]
iterate Distance i -> Distance i
forall i. Integral i => Distance i -> Distance i
rotate (i
1, [i] -> [i]
forall a. [a] -> [a]
cycle ([i] -> [i]) -> [i] -> [i]
forall a b. (a -> b) -> a -> b
$ PrimeWheel i -> [i]
forall i. PrimeWheel i -> [i]
getSpokeGaps PrimeWheel i
primeWheel)
generateMultiples :: Integral i
=> i
-> [i]
-> [i]
generateMultiples :: i -> [i] -> [i]
generateMultiples i
i = (i -> i -> i) -> i -> [i] -> [i]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\i
accumulator -> (i -> i -> i
forall a. Num a => a -> a -> a
+ i
accumulator) (i -> i) -> (i -> i) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i -> i
forall a. Num a => a -> a -> a
* i
i)) (i
i i -> Int -> i
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int))
{-# INLINE generateMultiples #-}