Skip to content

Instantly share code, notes, and snippets.

@phadej
Last active June 26, 2019 08:20
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save phadej/6552b040ecdc342ae516e83daaaee1b0 to your computer and use it in GitHub Desktop.
Save phadej/6552b040ecdc342ae516e83daaaee1b0 to your computer and use it in GitHub Desktop.
Looks like bitmaskWithRejection is good enough, if the range is small enough. In this completely bogus benchmark.
21523261
loop: 334.188ms
4238034988
loop: 19.833ms
117609953
loop: 19.107ms
3274687014
loop: 13.553ms
4259068631
loop: 9471.639ms
335970826
loop: 670.128ms
4290880512
loop: 549.245ms
2653146006
loop: 494.905ms
-- http://www.pcg-random.org/posts/bounded-rands.html
{-# LANGUAGE CPP, BangPatterns #-}
module Main where
import Data.Bits
import Data.Word (Word32, Word64)
import Data.List (unfoldr)
import qualified System.Random as R
import qualified System.Random.SplitMix32 as SM
#if defined(__GHCJS__)
#else
import Text.Printf (printf)
import System.Clock (Clock (Monotonic), getTime, toNanoSecs)
#endif
main :: IO ()
main = do
gen <- SM.newSMGen
bench gen (\g h -> R.randomR (0, pred h) g)
bench gen classicMod
bench gen intMult
bench gen bitmaskWithRejection
bench :: g -> (g -> Word32 -> (Word32, g)) -> IO ()
bench gen next = do
print $ take 70 $ unfoldr (\g -> Just (next g 10)) gen
clocked $ do
let x = sumOf next gen
print x
sumOf :: (g -> Word32 -> (Word32, g)) -> g -> Word32
sumOf next = go 0 2
where
go !acc !n g | n > 0xfffff = acc
| otherwise = let (w, g') = next g n in go (acc + w) (succ n) g'
classicMod :: SM.SMGen -> Word32 -> (Word32, SM.SMGen)
classicMod g h =
let (w32, g') = SM.nextWord32 g in (w32 `mod` h, g')
-- @
-- uint32_t bounded_rand(rng_t& rng, uint32_t range) {
-- uint32_t x = rng();
-- uint64_t m = uint64_t(x) * uint64_t(range);
-- return m >> 32;
-- }
-- @
--
intMult :: SM.SMGen -> Word32 -> (Word32, SM.SMGen)
intMult g h =
(fromIntegral $ (fromIntegral w32 * fromIntegral h :: Word64) `shiftR` 32, g')
where
(w32, g') = SM.nextWord32 g
-- @
-- uint32_t bounded_rand(rng_t& rng, uint32_t range) {
-- uint32_t mask = ~uint32_t(0);
-- --range;
-- mask >>= __builtin_clz(range|1);
-- uint32_t x;
-- do {
-- x = rng() & mask;
-- } while (x > range);
-- return x;
-- }
-- @@
bitmaskWithRejection :: SM.SMGen -> Word32 -> (Word32, SM.SMGen)
bitmaskWithRejection g0 range = go g0
where
mask = complement zeroBits `shiftR` countLeadingZeros (range .|. 1)
go g = let (x, g') = SM.nextWord32 g
x' = x .&. mask
in if x' >= range
then go g'
else (x', g')
-------------------------------------------------------------------------------
-- Poor man benchmarking with GHC and GHCJS
-------------------------------------------------------------------------------
clocked :: IO () -> IO ()
#if defined(__GHCJS__)
clocked action = do
start
action
stop
foreign import javascript unsafe
"console.time('loop');"
start :: IO ()
foreign import javascript unsafe
"console.timeEnd('loop');"
stop :: IO ()
#else
clocked action = do
start <- getTime Monotonic
action
end <- getTime Monotonic
printf "loop: %.03fms\n"
$ fromIntegral (toNanoSecs (end - start))
/ (1e6 :: Double)
#endif
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment