{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE UnicodeSyntax #-}
{-- |
-- Module: FactoredRandomNumbers
-- Description: A module of Kalai's algorithm to get uniformly pre-factored numbers
-- Copyright: (c) Venkatesh Narayanan
-- License:
-- Maintainer: venkatesh.narayanan@live.in
--
-- The module has three functions.
   The Adam Kalai Algorithm implmemented in this module (see Readme for more details)
              Input: Integer n > 0.

              Output: A uniformly random number 1 ≤ r ≤ n.

                  1. Generate a sequence n ≥ s1 ≥ s2 ≥ ··· ≥ sl = 1 by choosing
                  s1 ∈ {1, 2,..., n} and si+1 ∈ {1, 2,...,si}, until reaching 1.
                  2. Let r be the product of the prime si’s.
                  3. If r ≤ n, output r with probability r/n.
                  4. Otherwise, RESTART.
--}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Module for accessing functions based on Kalai's Algorithm
module FactoredRandomNumbers
  ( genARandomPreFactoredNumberLTEn,
    preFactoredNumOfBitSize,
    preFactoredNumOfBitSizePar,
  )
where

import Control.Concurrent.Async (race)
import Control.Concurrent.ParallelIO.Local (parallelFirst, withPool)
import Control.Monad.Loops (iterateWhile)
import Control.Parallel.Strategies (NFData, parBuffer, parListChunk, parListSplitAt, rdeepseq, rpar, withStrategy)
import Data.Maybe (fromMaybe)
import Data.Text (pack)
import qualified Data.Unamb (race)
import GHC.Conc (getNumCapabilities, getNumProcessors, setNumCapabilities)
import Math.NumberTheory.Primes.Testing (bailliePSW) -- isPrime is slower
import Protolude
  ( Applicative (pure),
    Bool (False),
    Either (..),
    Eq ((==)),
    Foldable (maximum),
    IO,
    Int,
    Integer,
    Maybe (Just),
    Monad ((>>=)),
    Num ((+), (-)),
    Ord (max, min, (<), (<=), (>)),
    Text,
    abs,
    div,
    filter,
    flip,
    fst,
    length,
    maximum,
    odd,
    otherwise,
    product,
    replicate,
    snd,
    ($),
    (&&),
    (.),
    (<$>),
    (<&>),
    (<*>),
    (>=>),
    (^),
    (||),
  )
import System.Random.Stateful (globalStdGen, uniformRM)

-- | Strategies that may be used with parallel calls
data Strats
  = Chunk
  | Buffer
  | Split
  deriving (Strats -> Strats -> Bool
(Strats -> Strats -> Bool)
-> (Strats -> Strats -> Bool) -> Eq Strats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Strats -> Strats -> Bool
== :: Strats -> Strats -> Bool
$c/= :: Strats -> Strats -> Bool
/= :: Strats -> Strats -> Bool
Eq)

-- | Takes an Integer for Bitsize value to operate on range [2 ^ y, 2 ^ y + 1 - 1].  This function leverages parallel execution
-- Provide an integer input and it should generate a tuple of a number in the range [2^y, 2^y+1 -1] and its prime factors
-- In the event that the concurrent call fails, a recovery through a basic parallelised call is attempted.
preFactoredNumOfBitSizePar :: Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSizePar :: Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSizePar Integer
1 = Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ (Integer, [Integer]) -> Either Text (Integer, [Integer])
forall a b. b -> Either a b
Right (Integer
1, [Integer
1])
preFactoredNumOfBitSizePar Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 = Either Text (Integer, [Integer])
-> Maybe (Either Text (Integer, [Integer]))
-> Either Text (Integer, [Integer])
forall a. a -> Maybe a -> a
fromMaybe (Either Text (Integer, [Integer])
 -> Maybe (Either Text (Integer, [Integer]))
 -> Either Text (Integer, [Integer]))
-> IO (Either Text (Integer, [Integer]))
-> IO
     (Maybe (Either Text (Integer, [Integer]))
      -> Either Text (Integer, [Integer]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSize Integer
n IO
  (Maybe (Either Text (Integer, [Integer]))
   -> Either Text (Integer, [Integer]))
-> IO (Maybe (Either Text (Integer, [Integer])))
-> IO (Either Text (Integer, [Integer]))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> IO (Maybe (Either Text (Integer, [Integer])))
preFactoredNumOfBitSizeParMaybe Integer
n
preFactoredNumOfBitSizePar Integer
_ = Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Integer, [Integer])
forall a b. a -> Either a b
Left (Text -> Either Text (Integer, [Integer]))
-> Text -> Either Text (Integer, [Integer])
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
"Invalid"

-- | Parallel preFactored Number given BitSize
-- Provide an integer input. Generate a tuple of a number in the range [2^y, 2^y+1 -1] and its prime factors.
preFactoredNumOfBitSizeParMaybe :: Integer -> IO (Maybe (Either Text (Integer, [Integer])))
preFactoredNumOfBitSizeParMaybe :: Integer -> IO (Maybe (Either Text (Integer, [Integer])))
preFactoredNumOfBitSizeParMaybe Integer
1 = Maybe (Either Text (Integer, [Integer]))
-> IO (Maybe (Either Text (Integer, [Integer])))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either Text (Integer, [Integer]))
 -> IO (Maybe (Either Text (Integer, [Integer]))))
