Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Drastic performance improvment for uniformR #6

Merged
merged 3 commits into from over 2 years ago

2 participants

Aleksey Khudyakov Bryan O'Sullivan
Aleksey Khudyakov
Collaborator
20-40x performance improvements for uniformR for integral times

It looks like GHC fails to specialize uniformRange despite INLINE
pragma. This results in horrible 20-40x slowdown. Adding
SPECIALIZE pragma fixes that

Also accept ranges (a,b) where a<b for integral types. It doesn't produce any
measurable slowdown.

Benchmarks are added as well
and others added some commits September 27, 2011
Aleksey Khudyakov Add uniformR to benchmarks 43ca7d7
20-40x performance improvements for uniformR for integral times
It looks like GHC fails to specialize uniformRange despite INLINE
pragma. This results in horrible 20-40x slowdown. Adding
SPECIALIZE pragma fixes that

Also accept ranges (a,b) where a<b. It doesn't produce any
measurable slowdown.

fixes #4.
d7fda63
Aleksey Khudyakov Fix uniformRange for case where (x1 > x2) 3909677
Aleksey Khudyakov
Collaborator

Ping?

Bryan O'Sullivan bos merged commit 1c1f03a into from December 12, 2011
Bryan O'Sullivan bos closed this December 12, 2011
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 3 unique commits by 2 authors.

Sep 28, 2011
Aleksey Khudyakov Add uniformR to benchmarks 43ca7d7
Sep 29, 2011
20-40x performance improvements for uniformR for integral times
It looks like GHC fails to specialize uniformRange despite INLINE
pragma. This results in horrible 20-40x slowdown. Adding
SPECIALIZE pragma fixes that

Also accept ranges (a,b) where a<b. It doesn't produce any
measurable slowdown.

fixes #4.
d7fda63
Sep 30, 2011
Aleksey Khudyakov Fix uniformRange for case where (x1 > x2) 3909677
This page is out of date. Refresh to see the latest.
41  System/Random/MWC.hs
@@ -478,21 +478,11 @@ type instance Unsigned Word   = Word
478 478
 -- unsigned data type of same size
479 479
 sub :: (Integral a, Integral (Unsigned a)) => a -> a -> Unsigned a
480 480
 sub x y = fromIntegral x - fromIntegral y
  481
+{-# INLINE sub #-}
481 482
 
482 483
 add :: (Integral a, Integral (Unsigned a)) => a -> Unsigned a -> a
483 484
 add m x = m + fromIntegral x
484  
-
485  
--- Generate uniform value in the range [0,n). Values must be
486  
--- unsigned. Second parameter is random number generator
487  
-unsignedRange :: (PrimMonad m, Integral a, Bounded a) => a -> m a -> m a
488  
-unsignedRange n rnd = go
489  
-  where
490  
-    buckets = maxBound `div` n
491  
-    maxN    = buckets * n
492  
-    go = do x <- rnd
493  
-            if x < maxN then return (x `div` buckets)
494  
-                        else go
495  
-{-# INLINE unsignedRange #-}
  485
+{-# INLINE add #-}
496 486
 
497 487
 -- Generate unformly distributed value in inclusive range.
498 488
 uniformRange :: ( PrimMonad m
@@ -500,10 +490,31 @@ uniformRange :: ( PrimMonad m
500 490
                 , Integral (Unsigned a), Bounded (Unsigned a), Variate (Unsigned a))
501 491
              => (a,a) -> Gen (PrimState m) -> m a
502 492
 uniformRange (x1,x2) g
503  
-  | x1 == minBound && x2 == maxBound = uniform g
504  
-  | otherwise                        = do x <- unsignedRange (sub x2 x1 + 1) (uniform g)
505  
-                                          return $! add x1 x
  493
+  | n == 0    = uniform g   -- Abuse overflow in unsigned types
  494
+  | otherwise = loop
  495
+  where
  496
+    -- Allow ranges where x2<x1
  497
+    (# a, b #) | x1 < x2   = (# x1, x2 #)
  498
+               | otherwise = (# x2, x1 #)
  499
+    n       = 1 + sub b a
  500
+    buckets = maxBound `div` n
  501
+    maxN    = buckets * n
  502
+    loop    = do x <- uniform g
  503
+                 if x < maxN then return $! add a (x `div` buckets)
  504
+                             else loop
506 505
 {-# INLINE uniformRange #-}
  506
+-- These SPECIALIZE pragmas are crucial for performance. Without them
  507
+-- generic version is used which is 20-40 times slower.
  508
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Int,   Int)    -> Gen (PrimState m) -> m Int    #-}
  509
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Int8,  Int8)   -> Gen (PrimState m) -> m Int8   #-}
  510
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Int16, Int16)  -> Gen (PrimState m) -> m Int16  #-}
  511
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Int32, Int32)  -> Gen (PrimState m) -> m Int32  #-}
  512
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Int64, Int64)  -> Gen (PrimState m) -> m Int64  #-}
  513
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Word,  Word)   -> Gen (PrimState m) -> m Word   #-}
  514
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Word8, Word8)  -> Gen (PrimState m) -> m Word8  #-}
  515
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Word16,Word16) -> Gen (PrimState m) -> m Word16 #-}
  516
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Word32,Word32) -> Gen (PrimState m) -> m Word32 #-}
  517
