{-# LANGUAGE BangPatterns #-}
import qualified Data.IntMap as I
import System.Random
 
main :: IO ()
main = do
  rd <- rollDice
  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'
    diceToRandom :: [Int] -> Double
    diceToRandom xxs = (/ (6 ^ diceNum)) $ fromIntegral $ foldl g 0 xxs
      where
        g !x !y = 6 * x + y - 1
 
rollDice :: IO [Int]
rollDice = getStdGen >>= (return . randomRs (1, 6))
 

ey0jIExBTkdVQUdFIEJhbmdQYXR0ZXJucyAjLX0KaW1wb3J0IHF1YWxpZmllZCBEYXRhLkludE1hcCBhcyBJCmltcG9ydCBTeXN0ZW0uUmFuZG9tCgptYWluIDo6IElPICgpCm1haW4gPSBkbwogIHJkIDwtIHJvbGxEaWNlCiAgbGV0IChhLCBiKSA9IGRpY2VQaSA0IDMwMDAwMCByZAoKICBwdXRTdHJMbiAkICJwaSA9ICIgKysgc2hvdyBhCiAgcHJpbnQgYgoKZGljZVBpIDo6IEludCAtPiBEb3VibGUgLT4gW0ludF0gLT4gKERvdWJsZSwgWyhJbnQsIEludCldKQpkaWNlUGkgZGljZU51bSBuIHJkID0gKDQgKiBjIC8gbiwgSS5hc3NvY3MgaW0pCiAgd2hlcmUKICAgIChjLCBpbSkgPSBnbyBuIDAgcmQgKEkuZnJvbUxpc3QgJCB6aXAgWzEuLjZdIFswLDAuLl0pCiAgICBnbyAwIGNvdW50IF8gICAgIGltID0gKGNvdW50LCBpbSkKICAgIGdvIG0gY291bnQgcm9sbHMgaW0gPQogICAgICBsZXQgIWggPSBzcXJ0ICQhIHggKiB4ICsgeSAqIHkgOjogRG91YmxlCiAgICAgICAgICAocjEsIHJzKSA9IHNwbGl0QXQgZGljZU51bSByb2xscwogICAgICAgICAgcjIgICAgICAgPSB0YWtlIGRpY2VOdW0gcnMKICAgICAgICAgICF4ICAgICAgID0gZGljZXNUb1JhbmRvbSByMQogICAgICAgICAgIXkgICAgICAgPSBkaWNlc1RvUmFuZG9tIHIyCiAgICAgICAgICAhY291bnQnICA9IGlmIGggPCAxLjAgdGhlbiBjb3VudCArIDEgZWxzZSBjb3VudAogICAgICAgICAgcm9sbHMnICAgPSBkcm9wIGRpY2VOdW0gcnMKICAgICAgICAgICFpbScgICAgID0gZm9sZHIgKEkudXBkYXRlICgoSnVzdCAkISkgLiBzdWNjKSkgaW0gJCEgcjEgKysgcjIKICAgICAgaW4gZ28gKG0gLSAxKSBjb3VudCcgcm9sbHMnIGltJwogICAgZGljZVRvUmFuZG9tIDo6IFtJbnRdIC0+IERvdWJsZQogICAgZGljZVRvUmFuZG9tIHh4cyA9ICgvICg2IF4gZGljZU51bSkpICQgZnJvbUludGVncmFsICQgZm9sZGwgZyAwIHh4cwogICAgICB3aGVyZQogICAgICAgIGcgIXggIXkgPSA2ICogeCArIHkgLSAxCgpyb2xsRGljZSA6OiBJTyBbSW50XQpyb2xsRGljZSA9IGdldFN0ZEdlbiA+Pj0gKHJldHVybiAuIHJhbmRvbVJzICgxLCA2KSkK