Tweaked SimpleRNGBench to be warning-free as well and added some additional tests...
authorRyan Newton <rrnewton@gmail.com>
Sun, 26 Jun 2011 04:08:40 +0000 (00:08 -0400)
committerRyan Newton <rrnewton@gmail.com>
Sun, 26 Jun 2011 04:08:40 +0000 (00:08 -0400)
Benchmark/SimpleRNGBench.hs

index 08b15e6..c5d3b9e 100644 (file)
@@ -9,7 +9,6 @@ import System.Exit (exitSuccess, exitFailure)
 import System.Environment
 import System.Random
 import System.CPUTime  (getCPUTime)
--- import Data.Time.Clock (diffUTCTime)
 import System.CPUTime.Rdtsc
 import System.Console.GetOpt
 
@@ -18,10 +17,8 @@ import Control.Concurrent
 import Control.Monad 
 import Control.Exception
 
--- import Crypto.Random (CryptoRandomGen(..))
-
 import Data.IORef
-import Data.List
+import Data.List hiding (last,sum)
 import Data.Int
 import Data.List.Split
 import Text.Printf
@@ -32,6 +29,7 @@ import Foreign.ForeignPtr
 import Foreign.Storable (peek,poke)
 
 import Benchmark.BinSearch
+import Prelude  hiding (last,sum)
 
 ----------------------------------------------------------------------------------------------------
 -- Miscellaneous helpers:
@@ -44,15 +42,18 @@ commaint n =
    chunk 3 $ 
    reverse (show n)
 
+padleft :: Int -> String -> String
 padleft n str | length str >= n = str
 padleft n str | otherwise       = take (n - length str) (repeat ' ') ++ str
 
+padright :: Int -> String -> String
 padright n str | length str >= n = str
 padright n str | otherwise       = str ++ take (n - length str) (repeat ' ')
 
+fmt_num :: (RealFrac a, PrintfArg a) => a -> String
 fmt_num n = if n < 100 
            then printf "%.2f" n
-           else commaint (round n)
+           else commaint (round n :: Integer)
 
 
 -- Measure clock frequency, spinning rather than sleeping to try to
@@ -71,7 +72,7 @@ measureFreq = do
           then loop (n+1) t2
           else return (n,t2)
   (n,t2) <- loop 0 t1
-  putStrLn$ "  Approx getCPUTime calls per second: "++ commaint n
+  putStrLn$ "  Approx getCPUTime calls per second: "++ commaint (n::Int64)
   when (t2 < t1) $ 
     putStrLn$ "WARNING: rdtsc not monotonically increasing, first "++show t1++" then "++show t2++" on the same OS thread"
 
