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 <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
