module MCSP.System.Random.Generate (
generate,
generateWith,
generateFast,
generateFastWith,
Seed,
randomSeed,
showSeedS,
showSeed,
readSeedP,
readSeed,
) where
import Control.Applicative (pure)
import Control.Exception.Extra (errorWithoutStackTrace)
import Control.Monad ((>>=))
import Control.Monad.ST (runST)
import Data.Bits (complement, xor)
import Data.Either (either)
import Data.Function (id, (.))
import Data.String qualified as Text (String)
import Data.Word (Word64, bitReverse64)
import Numeric (showHex)
import System.IO (IO)
import System.Random.PCG.Class (sysRandom)
import System.Random.PCG.Fast.Pure qualified (initialize)
import System.Random.PCG.Pure qualified (initialize)
import Text.Read.Lex (readHexP)
import Text.Show (ShowS, showChar)
import MCSP.Data.Pair (Pair, dupe, zipM)
import MCSP.System.Random.Monad (Random, evalRandom)
import MCSP.Text.ReadP (ReadP, readEitherP, trim)
mixSeed2 :: Seed -> Pair Word64
mixSeed2 :: Seed -> Seed
mixSeed2 (Word64
s1, Word64
s2) = (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
s2, Word64 -> Word64
bitReverse64 Word64
s1)
{-# INLINE mixSeed2 #-}
mixSeed1 :: Seed -> Word64
mixSeed1 :: Seed -> Word64
mixSeed1 (Seed -> Seed
mixSeed2 -> (Word64
s1, Word64
s2)) = Word64 -> Word64
forall a. Bits a => a -> a
complement (Word64
s1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
s2)
{-# INLINE mixSeed1 #-}
generateWith :: Seed -> Random a -> a
generateWith :: forall a. Seed -> Random a -> a
generateWith (Seed -> Seed
mixSeed2 -> (Word64
s1, Word64
s2)) Random a
r =
(forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (Word64 -> Word64 -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Word64 -> Word64 -> m (Gen (PrimState m))
System.Random.PCG.Pure.initialize Word64
s1 Word64
s2 ST s (Gen s) -> (Gen s -> ST s a) -> ST s a
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Random a -> Gen s -> ST s a
forall g s a. Generator g (ST s) => Random a -> g -> ST s a
evalRandom Random a
r)
{-# INLINE generateWith #-}
generateFastWith :: Seed -> Random a -> a
generateFastWith :: forall a. Seed -> Random a -> a
generateFastWith (Seed -> Word64
mixSeed1 -> Word64
seed) Random a
r =
(forall s. ST s a) -> a
forall a. (forall s. ST s a) -> a
runST (Word64 -> ST s (Gen (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Word64 -> m (Gen (PrimState m))
System.Random.PCG.Fast.Pure.initialize Word64
seed ST s (Gen s) -> (Gen s -> ST s a) -> ST s a
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Random a -> Gen s -> ST s a
forall g s a. Generator g (ST s) => Random a -> g -> ST s a
evalRandom Random a
r)
{-# INLINE generateFastWith #-}
generate :: Random a -> IO a
generate :: forall a. Random a -> IO a
generate Random a
r = do
Seed
seed <- IO Seed
randomSeed
pure (Seed -> Random a -> a
forall a. Seed -> Random a -> a
generateWith Seed
seed Random a
r)
{-# INLINE generate #-}
generateFast :: Random a -> IO a
generateFast :: forall a. Random a -> IO a
generateFast Random a
r = do
Seed
seed <- IO Seed
randomSeed
pure (Seed -> Random a -> a
forall a. Seed -> Random a -> a
generateFastWith Seed
seed Random a
r)
{-# INLINE generateFast #-}
type Seed = Pair Word64
randomSeed :: IO Seed
randomSeed :: IO Seed
randomSeed = Pair (IO Word64) -> IO Seed
forall (m :: * -> *) a. Applicative m => Pair (m a) -> m (Pair a)
zipM (IO Word64 -> Pair (IO Word64)
forall a. a -> (a, a)
dupe IO Word64
sysRandom)
{-# INLINE randomSeed #-}
showSeedS :: Seed -> ShowS
showSeedS :: Seed -> ShowS
showSeedS (Word64
x, Word64
y) = Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word64
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ShowS
forall a. Integral a => a -> ShowS
showHex Word64
y
{-# INLINE showSeedS #-}
showSeed :: Seed -> Text.String
showSeed :: Seed -> String
showSeed Seed
s = Seed -> ShowS
showSeedS Seed
s String
""
{-# INLINE showSeed #-}
readSeedP :: ReadP Seed
readSeedP :: ReadP Seed
readSeedP = do
Word64
l <- ReadP Word64 -> ReadP Word64
forall a. ReadP a -> ReadP a
trim ReadP Word64
forall a. (Eq a, Num a) => ReadP a
readHexP
Word64
r <- ReadP Word64 -> ReadP Word64
forall a. ReadP a -> ReadP a
trim ReadP Word64
forall a. (Eq a, Num a) => ReadP a
readHexP
pure (Word64
l, Word64
r)
{-# INLINE readSeedP #-}
readSeed :: Text.String -> Seed
readSeed :: String -> Seed
readSeed = (String -> Seed) -> (Seed -> Seed) -> Either String Seed -> Seed
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Seed
forall a. String -> a
errorWithoutStackTrace Seed -> Seed
forall a. a -> a
id (Either String Seed -> Seed)
-> (String -> Either String Seed) -> String -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Seed -> String -> Either String Seed
forall a. ReadP a -> String -> Either String a
readEitherP ReadP Seed
readSeedP