{- LANGUAGE BangPatterns, PatternSignatures, ScopedTypeVariables -}
{-# OPTIONS -fbang-patterns -fglasgow-exts -#include "SFMT.h" #-}
import Control.Exception
import Control.Monad
import Data.Int
import Data.Typeable
import Data.Word
import System.CPUTime
import System.Environment
import System.IO
import Text.Printf
import qualified System.Random as Old
import System.Random.Mersenne
main = do
print version
g <- newMTGen (Just 5)
time $ gen g
ranges_strict g
-- ranges_strict_range g
ranges_ty g
-- ranges g
speed (undefined :: Int) g
speed (undefined :: Integer) g
speed (undefined :: Double) g
time $ sums g
time $ sum_lazy g
gen g = do
forM_ [0 .. 10000] $ \i -> do
x <- random g :: IO Word
when (i < 1000) $ do
printf "%12u " (fromIntegral x :: Int)
when (i `rem` 4 == 3) $
putChar '\n'
time :: IO t -> IO t
time a = do
start <- getCPUTime
v <- a
end <- getCPUTime
let diff = (fromIntegral (end - start)) / (10^12)
printf "Computation time: %0.3f sec\n" (diff :: Double)
return v
-- overhead cause by random's badness
sums g = do
let lim = 100000000
printf "Generating %d randoms ...\n" lim
let go :: Int -> Int -> IO Int
go !n !acc
| n >= lim = return acc
| otherwise = do
a <- random g
go (n+1) (if a < acc then a else acc)
print =<< go 0 0
sum_lazy g = do
let lim = 100000000
printf "Generating %d randoms lazily ...\n" lim
xs <- randoms g :: IO [Int]
print (minimum (take lim xs)) -- faster when it fuses.
{-
-- overhead cause by random's badness
ranges g = do
let n = 10000000
test g n (undefined :: Bool)
test g n (undefined :: Word8)
test g n (undefined :: Word16)
test g n (undefined :: Word32)
test g n (undefined :: Word64)
test g n (undefined :: Word)
test g n (undefined :: Int)
test g n (undefined :: Int64)
test g n (undefined :: Int32)
test g n (undefined :: Int16)
test g n (undefined :: Int8)
test g n (undefined :: Integer)
-}
-- overhead cause by random's badness
ranges_ty g = do
let n = 10000000
test_type g n (undefined :: Bool)
test_type g n (undefined :: Word8)
test_type g n (undefined :: Word16)
test_type g n (undefined :: Word32)
test_type g n (undefined :: Word64)
test_type g n (undefined :: Word)
test_type g n (undefined :: Int)
test_type g n (undefined :: Int64)
test_type g n (undefined :: Int32)
test_type g n (undefined :: Int16)
test_type g n (undefined :: Int8)
-- overhead cause by random's badness
ranges_strict g = do
let n = 100000000
test_strict g n (undefined :: Word)
test_strict g n (undefined :: Word8)
test_strict g n (undefined :: Word16)
test_strict g n (undefined :: Word32)
test_strict g n (undefined :: Word64)
test_strict g n (undefined :: Int)
test_strict g n (undefined :: Int64)
test_strict g n (undefined :: Int32)
test_strict g n (undefined :: Int16)
test_strict g n (undefined :: Int8)
test_strict g n (undefined :: Double)
test_strict g n (undefined :: Integer)
test_strict g n (undefined :: Bool)
{-
-- overhead cause by random's badness
ranges_strict_range g = do
let n = 100000000
test_strict_range g n (undefined :: Word)
test_strict_range g n (undefined :: Word8)
test_strict_range g n (undefined :: Word16)
test_strict_range g n (undefined :: Word32)
test_strict_range g n (undefined :: Word64)
test_strict_range g n (undefined :: Int)
test_strict_range g n (undefined :: Int64)
test_strict_range g n (undefined :: Int32)
test_strict_range g n (undefined :: Int16)
test_strict_range g n (undefined :: Int8)
test_strict_range g n (undefined :: Double)
test_strict_range g n (undefined :: Integer)
test_strict_range g n (undefined :: Bool)
-}
------------------------------------------------------------------------
-- check values are in range for randomRs
{-
test :: forall a . (Show a, Ord a, Typeable a, MTRandom a) => MTGen -> Int -> a -> IO ()
test g n ty = do
a' <- random g :: IO a
b' <- random g :: IO a
let (a,b) = (min a' b', max a' b')
printf "%d bounded :: %s ...\t" n (show $ typeOf ty)
hFlush stdout
time $ do
xs <- randomRs (a,b) g :: IO [a]
sequence_
[ if x >= a && x <= b
then return ()
else error $ "Fail " ++ show (x,a,b)
| x <- take n xs ]
-- printf " all good."
-}
test_type :: forall a . (Bounded a, Show a, Ord a, Typeable a, MTRandom a) => MTGen -> Int -> a -> IO ()
test_type g n ty = do
printf "lazy generation of %d :: %s ...\t" n (show $ typeOf ty)
hFlush stdout
time $ do
xs <- randoms g :: IO [a]
sequence_
[ if x >= minBound && x <= maxBound
then return ()
else error $ "Fail " ++ show x
| x <- take n xs ]
-- printf "all good. "
test_strict :: forall a . (Show a, Ord a, Typeable a, MTRandom a) => MTGen -> Int -> a -> IO ()
test_strict g n ty = do
printf "strict generation of %d :: type %s ...\t" n (show $ typeOf ty)
hFlush stdout
time $ do
let go i
| i > n = return ()
| otherwise = do
x <- random g :: IO a
x `seq` go (i+1)
go 0
-- printf "all good. "
{-
test_strict_range :: forall a . (Show a, Ord a, Typeable a, MTRandom a) => MTGen -> Int -> a -> IO ()
test_strict_range g n ty = do
a' <- random g :: IO a
b' <- random g :: IO a
let (a,b) = (min a' b', max a' b')
printf "strict, ranged generation of %d :: type %s ...\t" n (show $ typeOf ty)
hFlush stdout
time $ do
let go i
| i > n = return ()
| otherwise = do
x <- randomR (a,b) g :: IO a
if x >= a && x <= b
then go (i+1)
else error $ "test_strict_range failed " ++ show (a,b,x)
go 0
printf "all good. "
-}
------------------------------------------------------------------------
-- compare with System.Random
-- overhead cause by random's badness
speed :: forall a . (Show a, Ord a, Typeable a, Old.Random a, Num a, MTRandom a)
=> a -> MTGen -> IO ()
speed ty g = do
let lim = 5000000
time $ do
putStrLn $ "System.Random: " ++ show lim ++ " " ++ show (show $ typeOf ty)
let g = Old.mkStdGen 5
let go :: Old.StdGen -> Int -> a -> a
go !g !n !acc
| n >= lim = acc
| otherwise =
let (a,g') = Old.random g
in go g' (n+1) (if a > acc then a else acc)
print (go g 0 0)
time $ do
putStrLn $ "System.Random.Mersenne: " ++ show lim ++ " " ++ show (show $ typeOf ty)
let go !n !acc
| n >= lim = return acc
| otherwise = do
a <- random g :: IO a
go (n+1::Int) (if a > acc then a else acc)
print =<< go 0 0