@@ -98,38 +99,38 @@ type Kern = Int -> Ptr Int -> IO ()
 -- foreign import ccall unsafe "stdlib.hs" rand :: IO Int
 
 {-# INLINE timeit #-}
---timeit :: (Random a, RandomGen g) => 
---       Int -> Int64 -> String -> g -> (g -> (a,g)) -> IO ()
-timeit numthreads freq msg gen next =
+timeit :: (Random a, RandomGen g) => 
+         Int -> Int64 -> String -> g -> (g -> (a,g)) -> IO ()
+timeit numthreads freq msg gen nxt =
   do 
-     counters <- forM [1..numthreads] (const$ newIORef 1
+     counters <- forM [1..numthreads] (const$ newIORef (1::Int64)
      tids <- forM counters $ \counter -> 
-               forkIO $ infloop counter (next gen)   
+               forkIO $ infloop counter (nxt gen)   
      threadDelay (1000*1000) -- One second
      mapM_ killThread tids
 
      finals <- mapM readIORef counters
      let mean :: Double = fromIntegral (foldl1 (+) finals) / fromIntegral numthreads
          cycles_per :: Double = fromIntegral freq / mean
-     printResult (round mean) msg cycles_per
+     printResult (round mean :: Int64) msg cycles_per
 
  where 
-   infloop !counter !(!n,!g) = 
+   infloop !counter !(!_,!g) = 
      do incr counter
-       infloop counter (next g)
+       infloop counter (nxt g)
 
    incr !counter = 
      do -- modifyIORef counter (+1) -- Not strict enough!
        c <- readIORef counter
        let c' = c+1
-       evaluate c'
+       _ <- evaluate c'
        writeIORef counter c'     
 
 
 -- This function times an IO function on one or more threads.  Rather
 -- than running a fixed number of iterations, it uses a binary search
 -- to find out how many iterations can be completed in a second.
-timeit_foreign :: Int -> Int64 -> String -> (Int -> Ptr Int -> IO ()) -> IO Int
+timeit_foreign :: Int -> Int64 -> String -> (Int -> Ptr Int -> IO ()) -> IO Int64
 timeit_foreign numthreads freq msg ffn = do 
   ptr     :: ForeignPtr Int <- mallocForeignPtr
 
@@ -147,43 +148,44 @@ timeit_foreign numthreads freq msg ffn = do
  where 
    -- This lifts a C kernel to operate simultaneously on N threads.
    replicate_kernel :: Int -> Kern -> Kern
-   replicate_kernel numthreads kern n ptr = do
-     ptrs <- forM [1..numthreads]
+   replicate_kernel nthreads kern n ptr = do
+     ptrs <- forM [1..nthreads]
               (const mallocForeignPtr) 
      tmpchan <- newChan
-     -- let childwork = ceiling$ fromIntegral n / fromIntegral numthreads
+     -- let childwork = ceiling$ fromIntegral n / fromIntegral nthreads
      let childwork = n -- Keep it the same.. interested in per-thread throughput.
      -- Fork/join pattern:
-     tids <- forM ptrs $ \ptr -> forkIO $ 
-             withForeignPtr ptr $ \p -> do
+     _ <- forM ptrs $ \pt -> forkIO $ 
+             withForeignPtr pt $ \p -> do
                 kern (fromIntegral childwork) p
                 result <- peek p
                 writeChan tmpchan result
 
-     results <- forM [1..numthreads] $ \_ -> 
+     results <- forM [1..nthreads] $ \_ -> 
                  readChan tmpchan
      -- Meaningless semantics here... sum the child ptrs and write to the input one:
      poke ptr (foldl1 (+) results)
      return ()
 
 
+printResult ::  Int64 -> String -> Double -> IO ()
 printResult total msg cycles_per = 
      putStrLn$ "    "++ padleft 11 (commaint total) ++" randoms generated "++ padright 27 ("["++msg++"]") ++" ~ "
               ++ fmt_num cycles_per ++" cycles/int"
 
 
--- Take many measurements
---approxBounds :: (RandomGen g, Random a, Ord a, Bounded a) => 
+-- Take many measurements and record the max/min/average random values.
 approxBounds :: (RandomGen g, Random a, Ord a, Num a, Fractional a) => 
                g -> (g -> (a,g)) -> Int -> (a,a,a)
-approxBounds rng next n = (mn,mx, sum / fromIntegral n)
+approxBounds initrng nxt iters = (mn_, mx_, sum_ / fromIntegral iters)
  where 
-  (mn,mx,sum) = loop rng n 100 (-100) 0
-  loop !rng 0 mn mx sum = (mn,mx,sum)
+  (mn_, mx_, sum_) = loop initrng iters 100 (-100) 0 -- Oops, can't use minBound/maxBound here.
+  loop _ 0 mn mx sum = (mn,mx,sum)
   loop rng  n mn mx sum = 
-    case next rng of 
+    case nxt rng of 
       (x, rng') -> loop rng' (n-1) (min x mn) (max x mx) (x+sum)
 
+floatBounds :: IO (Float, Float, Float)
 floatBounds = do g<-getStdGen; return$ approxBounds g random 100000 :: IO (Float,Float,Float)
 
 
@@ -193,12 +195,13 @@ floatBounds = do g<-getStdGen; return$ approxBounds g random 100000 :: IO (Float
 data Flag = NoC | Help 
   deriving (Show, Eq)
 
+options :: [OptDescr Flag]
 options = 
    [ Option ['h']  ["help"]  (NoArg Help)  "print program help"
    , Option []     ["noC"]   (NoArg NoC)   "omit C benchmarks, haskell only"
    ]
 
-  
+main :: IO ()
 main = do 
    argv <- getArgs
    let (opts,_,other) = getOpt Permute options argv
@@ -222,6 +225,7 @@ main = do
    putStrLn$ "  Approx clock frequency:  " ++ commaint freq
 
    let 
+       randInt     = random :: RandomGen g => g -> (Int,g)
        randFloat   = random :: RandomGen g => g -> (Float,g)
        randCFloat  = random :: RandomGen g => g -> (CFloat,g)
        randDouble  = random :: RandomGen g => g -> (Double,g)
@@ -229,12 +233,21 @@ main = do
        randInteger = random :: RandomGen g => g -> (Integer,g)
        randBool    = random :: RandomGen g => g -> (Bool,g)
 
+       -- rangeFloat  g = randomR (-100, 100::Float)   g
+       -- rangeCFloat  g = randomR (-100, 100::CFloat)  g
+       -- rangeDouble  g = randomR (-100, 100::Double)  g
+       -- rangeCDouble g = randomR (-100, 100::CDouble) g
+       -- rangeInteger g = randomR (-100, 100::Integer) g
+       -- rangeBool    g = randomR (False, True)        g
+
        gen = mkStdGen 23852358661234
        gamut th = do
-        putStrLn$ "  First, timing with System.Random interface:"
+        putStrLn$ "  First, timing System.Random.next:"
         timeit th freq "constant zero gen"    NoopRNG next 
         timeit th freq "System.Random stdGen" gen     next 
 
+        putStrLn$ "\n  Second, timing System.Random.random at different types:"
+        timeit th freq "System.Random Ints"     gen   randInt
         timeit th freq "System.Random Floats"   gen   randFloat
         timeit th freq "System.Random CFloats"  gen   randCFloat
         timeit th freq "System.Random Doubles"  gen   randDouble
@@ -242,6 +255,16 @@ main = do
         timeit th freq "System.Random Integers" gen   randInteger
         timeit th freq "System.Random Bools"    gen   randBool
 
+        putStrLn$ "\n  Third, timing range-restricted System.Random.randomR:"
+        timeit th freq "System.Random Ints"     gen   (randomR (-100, 100::Int))
+        timeit th freq "System.Random Floats"   gen   (randomR (-100, 100::Float))
+        timeit th freq "System.Random CFloats"  gen   (randomR (-100, 100::CFloat))
+        timeit th freq "System.Random Doubles"  gen   (randomR (-100, 100::Double))
+        timeit th freq "System.Random CDoubles" gen   (randomR (-100, 100::CDouble))
+        timeit th freq "System.Random Integers" gen   (randomR (-100, 100::Integer))
+        timeit th freq "System.Random Bools"    gen   (randomR (False, True::Bool))
+
+
   --       when (not$ NoC `elem` opts) $ do
   --     putStrLn$ "  Comparison to C's rand():"
   --     timeit_foreign th freq "ptr store in C loop"   store_loop