-> Maybe (Either Text (Integer, [Integer]))
-> IO (Maybe (Either Text (Integer, [Integer])))
forall a b. (a -> b) -> a -> b
$ Either Text (Integer, [Integer])
-> Maybe (Either Text (Integer, [Integer]))
forall a. a -> Maybe a
Just (Either Text (Integer, [Integer])
 -> Maybe (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> Maybe (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ (Integer, [Integer]) -> Either Text (Integer, [Integer])
forall a b. b -> Either a b
Right (Integer
1, [Integer
1])
preFactoredNumOfBitSizeParMaybe Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
10 :: Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
9 :: Integer) = Either Text (Integer, [Integer])
-> Maybe (Either Text (Integer, [Integer]))
forall a. a -> Maybe a
Just (Either Text (Integer, [Integer])
 -> Maybe (Either Text (Integer, [Integer])))
-> IO (Either Text (Integer, [Integer]))
-> IO (Maybe (Either Text (Integer, [Integer])))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSize Integer
n
preFactoredNumOfBitSizeParMaybe Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 = ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> IO (Int, Int) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Int, Int)
coresToUse) IO Int
-> (Int -> IO (Maybe (Either Text (Integer, [Integer]))))
-> IO (Maybe (Either Text (Integer, [Integer])))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Either Text (Integer, [Integer]))
-> Int -> IO (Maybe (Either Text (Integer, [Integer])))
forall a. IO a -> Int -> IO (Maybe a)
spinUpThreads (Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSize Integer
n)
preFactoredNumOfBitSizeParMaybe Integer
_ = Maybe (Either Text (Integer, [Integer]))
-> IO (Maybe (Either Text (Integer, [Integer])))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either Text (Integer, [Integer]))
 -> IO (Maybe (Either Text (Integer, [Integer]))))
