diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2010, Neil Brown + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Neil Brown nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Numeric/Probability/Game/Dice.hs b/Numeric/Probability/Game/Dice.hs new file mode 100644 --- /dev/null +++ b/Numeric/Probability/Game/Dice.hs @@ -0,0 +1,101 @@ + +-- | A module containing various definitions of dice as random events, and a few +-- associated helper functions. See 'DieRoll', which is really a synonym for 'EventM' +-- Int. +module Numeric.Probability.Game.Dice ( + -- * Main die roll type + DieRoll, roll, + -- * Dice definitions + d4, d6, d8, z10, d10, d12, d20, d100, z100, d, z, + -- * Dice helper functions + rerollOn) where + +import Numeric.Probability.Game.Event (EventM, enact, makeEvent, makeEventProb, outcomes) + +-- | A type synonym for events with an integer outcome (i.e. all standard die rolls). +-- +-- The 'Num' instance for @EventM Int@ allows you to add the results of two die +-- rolls, or subtract them (if it helps, @(+) = liftA2 (+)@). +-- +-- Multiplication works as follows. @d * e@ evaluates the first die roll, +-- then sums that many rolls of the second. So @2 * d6@ rolls two d6 and adds +-- the outcomes. However, this definition means that @d6 * 2@ rolls one d6, +-- then effectively scales the result by 2. And @d6 * d4@ rolls one d6, then +-- rolls that number of @d4@, adding their results together. The simple rule +-- when one of the terms is a constant is: use the constant on the left-hand +-- side to get more dice, and use the constant on the right-hand side to scale +-- the result. +type DieRoll = EventM Int + + +-- | A die with an equal chance of rolling 1, 2, 3 or 4. +d4 :: DieRoll +d4 = d 4 + +-- | A die with an equal chance of rolling 1, 2, 3, 4, 5 or 6. +d6 :: DieRoll +d6 = d 6 + +-- | A die with an equal chance of rolling 1, 2, 3, 4, 5, 6, 7 or 8. +d8 :: DieRoll +d8 = d 8 + +-- | A die with an equal chance of rolling 0, 1, 2, 3, 4, 5, 6, 7, 8 or 9. +z10 :: DieRoll +z10 = z 10 + +-- | A die with an equal chance of rolling 1, 2, 3, 4, 5, 6, 7, 8, 9 or 10. +d10 :: DieRoll +d10 = d 10 + +-- | A die with an equal chance of rolling 1 to 12 inclusive. +d12 :: DieRoll +d12 = d 12 + +-- | A die with an equal chance of rolling 1 to 20 inclusive. +d20 :: DieRoll +d20 = d 20 + +-- | A die with an equal chance of rolling 1 to 100 inclusive. +d100 :: DieRoll +d100 = d 100 + +-- | A die with an equal chance of rolling 0 to 99 inclusive. +z100 :: DieRoll +z100 = z 100 + +-- | Makes a die that has an equal chance of achieving the numbers 1 through the +-- number given. @d 4@ has an equal chance of producing the outcomes 1, 2, 3 and +-- 4, @d 1@ is equivalent to @return 1@ (a certain result of 1), and +-- @d@ is undefined for any number below 1. For convenience, all the standard dice are +-- provided, e.g. @d6 = d 6@. +d :: Int -> DieRoll +d n = makeEvent [1..n] + +-- | Makes a die that has an equal chance of achieving the numbers 0 through +-- the one less than the number given. @z 4@ has an equal chance of producing +-- the outcomes 0, 1, 2 and 3, while @z 1@ is equivalent to @return 0@ (a +-- certain result of 0), and @z@ is undefined for any number below 1. For +-- convenience, several standard dice that can be interpreted with a lower +-- result of 0 are provided, e.g. @z10 = z 10@. +z :: Int -> DieRoll +z n = makeEvent [0 .. (n - 1)] + +-- | Rerolls the die when the specified outcome(s) occur. This has the effect +-- of removing the outcomes from the set of outcomes and rescaling all the other +-- probabilities linearly to sum to 1. For example: +-- +-- > d6 `rerollOn` [5,6] == d4 +-- > chancePred (== 12) ((2*d6) `rerollOn` [7]) == 1/30 +-- +-- With the latter example, the standard chance of 12 on 2d6 is 1\/36, which +-- is rescaled by 36\/30, the reciprocal of the chance of /not/ hitting +-- a 7. +rerollOn :: DieRoll -> [Int] -> DieRoll +rerollOn dc ns = makeEventProb $ filter ((`notElem` ns) . fst) $ outcomes dc + +-- | A nice synonym for 'enact': actually rolls the die and produces a single result according to the probabilities +-- in the @EventM a@ parameter. +roll :: DieRoll -> IO Int +roll = enact + diff --git a/Numeric/Probability/Game/Event.hs b/Numeric/Probability/Game/Event.hs new file mode 100644 --- /dev/null +++ b/Numeric/Probability/Game/Event.hs @@ -0,0 +1,136 @@ +-- | A module containing the central type of the library, 'EventM', and various +-- related helper functions. +module Numeric.Probability.Game.Event (EventM, makeEvent, makeEventProb, outcomes, enact, + coinToss, subst) where + +import Control.Applicative (Applicative(..), (<$>), liftA2) +import Control.Arrow (second) +import Control.Monad (ap, replicateM) +import Data.Ratio (denominator) +import Numeric.Probability.Distribution (T(..), certainly, decons, fromFreqs, norm, selectP, uniform) +import System.Random (randomRIO) + +-- | A probabilistic event with an outcome of type 'a'. See the 'enact' function +-- to actually run the event and randomly pick an outcome. +-- +-- For an explanation of the 'Num' instance, see the DieRoll type in the "Numeric.Probability.Game.Dice" +-- module. +-- +-- The 'Eq' instance compares the two distributions to see if they are equal. +-- This looks at all the outcomes and sees if their probabilities are equal on +-- the left-hand side and the right-hand side. For example, +-- @coinToss == fmap (>= 4) d6@, but @d12 /= d6 + d6@. +-- +-- The 'Show' instance will display a horizontal bar-chart of relative outcome +-- probability. Note: this really is a relative probability -- common factors +-- are cancelled, and is not a count of the different outcomes. If you wish to +-- show the raw numbers, use @show . outcomes@ instead. +-- +-- The 'Functor' instance allows you to modify the outcome values without changing +-- their associated probabilities. For example, @fmap show d6@ changes the outcomes +-- into their String representations. +-- +-- The 'Applicative' instance allows you to join together the results of two events +-- in a predetermined manner. For example, @makeEvent [id, (* 2)] \<*\> d6@ allows +-- you to roll a d6 that has a 50% chance of being doubled. Note that @pure +-- 6@ is an event that is certain to produce the outcome 6. +-- +-- The 'Monad' instance allows you to base the choice of the next event on the +-- result of the previous event. For example, @coinToss >>= \x -> if x then d6 +-- else d4@ will roll a d4 50% of the time and a d6 the other 50%. Note that @return +-- 6@ is an event that is certain to produce the outcome 6. +newtype EventM a = EventM (T Rational a) + deriving (Monad, Functor) + +instance Ord a => Eq (EventM a) where +-- Eq not defined properly for T prob a, work-around for now: +--(===) :: Ord a => EventM a -> EventM a -> Bool + (==) (EventM a) (EventM b) = decons (norm a) == decons (norm b) + +normEventM :: Ord a => EventM a -> EventM a +normEventM (EventM dc) = EventM (norm dc) + +instance Num (EventM Int) where + (+) x y = normEventM $ liftA2 (+) x y + (-) x y = normEventM $ liftA2 (-) x y + negate = fmap negate + abs = normEventM . fmap abs + signum = normEventM . fmap signum + (*) = lotsOf + where + lotsOf :: EventM Int -> EventM Int -> EventM Int + lotsOf x y = do n <- x + sum <$> replicateM n y + fromInteger = EventM . certainly . fromInteger + +instance (Show a, Ord a) => Show (EventM a) where + show (EventM dc) = showBars (decons (norm dc)) + +showBars :: Show a => [(a, Rational)] -> String +showBars xs = unlines (map (makeBar . scale) xs) + where + den = fromIntegral $ foldr lcm 1 (map (denominator . snd) xs) + scale (x, r) = (x, floor (r * den)) -- should be integral anyway + + width = maximum (map (length . show . fst) xs) + + makeBar (x, n) = pad (show x) ++ ": " ++ replicate n '#' + where + pad s = s ++ replicate (width - length s) ' ' + +instance Applicative EventM where + pure = return + (<*>) = ap + +-- | Gets a list of all the outcomes of the event and their associated probability. +-- You can be sure that the probabilities will all sum to 1, and that there will +-- only be one item in the list per outcome. It is possible that some of the outcomes +-- in the list will have zero probability. +outcomes :: Ord a => EventM a -> [(a, Rational)] +outcomes (EventM dc) = decons (norm dc) + +-- | Makes an event that has an equal chance of taking on the value of each +-- entry in the list. Note that duplicates in the list are permitted and do +-- have an effect: @makeEvent [True, False]@ has a 50% chance of giving a True +-- result, but @makeEvent [True, True, False, False, False]@ only has a 40% +-- chance of giving a True result. If you do not want this behaviour, use +-- @makeEvent . nub@ to remove duplicates. +-- +-- The result of passing the empty list is undefined. +makeEvent :: [a] -> EventM a +makeEvent = EventM . uniform + +-- | Given a list of events and their associated probabilities, forms a +-- corresponding event. The probabilities must be non-negative. If the +-- probabilities do not sum to one, they are all scaled linearly so that their +-- sum is one. Duplicate items will have their probabilities added. +-- +-- The result of passing the empty list, a list containing negative probabilities, +-- or a list where all the probabilities are zero is undefined. +makeEventProb :: (Ord a, Real prob) => [(a, prob)] -> EventM a +makeEventProb = EventM . norm . fromFreqs . map (second toRational) + +-- | An event with a 50% chance of giving True, and a 50% chance of giving False. +coinToss :: EventM Bool +coinToss = makeEvent [True, False] + +-- | Actually enacts the event and produces a single result according to the probabilities +-- in the @EventM a@ parameter. +enact :: EventM a -> IO a +enact (EventM dc) = selectP (toDouble dc) <$> randomRIO (0, 1) + where + toDouble :: T Rational a -> T Double a + toDouble = Cons . map (second fromRational) . decons + +-- | If the @EventM a@ parameter returns a result equal to the first parameter, +-- it is changed to be the second parameter; otherwise it is left untouched. For +-- example @replace 4 8 d4@ has an equal chance of producing the outcomes 1, 2, +-- 3 and 8, @replace 10 0 d10 == z10@, and @replace 10 20 d6 == d6@. +subst :: Eq a => a -> a -> EventM a -> EventM a +subst x y = fmap (\n -> if x == n then y else n) + + + -- a `lotsOf` b = [(bx,ap*bp) | (ax,ap)<-a,(bx,bp)<- sum (replicate ax b)] + -- b `lotsOf` c = [(cx,bp*cp) | (bx,bp)<-b,(cx,cp)<- sum (replicate bx c)] + -- a `lotsOf` (b `lotsOf` c) + -- = [(bcx,ap*bcp) | (ax,ap)<-a,(bcx,bcp)<- sum (replicate ax [(cx,bp*cp) | (bx,bp)<-b,(cx,cp)<- sum (replicate bx c)])] diff --git a/Numeric/Probability/Game/Query.hs b/Numeric/Probability/Game/Query.hs new file mode 100644 --- /dev/null +++ b/Numeric/Probability/Game/Query.hs @@ -0,0 +1,33 @@ +-- | A module with functions for querying the probabilities of various outcomes. +module Numeric.Probability.Game.Query (chancePred, chanceRel, chanceTrue) where + +import Control.Applicative ((<$>), liftA2) +import Data.Maybe (fromMaybe) + +import Numeric.Probability.Game.Event (EventM, outcomes) + +-- | Gets the probability that the outcome will satisfy the given predicate. For +-- example: +-- +-- > chancePred (<= 2) d6 == 1/3 -- The chance of getting 2 or less on a d6 +-- > chancePred even d6 == 1/2 -- The chance of rolling an event number on a d6 +chancePred :: (a -> Bool) -> EventM a -> Rational +chancePred f e = fromMaybe 0 $ lookup True (outcomes (f <$> e)) + +-- | Gets the probability that the given relation will hold between the two events. +-- For example: +-- +-- > chanceRel (==) d6 d6 == 1/6 -- The chance of rolling doubles on d6 +-- > chanceRel (>) (2*d6) d12 -- The chance of beating a d12 with two d6 +chanceRel :: (a -> a -> Bool) -> EventM a -> EventM a -> Rational +chanceRel f a b = chanceTrue (liftA2 f a b) + +-- | Gets the probability that the given boolean-outcome event will give a True +-- outcome. For example: +-- +-- > chanceTrue coinToss == 1/2 +-- > chanceTrue ((== 3) <$> d6) == 1/6 +-- +-- (For the latter example, 'chancePred' is more concise.) +chanceTrue :: EventM Bool -> Rational +chanceTrue = chancePred id diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/game-probability.cabal b/game-probability.cabal new file mode 100644 --- /dev/null +++ b/game-probability.cabal @@ -0,0 +1,72 @@ +Name: game-probability +Version: 1.0 +Synopsis: Simple probability library for dice rolls and similar simple games of chance +-- A longer description of the package. +Description: A library designed to aid in easily calculating the + probability of various outcomes of dice rolls. The + central types are held in the + "Numeric.Probability.Game.Event" module, the dice are + defined in the "Numeric.Probability.Game.Dice" module, + and the functions for calculating probabilities are in + the "Numeric.Probability.Game.Query" module. Various + examples are scattered throughout the library, but here + are some more: + . + Evalulates the chance of a coin toss turning up heads: + . + > chanceTrue coinToss + . + Shows the chances of each outcome of rolling two six-sided dice, as a textual bar chart: + . + > show (2*d6) + . + The chance of getting an 18 when rolling 3 six-sided dice and rerolling on any total less than 8: + . + > chancePred (== 18) ((3*d6) `rerollOn` [3..7]) + . + As a more complex example, this implements my memory/understanding of the original + World of Darkness dice system + (). + You roll a given number of 10-sided dice, rolling one + extra for every 10 you score if you are specialised. The number of 1s on the + original roll are subtracted from the total number of + dice that equal or exceed the difficulty target: + . + > successes :: Int -> Int -> Bool -> EventM Int + > successes target dice specialised + > = do initial <- replicateM dice d10 + > extra <- if specialised + > then replicateM (count (== 10) initial) d10 + > else return [] + > return (count (>= target) (initial ++ extra) - count (== 1) initial) + > where + > count f xs = length (filter f xs) + . + If only all RPGs specified their rules in Haskell! + . + See also the blog post on the design of the library: +License: BSD3 +License-file: LICENSE +Author: Neil Brown +Maintainer: neil@twistedsquare.com +-- Copyright: + +Category: Math +Build-type: Simple + +Cabal-version: >=1.6 + + +Library + -- Modules exported by the library. + Exposed-modules: Numeric.Probability.Game.Event + Numeric.Probability.Game.Dice + Numeric.Probability.Game.Query + + -- Packages needed in order to build this package. + Build-depends: base >= 4 && < 5, probability == 0.2.*, random == 1.0.* + + Extensions: GeneralizedNewtypeDeriving FlexibleInstances + + GHC-Options: -Wall +