{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.Random.Mersenne.Pure64 (
PureMT
, pureMT
, newPureMT
, randomInt
, randomWord
, randomInt64
, randomWord64
, randomDouble
) where
import System.Random.Mersenne.Pure64.MTBlock
import System.Random.Mersenne.Pure64.Internal
import System.Random
import Data.Word
import Data.Int
import Data.Time.Clock
import Data.Time.Calendar
import System.CPUTime
pureMT :: Word64 -> PureMT
pureMT :: Word64 -> PureMT
pureMT = MTBlock -> PureMT
mkPureMT (MTBlock -> PureMT) -> (Word64 -> MTBlock) -> Word64 -> PureMT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> MTBlock
seedBlock (Word64 -> MTBlock) -> (Word64 -> Word64) -> Word64 -> MTBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
#if !MIN_VERSION_time(1,6,0)
diffTimeToPicoseconds :: DiffTime -> Integer
diffTimeToPicoseconds d =
round (1000 * 1000 * 1000 * 1000 * d)
#endif
newPureMT :: IO PureMT
newPureMT :: IO PureMT
newPureMT = do
Integer
ct <- IO Integer
getCPUTime
UTCTime
t <- IO UTCTime
getCurrentTime
let seed :: Integer
seed = Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
t) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ DiffTime -> Integer
diffTimeToPicoseconds (UTCTime -> DiffTime
utctDayTime UTCTime
t) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ct
PureMT -> IO PureMT
forall (m :: * -> *) a. Monad m => a -> m a
return (PureMT -> IO PureMT) -> PureMT -> IO PureMT
forall a b. (a -> b) -> a -> b
$ Word64 -> PureMT
pureMT (Word64 -> PureMT) -> Word64 -> PureMT
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seed
instance RandomGen PureMT where
next :: PureMT -> (Int, PureMT)
next = PureMT -> (Int, PureMT)
randomInt
split :: PureMT -> (PureMT, PureMT)
split = [Char] -> PureMT -> (PureMT, PureMT)
forall a. HasCallStack => [Char] -> a
error [Char]
"System.Random.Mersenne.Pure: unable to split the mersenne twister"
randomInt :: PureMT -> (Int,PureMT)
randomInt :: PureMT -> (Int, PureMT)
randomInt PureMT
g = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i, PureMT
g')
where (Word64
i, PureMT
g') = PureMT -> (Word64, PureMT)
randomWord64 PureMT
g
{-# INLINE randomInt #-}
randomWord :: PureMT -> (Word,PureMT)
randomWord :: PureMT -> (Word, PureMT)
randomWord PureMT
g = (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i, PureMT
g')
where (Word64
i, PureMT
g') = PureMT -> (Word64, PureMT)
randomWord64 PureMT
g
{-# INLINE randomWord #-}
randomInt64 :: PureMT -> (Int64,PureMT)
randomInt64 :: PureMT -> (Int64, PureMT)
randomInt64 PureMT
g = (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i, PureMT
g')
where (Word64
i, PureMT
g') = PureMT -> (Word64, PureMT)
randomWord64 PureMT
g
{-# INLINE randomInt64 #-}
randomDouble :: PureMT -> (Double,PureMT)
randomDouble :: PureMT -> (Double, PureMT)
randomDouble PureMT
g = (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
i Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2048) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
9007199254740992, PureMT
g')
where (Word64
i, PureMT
g') = PureMT -> (Word64, PureMT)
randomWord64 PureMT
g
{-# INLINE randomDouble #-}
randomWord64 :: PureMT -> (Word64,PureMT)
randomWord64 :: PureMT -> (Word64, PureMT)
randomWord64 (PureMT MTBlock
block Int
i MTBlock
nxt) = (Word64 -> Word64
mixWord64 (MTBlock
block MTBlock -> Int -> Word64
`lookupBlock` Int
i), PureMT
mt)
where
mt :: PureMT
mt | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
blockLenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = MTBlock -> Int -> MTBlock -> PureMT
PureMT MTBlock
block (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MTBlock
nxt
| Bool
otherwise = MTBlock -> PureMT
mkPureMT MTBlock
nxt
{-# INLINE randomWord64 #-}
mkPureMT :: MTBlock -> PureMT
mkPureMT :: MTBlock -> PureMT
mkPureMT MTBlock
block = MTBlock -> Int -> MTBlock -> PureMT
PureMT MTBlock
block Int
0 (MTBlock -> MTBlock
nextBlock MTBlock
block)