{-# LANGUAGE BangPatterns #-}
import qualified Data.IntMap as I
import System.Random
main :: IO ()
main = do
rd <- rollDices
let (a, b) = dicePi 4 300000 rd
putStrLn $ "pi = " ++ show a
print b
dicePi :: Int -> Double -> [Int] -> (Double, [(Int, Int)])
dicePi diceNum n rd = (4 * c / n, I.assocs im)
where
(c, im) = go n 0 rd (I.fromList $ zip [1..6] [0,0..])
go 0 count _ im = (count, im)
go m count rolls im =
let !h = sqrt $! x * x + y * y :: Double
(r1, rs) = splitAt diceNum rolls
r2 = take diceNum rs
!x = dicesToRandom r1
!y = dicesToRandom r2
!count' = if h < 1.0 then count + 1 else count
rolls' = drop diceNum rs
!im' = foldr (I.update ((Just $!) . succ)) im $! r1 ++ r2
in go (m - 1) count' rolls' im'
dicesToRandom :: [Int] -> Double
dicesToRandom xxs = (/ (6 ^ diceNum)) $ fromIntegral $ foldl g 0 xxs
where
g !x !y = 6 * x + y - 1
rollDices :: IO [Int]
rollDices = getStdGen >>= (return . randomRs (1, 6))