Skip to content

Commit 0a04839

Browse files
jezjez
committedMay 19, 2019
Third implementation, with xoshiro256**
❯ time .stack-work/install/x86_64-osx/lts-13.21/8.6.5/bin/bingo-sim 100000 Trials: 100000 Bingos: 3670 Hit rate: 0.0367 0.11s user 0.01s system 90% cpu 0.126 total
1 parent 8886a66 commit 0a04839

File tree

5 files changed

+204
-13
lines changed

5 files changed

+204
-13
lines changed
 

‎bingo-sim.cabal

+3-2
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,10 @@ cabal-version: 1.12
44
--
55
-- see: https://github.com/sol/hpack
66
--
7-
-- hash: 26378589030ced4d8f54066cd640d122b18b9474d2082849b5a315cade4a9319
7+
-- hash: 3fa6868be54f56e844ce88095718d2f5be4a44d809a636babdeadda66d9faeba
88

99
name: bingo-sim
10-
version: 0.0.2.0
10+
version: 0.0.3.0
1111
synopsis: A small playground to learn about profiling Haskell.
1212

1313
description: This package simulates the probability of scoring a bingo at a particular children's carnival game. I've been using it to learn how profiling in Haskell works.
@@ -25,6 +25,7 @@ extra-source-files:
2525
library
2626
exposed-modules:
2727
BingoSim.Board
28+
BingoSim.Prng
2829
BingoSim.Simulation
2930
other-modules:
3031
Paths_bingo_sim

‎package.yaml

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: bingo-sim
2-
version: 0.0.2.0
2+
version: 0.0.3.0
33
homepage: https://github.com/jez/bingo-sim
44
author: Jake Zimmerman
55
maintainer: zimmerman.jake@gmail.com

‎prof/bingo-sim.3.prof