-> Maybe (Either Text (Integer, [Integer]))
-> IO (Maybe (Either Text (Integer, [Integer])))
forall a b. (a -> b) -> a -> b
$ Either Text (Integer, [Integer])
-> Maybe (Either Text (Integer, [Integer]))
forall a. a -> Maybe a
Just (Either Text (Integer, [Integer])
 -> Maybe (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> Maybe (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Integer, [Integer])
forall a b. a -> Either a b
Left (Text -> Either Text (Integer, [Integer]))
-> Text -> Either Text (Integer, [Integer])
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
"Invalid"

-- | Spin up t threads of function f in parallel and return the one which completes first
spinUpThreads :: IO a -> Int -> IO (Maybe a)
spinUpThreads :: forall a. IO a -> Int -> IO (Maybe a)
spinUpThreads IO a
f Int
t = Int -> (Pool -> IO (Maybe a)) -> IO (Maybe a)
forall a. Int -> (Pool -> IO a) -> IO a
withPool Int
t ((Pool -> IO (Maybe a)) -> IO (Maybe a))
-> (Pool -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Pool
pool -> Pool -> [IO (Maybe a)] -> IO (Maybe a)
forall a. Pool -> [IO (Maybe a)] -> IO (Maybe a)
parallelFirst Pool
pool ([IO (Maybe a)] -> IO (Maybe a)) -> [IO (Maybe a)] -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Maybe a) -> [IO (Maybe a)]
forall a. Int -> a -> [a]
replicate Int
t (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
f)

-- | Spin up t actions of function f in parallel and return what's executed first
-- for now ignore t; fires up a 2 horse 'race' call from Control.Concurrent.Async
_spinUpActions :: IO a -> Int -> IO (Maybe a)
_spinUpActions :: forall a. IO a -> Int -> IO (Maybe a)
_spinUpActions IO a
f Int
_ = IO a -> IO (Maybe a)
forall a. IO a -> IO (Maybe a)
_raceJust IO a
f

-- | Spin up t Forks of function f in parallel and return what's executed first
-- for now ignore the second paramemter; fires up a 2-horse 'race' call from Data.Unamb
_spinUpForks :: IO a -> Int -> IO (Maybe a)
_spinUpForks :: forall a. IO a -> Int -> IO (Maybe a)
_spinUpForks IO a
f Int
_ = IO a -> IO (Maybe a)
forall a. IO a -> IO (Maybe a)
_raceJustU IO a
f

-- | Convert async.race from Either-Or to Maybe
_raceJust :: IO a -> IO (Maybe a)
_raceJust :: forall a. IO a -> IO (Maybe a)
_raceJust IO a
a =
  IO a -> IO a -> IO (Either a a)
forall a b. IO a -> IO b -> IO (Either a b)
race IO a
a IO a
a IO (Either a a) -> (Either a a -> IO (Maybe a)) -> IO (Maybe a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left a
u -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
u
    Right a
v -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
v

-- | Convert Data.Unamb.race to Maybe
_raceJustU :: IO a -> IO (Maybe a)
_raceJustU :: forall a. IO a -> IO (Maybe a)
_raceJustU IO a
a = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO a -> IO a
forall a. IO a -> IO a -> IO a
Data.Unamb.race IO a
a IO a
a

-- | Figure out # cores to use for parallelization
coresToUse :: IO (Int, Int)
coresToUse :: IO (Int, Int)
coresToUse = do
  Int
nCores <- IO Int
getNumProcessors
  let nEfficiencyCores :: Int
nEfficiencyCores = Int
nCores Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 -- a heuristic : 50% of cores = efficiency
  Int
nNumCapabilities <- IO Int
getNumCapabilities
  Int -> IO ()
setNumCapabilities (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
nCores Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nEfficiencyCores) Int
nNumCapabilities
  Int
nNumCapabilitiesSet <- IO Int
getNumCapabilities
  (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
nCores, Int
nNumCapabilitiesSet)

-- | Takes an Integer as a Bitsize value to operate on range [2 ^ y, 2 ^ y + 1 - 1]
-- Provide an integer input and it should generate a tuple of a number in the range [2^y, 2^y+1 -1] and its prime factors.
-- if it throws up a value below 2^n then do again. 50% of the time it should result in success.
preFactoredNumOfBitSize :: Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSize :: Integer -> IO (Either Text (Integer, [Integer]))
preFactoredNumOfBitSize Integer
1 = Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ (Integer, [Integer]) -> Either Text (Integer, [Integer])
forall a b. b -> Either a b
Right (Integer
1, [Integer
1])
preFactoredNumOfBitSize Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1 = (Either Text (Integer, [Integer]) -> Bool)
-> IO (Either Text (Integer, [Integer]))
-> IO (Either Text (Integer, [Integer]))
forall (m :: * -> *) a. Monad m => (a -> Bool) -> m a -> m a
iterateWhile ((Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
n) Integer -> Either Text (Integer, [Integer]) -> Bool
<|) (Integer -> IO (Either Text (Integer, [Integer]))
genARandomPreFactoredNumberLTEn (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
preFactoredNumOfBitSize Integer
_ = Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Integer, [Integer])
forall a b. a -> Either a b
Left (Text -> Either Text (Integer, [Integer]))
-> Text -> Either Text (Integer, [Integer])
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
"Invalid"

infix 1 <|

-- | An operator to compare the Right first value of the (Int, [Int]) to an Int for Truth-value of lesser-than predicate
(<|) :: Integer -> Either Text (Integer, [Integer]) -> Bool
Integer
bound <| :: Integer -> Either Text (Integer, [Integer]) -> Bool
<| Either Text (Integer, [Integer])
eOR = case Either Text (Integer, [Integer])
eOR of
  Left Text
_ -> Bool
False
  Right (Integer, [Integer])
v -> (Integer, [Integer]) -> Integer
forall a b. (a, b) -> a
fst (Integer, [Integer])
v Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
bound

-- | This is the Entry Function with a Integer bound. This is the core of the Kalai algorithm
-- Provide an integer input and it should generate a tuple of a number less than the input integer and its prime factors
genARandomPreFactoredNumberLTEn :: Integer -> IO (Either Text (Integer, [Integer]))
genARandomPreFactoredNumberLTEn :: Integer -> IO (Either Text (Integer, [Integer]))
genARandomPreFactoredNumberLTEn Integer
x | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Integer, [Integer])
forall a b. a -> Either a b
Left (Text -> Either Text (Integer, [Integer]))
-> Text -> Either Text (Integer, [Integer])
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
"Invalid"
genARandomPreFactoredNumberLTEn Integer
1 = Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ (Integer, [Integer]) -> Either Text (Integer, [Integer])
forall a b. b -> Either a b
Right (Integer
1, [Integer
1])
genARandomPreFactoredNumberLTEn Integer
n = do
  (Integer, [Integer])
candidateTuple <- Integer -> IO (Integer, [Integer])
potentialResult Integer
n
  Bool
-> IO (Either Text (Integer, [Integer]))
-> IO (Either Text (Integer, [Integer]))
-> IO (Either Text (Integer, [Integer]))
forall b. Bool -> b -> b -> b
if' (((Integer, [Integer]) -> Integer
forall a b. (a, b) -> a
fst ((Integer, [Integer]) -> Integer)
-> (Integer -> Bool) -> (Integer, [Integer]) -> Bool
forall a b. (a -> b) -> (b -> Bool) -> a -> Bool
`is` (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n)) (Integer, [Integer])
candidateTuple) (Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (Integer, [Integer])
 -> IO (Either Text (Integer, [Integer])))
-> Either Text (Integer, [Integer])
-> IO (Either Text (Integer, [Integer]))
forall a b. (a -> b) -> a -> b
$ (Integer, [Integer]) -> Either Text (Integer, [Integer])
forall a b. b -> Either a b
Right (Integer, [Integer])
candidateTuple) (Integer -> IO (Either Text (Integer, [Integer]))
genARandomPreFactoredNumberLTEn Integer
n) -- else keep doing till success

-- | Provided an Integer List, throws up a candidate Int and its prime factors for further assessment
filterPrimesProduct :: [Integer] -> (Integer, [Integer])
filterPrimesProduct :: [Integer] -> (Integer, [Integer])
filterPrimesProduct [Integer]
xs = (Integer, [Integer])
result where result :: (Integer, [Integer])
result@(Integer
_, [Integer]
sq) = ([Integer] -> Integer
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
product [Integer]
sq, [Integer] -> [Integer]
onlyPrimesFrom [Integer]
xs) -- note: product [] = 1

-- | parallel filter with 3 optional strategies
parFilter :: (NFData a) => Strats -> Int -> (a -> Bool) -> [a] -> [a]
parFilter :: forall a. NFData a => Strats -> Int -> (a -> Bool) -> [a] -> [a]
parFilter Strats
strat Int
stratParm a -> Bool
p = case Strats
strat of
  Strats
Chunk -> Strategy [a] -> [a] -> [a]
forall a. Strategy a -> a -> a
withStrategy (Int -> Strategy a -> Strategy [a]
forall a. Int -> Strategy a -> Strategy [a]
parListChunk Int
stratParm Strategy a
forall a. NFData a => Strategy a
rdeepseq) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p
  Strats
Buffer -> Strategy [a] -> [a] -> [a]
forall a. Strategy a -> a -> a
withStrategy (Int -> Strategy a -> Strategy [a]
forall a. Int -> Strategy a -> Strategy [a]
parBuffer Int
stratParm Strategy a
forall a. Strategy a
rpar) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p
  Strats
Split -> Strategy [a] -> [a] -> [a]
forall a. Strategy a -> a -> a
withStrategy (Int -> Strategy [a] -> Strategy [a] -> Strategy [a]
forall a. Int -> Strategy [a] -> Strategy [a] -> Strategy [a]
parListSplitAt Int
stratParm Strategy [a]
forall a. NFData a => Strategy a
rdeepseq Strategy [a]
forall a. NFData a => Strategy a
rdeepseq) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p

