Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

94 lines (79 sloc) 3.654 kb
module Roguestar.Lib.Random
(pick,
pickM,
weightedPick,
weightedPickM,
linearRoll,
fixedSumRoll,
fixedSumLinearRoll,
logRoll,
opposedLinearPowerRatio,
rationalRoll)
where
import Data.List
import Data.Maybe
import System.Random ()
import Control.Monad.Random
import Control.Monad
import Data.Ratio
-- | Pick an element of a list at random.
pick :: (RandomGen g) => [a] -> g -> (a,g)
pick elems = runRand (pickM elems)
-- | Pick an element of a weighted list at random. E.g. in "[(2,x),(3,y)]" "y" will be picked three times out of five while "x" will be picked 2 times out of five.
weightedPick :: (RandomGen g) => [(Integer,a)] -> g -> (a,g)
weightedPick elems = runRand (weightedPickM elems)
-- | 'pick' in MinadRandom
pickM :: (MonadRandom m) => [a] -> m a
pickM elems = weightedPickM (map (\x -> (1,x)) elems)
-- | 'weightedPick' in MonadRandom
weightedPickM :: (MonadRandom m) => [(Integer,a)] -> m a
weightedPickM [] = error "Tried to pick from an empty list."
weightedPickM elems =
do let (weights,values) = unzip elems
let (weight_total,weight_totals) = mapAccumL (\x y -> (x+y,x+y)) 0 weights
weight_to_find <- getRandomR (1,weight_total)
let index = fromJust $ findIndex (\x -> x >= weight_to_find) weight_totals
return $ values !! index
-- | Roll an (n+1) sided die numbered zero to n.
linearRoll :: (MonadRandom m) => Integer -> m Integer
linearRoll n = getRandomR (0,n)
-- | fixedSumRoll using 'linearRoll', with optimizations.
-- REVISIT: this can be improved significantly, but performance doesn't seem to be a material problem so far.
fixedSumLinearRoll :: (MonadRandom m) => [Integer] -> Integer -> m [Integer]
fixedSumLinearRoll xs a = fixedSumRoll (map (linearRoll . min a) xs) a
-- | Roll a sequence of random variables, such that the sum of the result is a fixed value.
fixedSumRoll :: (MonadRandom m) => [m Integer] -> Integer -> m [Integer]
fixedSumRoll rs a =
do xs <- sequence rs
case sum xs == a of
True -> return xs
False -> fixedSumRoll rs a
-- | Roll a die where the typical outcome is the base-2 logarithm of the input.
-- This function has exactly the same probability of rolling exactly 0 as 'linearDiceRoll'.
--
logRoll :: (MonadRandom m) => Integer -> m Integer
logRoll n = liftM (min n) $ accumRoll 0 n
where accumRoll c x =
do x' <- linearRoll x
case x' of
0 -> return c
_ -> accumRoll (c+1) x'
-- | Roll on a rational number that is a probability between zero and one, to generate a boolean.
rationalRoll :: (MonadRandom m) => Rational -> m Bool
rationalRoll r =
do p <- linearRoll (denominator r - 1)
return $ p < numerator r
-- | 'opposedLinearPowerRatio' is used when a constant (non-random) power relationship needs to be
-- determined between two parties. (For example, this is used in the Spot/Hide contest when determining
-- line of sight.)
--
-- It accepts negative values for either parameter, and is invertable, i.e.,
-- @opposedLinearPowerRatio a b@ = @1 - opposedLinearPowerRatio b a@
--
-- One use is: @2 * (a%1) * opposedLinearPowerRatio a b@, whichs gives you roughly @a@ if @a@ and @b@ are equal,
-- or less or more than @a@ otherwise.
opposedLinearPowerRatio :: Integer -> Integer -> Rational
opposedLinearPowerRatio a b | a < 1 = opposedLinearPowerRatio 1 (b-a+1)
opposedLinearPowerRatio a b | b < 1 = opposedLinearPowerRatio (a-b+1) 1
opposedLinearPowerRatio a b | a >= b = ((a-b) % a) + (b % a)/2
opposedLinearPowerRatio a b | otherwise = 1 - opposedLinearPowerRatio b a
Jump to Line
Something went wrong with that request. Please try again.