+91
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,91 @@
1+
Mon May 20 01:36 2019 Time and Allocation Profiling Report (Final)
2+
3+
bingo-sim +RTS -p -RTS 100000
4+
5+
total time = 0.49 secs (487 ticks @ 1000 us, 1 processor)
6+
total alloc = 976,788,160 bytes (excludes profiling overheads)
7+
8+
COST CENTRE MODULE SRC %time %alloc
9+
10+
next BingoSim.Prng src/BingoSim/Prng.hs:(69,1)-(81,39) 39.2 48.7
11+
shuffleBits BingoSim.Simulation src/BingoSim/Simulation.hs:(121,1)-(127,37) 26.5 34.4
12+
shuffleBits.bs' BingoSim.Simulation src/BingoSim/Simulation.hs:126:7-52 15.0 5.7
13+
swapBits BingoSim.Simulation src/BingoSim/Simulation.hs:(139,1)-(142,46) 8.8 5.2
14+
next.result BingoSim.Prng src/BingoSim/Prng.hs:70:7-41 3.7 5.7
15+
shuffleBits.gen' BingoSim.Simulation src/BingoSim/Simulation.hs:124:7-29 1.4 0.0
16+
shuffleBits.(...) BingoSim.Simulation src/BingoSim/Simulation.hs:124:7-29 1.4 0.0
17+
18+
19+
individual inherited
20+
COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
21+
22+
MAIN MAIN <built-in> 193 0 0.0 0.0 100.0 100.0
23+
CAF GHC.Conc.Signal <entire-module> 290 0 0.0 0.0 0.0 0.0
24+
CAF GHC.Float <entire-module> 282 0 0.0 0.0 0.0 0.0
25+
CAF GHC.IO.Encoding <entire-module> 272 0 0.0 0.0 0.0 0.0
26+
CAF GHC.IO.Encoding.Iconv <entire-module> 270 0 0.0 0.0 0.0 0.0
27+
CAF GHC.IO.Handle.FD <entire-module> 261 0 0.0 0.0 0.0 0.0
28+
CAF Text.Printf <entire-module> 224 0 0.0 0.0 0.0 0.0
29+
CAF Text.Read.Lex <entire-module> 222 0 0.0 0.0 0.0 0.0
30+
CAF:col1 BingoSim.Board src/BingoSim/Board.hs:148:1-4 345 0 0.0 0.0 0.0 0.0
31+
col1 BingoSim.Board src/BingoSim/Board.hs:148:1-45 421 1 0.0 0.0 0.0 0.0
32+
CAF:col2 BingoSim.Board src/BingoSim/Board.hs:151:1-4 344 0 0.0 0.0 0.0 0.0
33+
col2 BingoSim.Board src/BingoSim/Board.hs:151:1-45 422 1 0.0 0.0 0.0 0.0
34+
CAF:col3 BingoSim.Board src/BingoSim/Board.hs:154:1-4 343 0 0.0 0.0 0.0 0.0
35+
col3 BingoSim.Board src/BingoSim/Board.hs:154:1-45 423 1 0.0 0.0 0.0 0.0
36+
CAF:col4 BingoSim.Board src/BingoSim/Board.hs:157:1-4 342 0 0.0 0.0 0.0 0.0
37+
col4 BingoSim.Board src/BingoSim/Board.hs:157:1-45 424 1 0.0 0.0 0.0 0.0
38+
CAF:col5 BingoSim.Board src/BingoSim/Board.hs:160:1-4 341 0 0.0 0.0 0.0 0.0
39+
col5 BingoSim.Board src/BingoSim/Board.hs:160:1-45 425 1 0.0 0.0 0.0 0.0
40+
CAF:col6 BingoSim.Board src/BingoSim/Board.hs:163:1-4 339 0 0.0 0.0 0.0 0.0
41+
col6 BingoSim.Board src/BingoSim/Board.hs:163:1-45 426 1 0.0 0.0 0.0 0.0
42+
CAF:dia1 BingoSim.Board src/BingoSim/Board.hs:124:1-4 354 0 0.0 0.0 0.0 0.0
43+
dia1 BingoSim.Board src/BingoSim/Board.hs:124:1-45 413 1 0.0 0.0 0.0 0.0
44+
CAF:dia2 BingoSim.Board src/BingoSim/Board.hs:127:1-4 353 0 0.0 0.0 0.0 0.0
45+
dia2 BingoSim.Board src/BingoSim/Board.hs:127:1-45 414 1 0.0 0.0 0.0 0.0
46+
CAF:lvl1_r631 BingoSim.Simulation <no location info> 311 0 0.0 0.0 0.0 0.0
47+
CAF:lvl3_r633 BingoSim.Simulation <no location info> 312 0 0.0 0.0 0.0 0.0
48+
CAF:lvl5_r635 BingoSim.Simulation <no location info> 313 0 0.0 0.0 0.0 0.0
49+
CAF:lvl6_r636 BingoSim.Simulation <no location info> 314 0 0.0 0.0 0.0 0.0
50+
runSimulation BingoSim.Simulation src/BingoSim/Simulation.hs:(68,1)-(84,41) 397 0 0.0 0.0 0.0 0.0
51+
mkState BingoSim.Prng src/BingoSim/Prng.hs:(55,1)-(57,39) 398 1 0.0 0.0 0.0 0.0
52+
CAF:main1 Main <no location info> 384 0 0.0 0.0 0.0 0.0
53+
main Main app/Main.hs:(10,1)-(12,30) 386 1 0.0 0.0 0.0 0.0
54+
CAF:main4 Main <no location info> 381 0 0.0 0.0 0.0 0.0
55+
CAF:row1 BingoSim.Board src/BingoSim/Board.hs:130:1-4 351 0 0.0 0.0 0.0 0.0
56+
row1 BingoSim.Board src/BingoSim/Board.hs:130:1-45 415 1 0.0 0.0 0.0 0.0
57+
CAF:row2 BingoSim.Board src/BingoSim/Board.hs:133:1-4 350 0 0.0 0.0 0.0 0.0
58+
row2 BingoSim.Board src/BingoSim/Board.hs:133:1-45 416 1 0.0 0.0 0.0 0.0
59+
CAF:row3 BingoSim.Board src/BingoSim/Board.hs:136:1-4 349 0 0.0 0.0 0.0 0.0
60+
row3 BingoSim.Board src/BingoSim/Board.hs:136:1-45 417 1 0.0 0.0 0.0 0.0
61+
CAF:row4 BingoSim.Board src/BingoSim/Board.hs:139:1-4 348 0 0.0 0.0 0.0 0.0
62+
row4 BingoSim.Board src/BingoSim/Board.hs:139:1-45 418 1 0.0 0.0 0.0 0.0
63+
CAF:row5 BingoSim.Board src/BingoSim/Board.hs:142:1-4 347 0 0.0 0.0 0.0 0.0
64+
row5 BingoSim.Board src/BingoSim/Board.hs:142:1-45 419 1 0.0 0.0 0.0 0.0
65+
CAF:row6 BingoSim.Board src/BingoSim/Board.hs:145:1-4 346 0 0.0 0.0 0.0 0.0
66+
row6 BingoSim.Board src/BingoSim/Board.hs:145:1-45 420 1 0.0 0.0 0.0 0.0
67+
main Main app/Main.hs:(10,1)-(12,30) 387 0 0.0 0.0 100.0 100.0
68+
main.\ Main app/Main.hs:11:13-37 388 1 0.0 0.0 100.0 100.0
69+
runSimulation BingoSim.Simulation src/BingoSim/Simulation.hs:(68,1)-(84,41) 389 1 0.6 0.0 100.0 100.0
70+
hasBingo BingoSim.Board src/BingoSim/Board.hs:(82,1)-(96,32) 412 100000 0.6 0.0 0.6 0.0
71+
randomBoard BingoSim.Simulation src/BingoSim/Simulation.hs:(108,1)-(110,35) 390 100000 0.6 0.2 98.8 100.0
72+
shuffleBits BingoSim.Simulation src/BingoSim/Simulation.hs:(121,1)-(127,37) 391 3600000 26.5 34.4 98.2 99.8
73+
shuffleBits.(...) BingoSim.Simulation src/BingoSim/Simulation.hs:124:7-29 394 3500000 1.4 0.0 45.6 54.5
74+
next BingoSim.Prng src/BingoSim/Prng.hs:(69,1)-(81,39) 395 3500000 39.2 48.7 44.1 54.5
75+
next.result BingoSim.Prng src/BingoSim/Prng.hs:70:7-41 406 3500000 3.7 5.7 3.7 5.7
76+
next.s0' BingoSim.Prng src/BingoSim/Prng.hs:77:7-27 402 3499999 0.2 0.0 0.2 0.0
77+
next.s1' BingoSim.Prng src/BingoSim/Prng.hs:76:7-27 403 3499999 0.4 0.0 0.4 0.0
78+
next.s2' BingoSim.Prng src/BingoSim/Prng.hs:74:7-26 400 3499999 0.2 0.0 0.2 0.0
79+
next.s2'' BingoSim.Prng src/BingoSim/Prng.hs:79:7-26 404 3499999 0.0 0.0 0.0 0.0
80+
next.s3' BingoSim.Prng src/BingoSim/Prng.hs:75:7-26 399 3499999 0.2 0.0 0.2 0.0
81+
next.s3'' BingoSim.Prng src/BingoSim/Prng.hs:80:7-31 405 3499999 0.0 0.0 0.0 0.0
82+
next.t BingoSim.Prng src/BingoSim/Prng.hs:72:7-35 401 3499999 0.2 0.0 0.2 0.0
83+
shuffleBits.bs' BingoSim.Simulation src/BingoSim/Simulation.hs:126:7-52 408 3500000 15.0 5.7 24.2 10.9
84+
swapBits BingoSim.Simulation src/BingoSim/Simulation.hs:(139,1)-(142,46) 410 3500000 8.8 5.2 9.2 5.2
85+
swapBits.x BingoSim.Simulation src/BingoSim/Simulation.hs:141:7-53 411 3182752 0.4 0.0 0.4 0.0
86+
shuffleBits.i BingoSim.Simulation src/BingoSim/Simulation.hs:125:7-48 407 3500000 0.2 0.0 0.2 0.0
87+
shuffleBits.n' BingoSim.Simulation src/BingoSim/Simulation.hs:123:7-26 392 3500000 0.2 0.0 0.2 0.0
88+
shuffleBits.rand BingoSim.Simulation src/BingoSim/Simulation.hs:124:7-29 393 3500000 0.0 0.0 0.0 0.0
89+
shuffleBits.gen' BingoSim.Simulation src/BingoSim/Simulation.hs:124:7-29 396 3499999 1.4 0.0 1.4 0.0
90+
randomBoard.board BingoSim.Simulation src/BingoSim/Simulation.hs:109:7-26 409 100000 0.0 0.0 0.0 0.0
91+
runSimulation.rate BingoSim.Simulation src/BingoSim/Simulation.hs:81:7-58 427 1 0.0 0.0 0.0 0.0