+{-# SPECIALIZE uniformRange :: (PrimMonad m) => (Word64,Word64) -> Gen (PrimState m) -> m Word64 #-}
507 518
 
508 519
 -- | Generate a vector of pseudo-random variates.  This is not
509 520
 -- necessarily faster than invoking 'uniform' repeatedly in a loop,
48  benchmarks/Benchmark.hs
@@ -12,18 +12,42 @@ main = do
12 12
   mtg <- M.newMTGen . Just =<< uniform mwc
13 13
   defaultMain 
14 14
     [ bgroup "mwc"
15  
-      [ bench "Double"  (uniform mwc :: IO Double)
16  
-      , bench "Int"     (uniform mwc :: IO Int)
17  
-      , bench "Int8"    (uniform mwc :: IO Int8)
18  
-      , bench "Int16"   (uniform mwc :: IO Int16)
19  
-      , bench "Int32"   (uniform mwc :: IO Int32)
20  
-      , bench "Int64"   (uniform mwc :: IO Int64)
21  
-      , bench "Word"    (uniform mwc :: IO Word)
22  
-      , bench "Word8"   (uniform mwc :: IO Word8)
23  
-      , bench "Word16"  (uniform mwc :: IO Word16)
24  
-      , bench "Word32"  (uniform mwc :: IO Word32)
25  
-      , bench "Word64"  (uniform mwc :: IO Word64)
26  
-      , bench "normal"  (normal mwc :: IO Double)
  15
+      -- One letter group names are used so they will fit on the plot.
  16
+      --
  17
+      --  U - uniform
  18
+      --  R - uniformR
  19
+      --  D - distribution
  20
+      [ bgroup "U"
  21
+        [ bench "Double"  (uniform mwc :: IO Double)
  22
+        , bench "Int"     (uniform mwc :: IO Int)
  23
+        , bench "Int8"    (uniform mwc :: IO Int8)
  24
+        , bench "Int16"   (uniform mwc :: IO Int16)
  25
+        , bench "Int32"   (uniform mwc :: IO Int32)
  26
+        , bench "Int64"   (uniform mwc :: IO Int64)
  27
+        , bench "Word"    (uniform mwc :: IO Word)
  28
+        , bench "Word8"   (uniform mwc :: IO Word8)
  29
+        , bench "Word16"  (uniform mwc :: IO Word16)
  30
+        , bench "Word32"  (uniform mwc :: IO Word32)
  31
+        , bench "Word64"  (uniform mwc :: IO Word64)
  32
+        ]
  33
+      , bgroup "R"
  34
+        -- I'm not entirely convinced that this is right way to test
  35
+        -- uniformR. /A.Khudyakov/
  36
+        [ bench "Double"  (uniformR (-3.21,26) mwc :: IO Double)
  37
+        , bench "Int"     (uniformR (-12,679)  mwc :: IO Int)
  38
+        , bench "Int8"    (uniformR (-12,4)    mwc :: IO Int8)
  39
+        , bench "Int16"   (uniformR (-12,679)  mwc :: IO Int16)
  40
+        , bench "Int32"   (uniformR (-12,679)  mwc :: IO Int32)
  41
+        , bench "Int64"   (uniformR (-12,679)  mwc :: IO Int64)
  42
+        , bench "Word"    (uniformR (34,633)   mwc :: IO Word)
  43
+        , bench "Word8"   (uniformR (34,63)    mwc :: IO Word8)
  44
+        , bench "Word16"  (uniformR (34,633)   mwc :: IO Word16)
  45
+        , bench "Word32"  (uniformR (34,633)   mwc :: IO Word32)
  46
+        , bench "Word64"  (uniformR (34,633)   mwc :: IO Word64)
  47
+        ]
  48
+      , bgroup "D"
  49
+        [ bench "normal"  (normal mwc :: IO Double)
  50
+        ]
27 51
       ]
28 52
     , bgroup "random"
29 53
       [
Commit_comment_tip

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.