-- | Reduction of a composite list of integers into primefactors
-- Select the parallel (or not) strategy based on the size range. Use Parallel > Billion
onlyPrimesFrom :: [Integer] -> [Integer]
onlyPrimesFrom :: [Integer] -> [Integer]
onlyPrimesFrom [Integer]
xs
  | [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Integer]
xs Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
10 :: Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
9 :: Integer) = (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter Integer -> Bool
isPrimeOr1 [Integer]
xs -- at a billion try parallelzing and concurrency options
  | Bool
otherwise = Strats -> Int -> (Integer -> Bool) -> [Integer] -> [Integer]
forall a. NFData a => Strats -> Int -> (a -> Bool) -> [a] -> [a]
parFilter Strats
Split ([Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3) Integer -> Bool
isPrimeOr1 [Integer]
xs

-- assuming the first 3rd of the list comprise larger numbers and their processing workload = the residual 2/3rd

-- | Provided an Integer, throws up a candidate Int and its factors for further evaluation
potentialResult :: Integer -> IO (Integer, [Integer])
potentialResult :: Integer -> IO (Integer, [Integer])
potentialResult Integer
n = Integer -> IO [Integer]
mkList Integer
n IO [Integer]
-> ([Integer] -> (Integer, [Integer])) -> IO (Integer, [Integer])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Integer] -> (Integer, [Integer])
filterPrimesProduct

-- | Provided an Integer, creates a sequence of random integers LTE n in decreasing order,
-- possibly with multiples ending at 1
mkList :: Integer -> IO [Integer]
mkList :: Integer -> IO [Integer]
mkList Integer
1 = [Integer] -> IO [Integer]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
mkList Integer
n = ((Integer, Integer) -> IO Integer
getRndMInt ((Integer, Integer) -> IO Integer)
-> (Integer -> IO [Integer]) -> (Integer, Integer) -> IO [Integer]
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (b -> m [b]) -> a -> m [b]
>=>: Integer -> IO [Integer]
mkList) (Integer
1, Integer
n)

-- | Get a Random Integer with uniform probability in the range (l,u)
getRndMInt :: (Integer, Integer) -> IO Integer
getRndMInt :: (Integer, Integer) -> IO Integer
getRndMInt (Integer
l, Integer
u) = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
l (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
u (Integer -> Integer) -> IO Integer -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> AtomicGenM StdGen -> IO Integer
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
(Integer, Integer) -> g -> m Integer
uniformRM (Integer
l, Integer
u) AtomicGenM StdGen
globalStdGen -- uniformRM (a, b) = uniformRM (b, a) holds as per fn defn

infixr 1 >=>:

-- | Left-to-right Kleisli composition of monads plus prepend elem to List using applicative
-- Late edit: there may be something in Control.arrow that already does exactly this
(>=>:) :: (Monad m) => (a -> m b) -> (b -> m [b]) -> (a -> m [b])
a -> m b
f >=>: :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (b -> m [b]) -> a -> m [b]
>=>: b -> m [b]
g = a -> m b
f (a -> m b) -> (b -> m [b]) -> a -> m [b]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \b
u -> (b
u b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ([b] -> [b]) -> m [b] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> m [b]
g b
u

-- | True if input is prime or 1
-- Primality testing is one key to peformance of this algo
-- the isOdd and greater than 3 is for the use of bailliePSW primality
-- using bailliePSW in place of the standard isPrime leads to 75% reduction in time !!!
isPrimeOr1 :: Integer -> Bool
isPrimeOr1 :: Integer -> Bool
isPrimeOr1 Integer
n = (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3) Bool -> Bool -> Bool
|| (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
3 Bool -> Bool -> Bool
&& Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
i Bool -> Bool -> Bool
&& Integer -> Bool
bailliePSW Integer
i) where i :: Integer
i = Integer -> Integer
forall a. Num a => a -> a
abs Integer
n -- bailliePSW requires that n > 3 and that input is Odd

-- | from Data.Function.predicate
is :: (a -> b) -> (b -> Bool) -> (a -> Bool)
is :: forall a b. (a -> b) -> (b -> Bool) -> a -> Bool
is = ((b -> Bool) -> (a -> b) -> a -> Bool)
-> (a -> b) -> (b -> Bool) -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

-- | @if then else@ made concise
if' :: Bool -> b -> b -> b
if' :: forall b. Bool -> b -> b -> b
if' Bool
p b
u b
v
  | Bool
p = b
u
  | Bool
otherwise = b
v