[commit: random] master: Fix #5133 - also yields this change a 240X speedup in generating random floats in my tests. (4cfc44a)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/random

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/4cfc44a16bd9dea222882e1762e8fb7407411600

>---------------------------------------------------------------

commit 4cfc44a16bd9dea222882e1762e8fb7407411600
Author: Ryan Newton <rrnewton at gmail.com>
Date:   Fri Jun 24 22:39:44 2011 -0400

    Fix #5133 - also yields this change a 240X speedup in generating random floats in my tests.

>---------------------------------------------------------------

 Benchmark/SimpleRNGBench.hs |   46 +++++++++++++++++++++++++++++-------------
 System/Random.hs            |   15 ++++++++++++-
 2 files changed, 45 insertions(+), 16 deletions(-)

diff --git a/Benchmark/SimpleRNGBench.hs b/Benchmark/SimpleRNGBench.hs
index 49a5a54..08b15e6 100644
--- a/Benchmark/SimpleRNGBench.hs
+++ b/Benchmark/SimpleRNGBench.hs
@@ -57,8 +57,8 @@ fmt_num n = if n < 100
 
 -- Measure clock frequency, spinning rather than sleeping to try to
 -- stay on the same core.
-measure_freq2 :: IO Int64
-measure_freq2 = do 
+measureFreq :: IO Int64
+measureFreq = do 
   let second = 1000 * 1000 * 1000 * 1000 -- picoseconds are annoying
   t1 <- rdtsc 
   start <- getCPUTime
@@ -80,14 +80,6 @@ measure_freq2 = do
 ----------------------------------------------------------------------------------------------------
 -- Drivers to get random numbers repeatedly.
 
-incr !counter = 
-  do -- modifyIORef counter (+1) -- Not strict enough!
-     -- Incrementing counter strictly (avoiding stack overflow) is annoying:
-     c <- readIORef counter
-     let c' = c+1
-     evaluate c'
-     writeIORef counter c'     
-
 -- Test overheads without actually generating any random numbers:
 data NoopRNG = NoopRNG
 instance RandomGen NoopRNG where 
@@ -119,13 +111,21 @@ timeit numthreads freq msg gen next =
      finals <- mapM readIORef counters
      let mean :: Double = fromIntegral (foldl1 (+) finals) / fromIntegral numthreads
          cycles_per :: Double = fromIntegral freq / mean
-     print_result (round mean) msg cycles_per
+     printResult (round mean) msg cycles_per
 
  where 
    infloop !counter !(!n,!g) = 
      do incr counter
 	infloop counter (next g)
 
+   incr !counter = 
+     do -- modifyIORef counter (+1) -- Not strict enough!
+	c <- readIORef counter
+	let c' = c+1
+	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.
@@ -141,7 +141,7 @@ timeit_foreign numthreads freq msg ffn = do
 
   let total_per_second = round $ fromIntegral n * (1 / t)
       cycles_per = fromIntegral freq * t / fromIntegral n
-  print_result total_per_second msg cycles_per
+  printResult total_per_second msg cycles_per
   return total_per_second
 
  where 
@@ -167,10 +167,26 @@ timeit_foreign numthreads freq msg ffn = do
      return ()
 
 
-print_result total msg cycles_per = 
+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) => 
+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)
+ where 
+  (mn,mx,sum) = loop rng n 100 (-100) 0
+  loop !rng 0 mn mx sum = (mn,mx,sum)
+  loop rng  n mn mx sum = 
+    case next rng of 
+      (x, rng') -> loop rng' (n-1) (min x mn) (max x mx) (x+sum)
+
+floatBounds = do g<-getStdGen; return$ approxBounds g random 100000 :: IO (Float,Float,Float)
+
+
 ----------------------------------------------------------------------------------------------------
 -- Main Script
 
@@ -202,13 +218,14 @@ main = do
    t2 <- rdtsc
    putStrLn ("  Cost of rdtsc (ffi call):    " ++ show (t2 - t1))
 
-   freq <- measure_freq2
+   freq <- measureFreq
    putStrLn$ "  Approx clock frequency:  " ++ commaint freq
 
    let 
        randFloat   = random :: RandomGen g => g -> (Float,g)
        randCFloat  = random :: RandomGen g => g -> (CFloat,g)
        randDouble  = random :: RandomGen g => g -> (Double,g)
+       randCDouble = random :: RandomGen g => g -> (CDouble,g)
        randInteger = random :: RandomGen g => g -> (Integer,g)
        randBool    = random :: RandomGen g => g -> (Bool,g)
 
@@ -221,6 +238,7 @@ main = do
 	 timeit th freq "System.Random Floats"   gen   randFloat
 	 timeit th freq "System.Random CFloats"  gen   randCFloat
 	 timeit th freq "System.Random Doubles"  gen   randDouble
+	 timeit th freq "System.Random CDoubles" gen   randCDouble
 	 timeit th freq "System.Random Integers" gen   randInteger
 	 timeit th freq "System.Random Bools"    gen   randBool
 
diff --git a/System/Random.hs b/System/Random.hs
index 547218f..d98f467 100644
--- a/System/Random.hs
+++ b/System/Random.hs
@@ -348,11 +348,22 @@ instance Random Double where
 -- hah, so you thought you were saving cycles by using Float?
 instance Random Float where
   randomR = randomIvalFrac
-  random  = randomFrac
+  random rng = 
+    case next rng of 
+      (x,rng') -> 
+         let 
+            -- We use 24 bits of randomness corresponding to the 24 bit significand:
+            rand = fromIntegral (mask24 .&. x) :: Float
+	 in 
+         (rand / 2^24, rng')
+   where
+     mask24 :: Int 
+     mask24 = 2^24 - 1
 
 instance Random CFloat where
   randomR = randomIvalFrac
-  random  = randomFrac
+  random rng = case random rng of 
+	         (x,rng') -> (realToFrac (x::Float), rng')
 
 instance Random CDouble where
   randomR = randomIvalFrac