← Back to branch summary

~ubuntu-branches/ubuntu/trusty/haskell-mersenne-random-pure64/trusty

« back to all changes in this revision

Viewing changes to tests/Unit.hs

  • Committer: Package Import Robot
  • Author(s): Joachim Breitner
  • Date: 2012-12-09 13:43:33 UTC
  • Revision ID: package-import@ubuntu.com-20121209134333-d6wrwl64m871qfgf
Tags: upstream-0.2.0.3
Import upstream version 0.2.0.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/Unit.hs
 
1
{-# LANGUAGE BangPatterns #-}
 
2
-- A basic correctness and performance test for mersenne-random-pure64.
 
3
--
 
4
-- Copyright (c) 2008, Don Stewart <dons@galois.com>
 
5
 
 
6
import Control.Exception
 
7
import Control.Monad
 
8
import Data.Int
 
9
import Data.Typeable
 
10
import Data.Word
 
11
import System.CPUTime
 
12
import System.Environment
 
13
import System.IO
 
14
import Text.Printf
 
15
import qualified System.Random as Old
 
16
import qualified System.Random.Mersenne as Unsafe
 
17
 
 
18
import System.Random.Mersenne.Pure64
 
19
import System.Random.Mersenne.Pure64.Base
 
20
import Control.Concurrent
 
21
import Control.Concurrent.MVar
 
22
 
 
23
time :: IO t -> IO t
 
24
time a = do
 
25
    start <- getCPUTime
 
26
    v <- a
 
27
    end   <- getCPUTime
 
28
    let diff = (fromIntegral (end - start)) / (10^12)
 
29
    printf "Computation time: %0.3f sec\n" (diff :: Double)
 
30
    return v
 
31
 
 
32
seed = 7
 
33
 
 
34
main = do
 
35
 
 
36
    c_init_genrand64_unsafe seed
 
37
    let g = pureMT (fromIntegral seed)
 
38
 
 
39
    ------------------------------------------------------------------------
 
40
    -- calibrate
 
41
    s <- newMVar 0 :: IO (MVar Int)
 
42
    putStr "Calibrating ... " >> hFlush stdout
 
43
 
 
44
    tid <- forkIO $ do
 
45
        let go !i !g = do
 
46
                let (!_, !g') = randomWord64 g
 
47
                x <- swapMVar s i
 
48
                x `seq` go (i+1) g'
 
49
        go 0 g
 
50
 
 
51
    threadDelay (1000 * 1000)
 
52
    killThread tid
 
53
    lim <- readMVar s -- 1 sec worth of generation
 
54
    putStrLn $ "done. Using N=" ++ show lim
 
55
 
 
56
    time $ do
 
57
        let m = 2*lim
 
58
        putStr $ "Checking against released mt19937-64.c to depth " ++ show m ++ " "
 
59
        hFlush stdout
 
60
        equivalent g m
 
61
 
 
62
    speed lim
 
63
 
 
64
    return ()
 
65
 
 
66
------------------------------------------------------------------------
 
67
 
 
68
equivalent !g !n | n > 0 = do
 
69
 
 
70
    i'      <- c_genrand64_int64_unsafe
 
71
    d'      <- c_genrand64_real2_unsafe
 
72
 
 
73
    let (i, g')  = randomWord64 g
 
74
        (d, g'') = randomDouble g'
 
75
 
 
76
    if i == fromIntegral i' && d == realToFrac d'
 
77
        then do when (n `rem` 500000 == 0) $ putChar '.' >> hFlush stdout
 
78
                equivalent g'' (n-1)
 
79
 
 
80
        else do print $ "Failed! " ++ show ((i,i') , (d,d'))
 
81
                return g''
 
82
 
 
83
equivalent g _ = do putStrLn "Matches model!"
 
84
                    return g
 
85
 
 
86
------------------------------------------------------------------------
 
87
-- compare with System.Random
 
88
 
 
89
-- overhead cause by random's badness
 
90
speed lim = do
 
91
 
 
92
 time $ do
 
93
    putStrLn $ "System.Random"
 
94
    let g = Old.mkStdGen 5
 
95
    let go :: Old.StdGen -> Int -> Int -> Int
 
96
        go !g !n !acc
 
97
            | n >= lim = acc
 
98
            | otherwise     =
 
99
                    let (a, g') = Old.random g
 
100
                    in go g' (n+1) (if a > acc then a else acc)
 
101
    print (go g 0 0)
 
102
 
 
103
 time $ do
 
104
    putStrLn $ "System.Random with our generator"
 
105
    let g = pureMT 5
 
106
    let go :: PureMT -> Int -> Int -> Int
 
107
        go !g !n !acc
 
108
            | n >= lim = acc
 
109
            | otherwise     =
 
110
                    let (a,g') = Old.random g
 
111
                    in go g' (n+1) (if a > acc then a else acc)
 
112
    print (go g 0 0)
 
113
 
 
114
 time $ do
 
115
    putStrLn $ "System.Random.Mersenne.Pure"
 
116
    let g = pureMT 5
 
117
    let go :: PureMT -> Int -> Int -> Int
 
118
        go !g !n !acc
 
119
            | n >= lim = acc
 
120
            | otherwise     =
 
121
                    let (a',g') = randomWord64 g
 
122
                        a = fromIntegral a'
 
123
                    in go g' (n+1) (if a > acc then a else acc)
 
124
    print (go g 0 0)
 
125
 
 
126
 time $ do
 
127
    putStrLn $ "System.Random.Mersenne.Pure generating Double"
 
128
    let g = pureMT 5
 
129
    let go :: PureMT -> Int -> Double -> Double
 
130
        go !g !n !acc
 
131
            | n >= lim = acc
 
132
            | otherwise     =
 
133
                    let (a, g') = randomDouble g
 
134
                    in go g' (n+1) (if a > acc then a else acc)
 
135
    print (go g 0 0)
 
136
 
 
137
 time $ do
 
138
    putStrLn $ "System.Random.Mersenne.Pure (unique state)"
 
139
    c_init_genrand64_unsafe 5
 
140
    let go :: Int -> Int -> IO Int
 
141
        go !n !acc
 
142
            | n >= lim = return acc
 
143
            | otherwise     = do
 
144
                    a' <- c_genrand64_int64_unsafe
 
145
                    let a = fromIntegral a'
 
146
                    go (n+1) (if a > acc then a else acc)
 
147
    print =<< go 0 0
 
148
 
 
149
 time $ do
 
150
    putStrLn $ "System.Random.Mersenne.Unsafe"
 
151
    g <- Unsafe.newMTGen (Just 5)
 
152
 
 
153
    let go :: Int -> Int -> IO Int
 
154
        go !n !acc
 
155
            | n >= lim = return acc
 
156
            | otherwise     = do
 
157
                    a <- Unsafe.random g
 
158
                    go (n+1) (if a > acc then a else acc)
 
159
 
 
160
    print =<< go 0 0
 
161
 
 
162
 
 
163
--    printf "MT is %s times faster generating %s\n" (show $x`div`y) (show (typeOf ty))
 
164
--    return ()
 
165