module Game.LambdaHack.Random
(
Rnd
, randomR, oneOf, frequency, roll
, RollDice(..), rollDice, maxDice, minDice, meanDice
, RollDiceXY(..), rollDiceXY
, RollDeep, rollDeep, chanceDeep, intToDeep, maxDeep
, Chance, chance
) where
import qualified Data.Binary as Binary
import Data.Ratio
import qualified System.Random as R
import Control.Monad
import qualified Data.List as L
import qualified Control.Monad.State as MState
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Utils.Frequency
type Rnd a = MState.State R.StdGen a
randomR :: (R.Random a) => (a, a) -> Rnd a
randomR range = MState.state $ R.randomR range
oneOf :: [a] -> Rnd a
oneOf xs = do
r <- randomR (0, length xs 1)
return (xs !! r)
frequency :: Show a => Frequency a -> Rnd a
frequency fr = MState.state $ rollFreq fr
roll :: Int -> Rnd Int
roll x = if x <= 0 then return 0 else randomR (1, x)
data RollDice = RollDice Binary.Word8 Binary.Word8
deriving (Eq, Ord)
instance Show RollDice where
show (RollDice a b) = show a ++ "d" ++ show b
instance Read RollDice where
readsPrec d s =
let (a, db) = L.break (== 'd') s
av = read a
in case db of
'd' : b -> [ (RollDice av bv, rest) | (bv, rest) <- readsPrec d b ]
_ -> []
rollDice :: RollDice -> Rnd Int
rollDice (RollDice a' 1) = return $ fromEnum a'
rollDice (RollDice a' b') =
let (a, b) = (fromEnum a', fromEnum b')
in liftM sum (replicateM a (roll b))
maxDice :: RollDice -> Int
maxDice (RollDice a' b') =
let (a, b) = (fromEnum a', fromEnum b')
in a * b
minDice :: RollDice -> Int
minDice (RollDice a' b') =
let (a, b) = (fromEnum a', fromEnum b')
in if b == 0 then 0 else a
meanDice :: RollDice -> Rational
meanDice (RollDice a' b') =
let (a, b) = (fromIntegral a', fromIntegral b')
in if b' == 0 then 0 else a * (b + 1) % 2
data RollDiceXY = RollDiceXY (RollDice, RollDice)
deriving Show
rollDiceXY :: RollDiceXY -> Rnd (Int, Int)
rollDiceXY (RollDiceXY (xd, yd)) = do
x <- rollDice xd
y <- rollDice yd
return (x, y)
type RollDeep = (RollDice, RollDice)
rollDeep :: Int -> Int -> RollDeep -> Rnd Int
rollDeep n depth (d1, d2) =
assert (n > 0 && n <= depth `blame` (n, depth)) $ do
r1 <- rollDice d1
r2 <- rollDice d2
return $ r1 + ((n 1) * r2) `div` max 1 (depth 1)
chanceDeep :: Int -> Int -> RollDeep -> Rnd Bool
chanceDeep n depth deep = do
c <- rollDeep n depth deep
return $ c > 50
intToDeep :: Int -> RollDeep
intToDeep 0 = (RollDice 0 0, RollDice 0 0)
intToDeep n' = let n = toEnum n'
in if n > maxBound || n < minBound
then assert `failure` n'
else (RollDice n 1, RollDice 0 0)
maxDeep :: RollDeep -> Int
maxDeep (d1, d2) = maxDice d1 + maxDice d2
type Chance = Rational
chance :: Chance -> Rnd Bool
chance r = do
let n = numerator r
d = denominator r
k <- randomR (1, d)
return (k <= n)