‎src/BingoSim/Prng.hs

+98
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,98 @@
1+
-- |
2+
-- This is a port of
3+
-- [xoshiro256**](http://xoshiro.di.unimi.it/xoshiro256starstar.c) from C to
4+
-- Haskell. The documentation and comments below come from the original C
5+
-- sources.
6+
--
7+
-- = License
8+
--
9+
-- Written in 2018 by David Blackman and Sebastiano Vigna (vigna@acm.org)
10+
--
11+
-- To the extent possible under law, the author has dedicated all copyright
12+
-- and related and neighboring rights to this software to the public domain
13+
-- worldwide. This software is distributed without any warranty.
14+
--
15+
-- See <http://creativecommons.org/publicdomain/zero/1.0/>.
16+
17+
module BingoSim.Prng
18+
( State
19+
, mkState
20+
, next
21+
, jump
22+
, longJump
23+
)
24+
where
25+
26+
import Data.Bits
27+
import Data.Word
28+
29+
-- | The state of the generator.
30+
--
31+
-- The state must be seeded so that it is not everywhere zero. If you have
32+
-- a 64-bit seed, we suggest to seed a splitmix64 generator and use its
33+
-- output to fill s.
34+
--
35+
-- In Haskell, we've made this type opaque. See 'mkState' to construct a 'State'.
36+
data State = State
37+
{-# UNPACK #-} !Word64
38+
{-# UNPACK #-} !Word64
39+
{-# UNPACK #-} !Word64
40+
{-# UNPACK #-} !Word64
41+
42+
instance Show State where
43+
show (State s0 s1 s2 s3) =
44+
"mkState " ++ (show s0) ++ " " ++ (show s1) ++ " " ++ (show s2) ++ " " ++ (show s3)
45+
46+
-- | Create an initial state from a seed.
47+
--
48+
-- Raises an exception if the initial seed is all zeros.
49+
--
50+
-- >>> mkState 0 0 0 0
51+
-- *** Exception: The state must be seeded so that it is not zero everywhere.
52+
-- >>> mkState 1 2 3 4
53+
-- mkState 1 2 3 4
54+
mkState :: Word64 -> Word64 -> Word64 -> Word64 -> State
55+
mkState 0 0 0 0 =
56+
error "The state must be seeded so that it is not zero everywhere."
57+
mkState s0 s1 s2 s3 = State s0 s1 s2 s3
58+
59+
-- | This is xoshiro256** 1.0, our all-purpose, rock-solid generator. It has
60+
-- excellent (sub-ns) speed, a state (256 bits) that is large enough for
61+
-- any parallel application, and it passes all tests we are aware of.
62+
--
63+
-- For generating just floating-point numbers, xoshiro256+ is even faster.
64+
--
65+
-- >>> let state = mkState 1 2 3 4
66+
-- >>> next state
67+
-- (11520,mkState 7 0 262146 211106232532992)
68+
next :: State -> (Word64, State)
69+
next (State s0 s1 s2 s3) =
70+
let result = ((s1 * 5) `rotateL` 7) * 9
71+
72+
t = s1 `unsafeShiftL` 17
73+
74+
s2' = s2 `xor` s0
75+
s3' = s3 `xor` s1
76+
s1' = s1 `xor` s2'
77+
s0' = s0 `xor` s3'
78+
79+
s2'' = s2' `xor` t
80+
s3'' = s3' `rotateL` 45
81+
in (result, State s0' s1' s2'' s3'')
82+
83+
-- | This is the jump function for the generator. It is equivalent
84+
-- to 2^128 calls to next(); it can be used to generate 2^128
85+
-- non-overlapping subsequences for parallel computations.
86+
--
87+
-- Note: This function is not yet implemented in Haskell.
88+
jump :: State -> State
89+
jump (State _s0 _s1 _s2 _s3) = undefined
90+
91+
-- | This is the long-jump function for the generator. It is equivalent to
92+
-- 2^192 calls to next(); it can be used to generate 2^64 starting points,
93+
-- from each of which jump() will generate 2^64 non-overlapping
94+
-- subsequences for parallel distributed computations.
95+
--
96+
-- Note: This function is not yet implemented in Haskell.
97+
longJump :: State -> State
98+
longJump (State _s0 _s1 _s2 _s3) = undefined

‎src/BingoSim/Simulation.hs

+11-10
Original file line numberDiff line numberDiff line change
@@ -37,10 +37,11 @@ import Control.Monad
3737
import Data.Bits
3838
import Data.IORef
3939
import Data.Word
40-
import System.Random
4140
import Text.Printf
4241

4342
import BingoSim.Board
43+
import BingoSim.Prng (mkState, next)
44+
import qualified BingoSim.Prng as Prng
4445

4546
-- | Run the entire simulation, consisting of @trials@ trials.
4647
--
@@ -66,7 +67,7 @@ runSimulation
6667
-> IO ()
6768
runSimulation trials = do
6869
count <- newIORef 0
69-
genRef <- newStdGen >>= newIORef
70+
genRef <- newIORef (mkState 111 222 333 444)
7071

7172
replicateM_ trials $ do
7273
gen <- readIORef genRef
@@ -103,7 +104,7 @@ runSimulation trials = do
103104
--
104105
-- The sacrifice is that the naive strategy nearly exactly matches our
105106
-- intuition for how this game works in the real world.
106-
randomBoard :: RandomGen g => g -> IO (Board, g)
107+
randomBoard :: Prng.State -> IO (Board, Prng.State)
107108
randomBoard gen = do
108109
let board = Board 0x7fff
109110
return $ shuffleBits gen board 36
@@ -113,16 +114,16 @@ randomBoard gen = do
113114
-- Uses recursion to swap the current bit into place, from most to least
114115
-- significant.
115116
shuffleBits
116-
:: RandomGen g
117-
=> g
117+
:: Prng.State
118118
-> Board
119-
-> Int -- ^ @n@: The current bit we're considering swapping or leaving alone.
120-
-> (Board, g)
119+
-> Int -- ^ @n@: The current bit we're considering swapping or leaving alone (1-indexed).
120+
-> (Board, Prng.State)
121121
shuffleBits gen board 1 = (board, gen)
122122
shuffleBits gen (Board bs) n =
123-
let n' = n - 1
124-
(i, gen') = randomR (0, n') gen
125-
bs' = swapBits bs n' i
123+
let n' = n - 1
124+
(rand, gen') = next gen
125+
i = rand `mod` (fromIntegral n)
126+
bs' = swapBits bs n' (fromIntegral i)
126127
in shuffleBits gen' (Board bs') n'
127128

128129
-- | Helper for swapping two specific bits.

0 commit comments

Comments
 (0)
Please sign in to comment.