{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------
-- |
-- Module     : System.Random.Mersenne.Pure64
-- Copyright  : Copyright (c) 2008, Don Stewart <dons@galois.com>
-- License    : BSD3
-- Maintainer : Don Stewart <dons@galois.com>
-- Stability  : experimental
-- Portability: CPP, FFI
-- Tested with: GHC 6.8.3
--
-- A purely functional binding 64 bit binding to the classic mersenne
-- twister random number generator. This is more flexible than the
-- impure 'mersenne-random' library, at the cost of being a bit slower.
-- This generator is however, many times faster than System.Random,
-- and yields high quality randoms with a long period.
--
-- This generator may be used with System.Random, however, that is
-- likely to be slower than using it directly.
--
module System.Random.Mersenne.Pure64 (

    -- * The random number generator
    PureMT          -- abstract: RandomGen

    -- * Introduction
    , pureMT        -- :: Word64 -> PureMT
    , newPureMT     -- :: IO PureMT

    -- $instance

    -- * Low level access to the generator

    -- $notes
    , randomInt     -- :: PureMT -> (Int   ,PureMT)
    , randomWord    -- :: PureMT -> (Word  ,PureMT)
    , randomInt64   -- :: PureMT -> (Int64 ,PureMT)
    , randomWord64  -- :: PureMT -> (Word64,PureMT)
    , randomDouble  -- :: PureMT -> (Double,PureMT)

    ) 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

-- | Create a PureMT generator from a 'Word64' seed.
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

-- | Create a new PureMT generator, using the clocktime as the base for the seed.
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

------------------------------------------------------------------------
-- System.Random interface.

-- $instance
--
-- Being purely functional, the PureMT generator is an instance of
-- RandomGen. However, it doesn't support 'split' yet.

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"

------------------------------------------------------------------------
-- Direct access to Int, Word and Double types

-- | Yield a new 'Int' value from the generator, returning a new
-- generator and that 'Int'. The full 64 bits will be used on a 64 bit machine.
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 #-}

-- | Yield a new 'Word' value from the generator, returning a new
-- generator and that 'Word'.
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 #-}

-- | Yield a new 'Int64' value from the generator, returning a new
-- generator and that 'Int64'.
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 #-}

-- | Efficiently yield a new 53-bit precise 'Double' value, and a new generator.
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 #-}

-- | Yield a new 'Word64' value from the generator, returning a new
-- generator and that 'Word64'.
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 #-}

-- create a new PureMT from an MTBlock
mkPureMT :: MTBlock -> PureMT
mkPureMT :: MTBlock -> PureMT
mkPureMT MTBlock
block = MTBlock -> Int -> MTBlock -> PureMT
PureMT MTBlock
block Int
0 (MTBlock -> MTBlock
nextBlock MTBlock
block)