{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Representation of dice scaled with current level depth.
module Game.LambdaHack.Core.Dice
  ( -- * Frequency distribution for casting dice scaled with level depth
    Dice, AbsDepth(..), castDice, d, dL, z, zL, intToDice, minDice, maxDice
  , infsupDice, supDice, infDice, meanDice, reduceDice
    -- * Dice for rolling a pair of integer parameters representing coordinates.
  , DiceXY(..), supDiceXY, infDiceXY
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Data.Binary

-- | Multiple dice rolls, some scaled with current level depth, in which case
-- the sum of all rolls is scaled in proportion to current depth
-- divided by maximal dungeon depth.
--
-- The simple dice should have positive number of rolls and number of sides.
--
-- The @Num@ instance doesn't have @abs@ nor @signum@ defined,
-- because the functions for computing infimum, supremum and mean dice
-- results would be too costly.
data Dice =
    DiceI Int
  | DiceD Int Int
  | DiceDL Int Int
  | DiceZ Int Int
  | DiceZL Int Int
  | DicePlus Dice Dice
  | DiceTimes Dice Dice
  | DiceNegate Dice
  | DiceMin Dice Dice
  | DiceMax Dice Dice
  deriving Dice -> Dice -> Bool
(Dice -> Dice -> Bool) -> (Dice -> Dice -> Bool) -> Eq Dice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dice -> Dice -> Bool
$c/= :: Dice -> Dice -> Bool
== :: Dice -> Dice -> Bool
$c== :: Dice -> Dice -> Bool
Eq

instance Show Dice where
  show :: Dice -> String
show = ShowS
stripOuterParens ShowS -> (Dice -> String) -> Dice -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dice -> String
showDiceWithParens

stripOuterParens :: String -> String
stripOuterParens :: ShowS
stripOuterParens s :: String
s@(Char
'(' : String
rest) = case String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
uncons (String -> Maybe (Char, String)) -> String -> Maybe (Char, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
rest of
  Just (Char
')', String
middle) -> ShowS
forall a. [a] -> [a]
reverse String
middle
  Maybe (Char, String)
_ -> String
s
stripOuterParens String
s = String
s

showDiceWithParens :: Dice -> String
showDiceWithParens :: Dice -> String
showDiceWithParens = Dice -> String
sh
 where
  sh :: Dice -> String
sh Dice
dice1 = case Dice
dice1 of
    DiceI Int
k -> Int -> String
forall a. Show a => a -> String
show Int
k
    DiceD Int
n Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"d" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DiceDL Int
n Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"dL" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DiceZ Int
n Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"z" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DiceZL Int
n Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"zL" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DicePlus Dice
d1 (DiceNegate Dice
d2) -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DicePlus (DiceNegate Dice
d1) Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DicePlus Dice
d1 (DicePlus Dice
d2 Dice
d3) -> Dice -> String
sh (Dice -> String) -> Dice -> String
forall a b. (a -> b) -> a -> b
$ Dice -> Dice -> Dice
DicePlus (Dice -> Dice -> Dice
DicePlus Dice
d1 Dice
d2) Dice
d3
    DicePlus (DicePlus Dice
d1 Dice
d2) Dice
d3 ->
      ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
stripOuterParens (Dice -> String
sh (Dice -> String) -> Dice -> String
forall a b. (a -> b) -> a -> b
$ Dice -> Dice -> Dice
DicePlus Dice
d1 Dice
d2) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d3
    DicePlus Dice
d1 Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DiceTimes Dice
d1 Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DiceNegate Dice
d1 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d1
    DiceMin Dice
d1 Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"min" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DiceMax Dice
d1 Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"max" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2

wrapInParens :: String -> String
wrapInParens :: ShowS
wrapInParens String
"" = String
""
wrapInParens String
t = String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance Num Dice where
  Dice
d1 + :: Dice -> Dice -> Dice
+ Dice
d2 = Dice -> Dice -> Dice
DicePlus Dice
d1 Dice
d2
  Dice
d1 * :: Dice -> Dice -> Dice
* Dice
d2 = Dice -> Dice -> Dice
DiceTimes Dice
d1 Dice
d2
  Dice
d1 - :: Dice -> Dice -> Dice
- Dice
d2 = Dice
d1 Dice -> Dice -> Dice
forall a. Num a => a -> a -> a
+ Dice -> Dice
DiceNegate Dice
d2
  negate :: Dice -> Dice
negate = Dice -> Dice
DiceNegate
  abs :: Dice -> Dice
abs = Dice -> Dice
forall a. HasCallStack => a
undefined  -- very costly to compute mean exactly
  signum :: Dice -> Dice
signum = Dice -> Dice
forall a. HasCallStack => a
undefined  -- very costly to compute mean exactly
  fromInteger :: Integer -> Dice
fromInteger Integer
n = Int -> Dice
DiceI (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

-- | Absolute depth in the dungeon. When used for the maximum depth
-- of the whole dungeon, this can be different than dungeon size,
-- e.g., when the dungeon is branched, and it can even be different
-- than the length of the longest branch, if levels at some depths are missing.
newtype AbsDepth = AbsDepth Int
  deriving (Int -> AbsDepth -> ShowS
[AbsDepth] -> ShowS
AbsDepth -> String
(Int -> AbsDepth -> ShowS)
-> (AbsDepth -> String) -> ([AbsDepth] -> ShowS) -> Show AbsDepth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsDepth] -> ShowS
$cshowList :: [AbsDepth] -> ShowS
show :: AbsDepth -> String
$cshow :: AbsDepth -> String
showsPrec :: Int -> AbsDepth -> ShowS
$cshowsPrec :: Int -> AbsDepth -> ShowS
Show, AbsDepth -> AbsDepth -> Bool
(AbsDepth -> AbsDepth -> Bool)
-> (AbsDepth -> AbsDepth -> Bool) -> Eq AbsDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsDepth -> AbsDepth -> Bool
$c/= :: AbsDepth -> AbsDepth -> Bool
== :: AbsDepth -> AbsDepth -> Bool
$c== :: AbsDepth -> AbsDepth -> Bool
Eq, Eq AbsDepth
Eq AbsDepth
-> (AbsDepth -> AbsDepth -> Ordering)
-> (AbsDepth -> AbsDepth -> Bool)
-> (AbsDepth -> AbsDepth -> Bool)
-> (AbsDepth -> AbsDepth -> Bool)
-> (AbsDepth -> AbsDepth -> Bool)
-> (AbsDepth -> AbsDepth -> AbsDepth)
-> (AbsDepth -> AbsDepth -> AbsDepth)
-> Ord AbsDepth
AbsDepth -> AbsDepth -> Bool
AbsDepth -> AbsDepth -> Ordering
AbsDepth -> AbsDepth -> AbsDepth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AbsDepth -> AbsDepth -> AbsDepth
$cmin :: AbsDepth -> AbsDepth -> AbsDepth
max :: AbsDepth -> AbsDepth -> AbsDepth
$cmax :: AbsDepth -> AbsDepth -> AbsDepth
>= :: AbsDepth -> AbsDepth -> Bool
$c>= :: AbsDepth -> AbsDepth -> Bool
> :: AbsDepth -> AbsDepth -> Bool
$c> :: AbsDepth -> AbsDepth -> Bool
<= :: AbsDepth -> AbsDepth -> Bool
$c<= :: AbsDepth -> AbsDepth -> Bool
< :: AbsDepth -> AbsDepth -> Bool
$c< :: AbsDepth -> AbsDepth -> Bool
compare :: AbsDepth -> AbsDepth -> Ordering
$ccompare :: AbsDepth -> AbsDepth -> Ordering
$cp1Ord :: Eq AbsDepth
Ord, Get AbsDepth
[AbsDepth] -> Put
AbsDepth -> Put
(AbsDepth -> Put)
-> Get AbsDepth -> ([AbsDepth] -> Put) -> Binary AbsDepth
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [AbsDepth] -> Put
$cputList :: [AbsDepth] -> Put
get :: Get AbsDepth
$cget :: Get AbsDepth
put :: AbsDepth -> Put
$cput :: AbsDepth -> Put
Binary)

-- | Cast dice scaled with current level depth. When scaling, we round up,
-- so that the value of @1 `dL` 1@ is @1@ even at the lowest level,
-- but so is the value of @1 `dL` depth@.
--
-- The implementation calls RNG as many times as there are dice rolls,
-- which is costly, so content should prefer to cast fewer dice
-- and then multiply them by a constant. If rounded results are not desired
-- (often they are, to limit the number of distinct item varieties
-- in inventory), another dice may be added to the result.
--
-- A different possible implementation, with dice represented as @Frequency@,
-- makes only one RNG call per dice, but due to lists lengths proportional
-- to the maximal value of the dice, it's is intractable for 1000d1000
-- and problematic already for 100d100.
castDice :: forall m. Monad m
         => ((Int, Int) -> m Int)
         -> AbsDepth -> AbsDepth -> Dice -> m Int
{-# INLINE castDice #-}
castDice :: ((Int, Int) -> m Int) -> AbsDepth -> AbsDepth -> Dice -> m Int
castDice (Int, Int) -> m Int
randomR (AbsDepth Int
lvlDepth) (AbsDepth Int
maxDepth) Dice
dice = do
  let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
lvlDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
lvlDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxDepth
                    Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"invalid depth for dice rolls"
                    String -> (Int, Int) -> (String, (Int, Int))
forall v. String -> v -> (String, v)
`swith` (Int
lvlDepth, Int
maxDepth)) ()
      castNK :: Int -> Int -> Int -> m Int
castNK Int
n Int
start Int
k = if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k then Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k else do
          let f :: Int -> Int -> m Int
f !Int
acc Int
0 = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc
              f Int
acc Int
count = do
                Int
r <- (Int, Int) -> m Int
randomR (Int
start, Int
k)
                Int -> Int -> m Int
f (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          Int -> Int -> m Int
f Int
0 Int
n
      scaleL :: Int -> Int
scaleL Int
k = (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
lvlDepth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`divUp` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
maxDepth
      castD :: Dice -> m Int
      castD :: Dice -> m Int
castD Dice
dice1 = case Dice
dice1 of
        DiceI Int
k -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
        DiceD Int
n Int
k -> Int -> Int -> Int -> m Int
castNK Int
n Int
1 Int
k
        DiceDL Int
n Int
k -> Int -> Int
scaleL (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int -> m Int
castNK Int
n Int
1 Int
k
        DiceZ Int
n Int
k -> Int -> Int -> Int -> m Int
castNK Int
n Int
0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        DiceZL Int
n Int
k -> Int -> Int
scaleL (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int -> m Int
castNK Int
n Int
0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        DicePlus Dice
d1 Dice
d2 -> do
          Int
k1 <- Dice -> m Int
castD Dice
d1
          Int
k2 <- Dice -> m Int
castD Dice
d2
          Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k2
        DiceTimes Dice
d1 Dice
d2 -> do
          Int
k1 <- Dice -> m Int
castD Dice
d1
          Int
k2 <- Dice -> m Int
castD Dice
d2
          Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k2
        DiceNegate Dice
d1 -> do
          Int
k <- Dice -> m Int
castD Dice
d1
          Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int -> Int
forall a. Num a => a -> a
negate Int
k
        DiceMin Dice
d1 Dice
d2 -> do
          Int
k1 <- Dice -> m Int
castD Dice
d1
          Int
k2 <- Dice -> m Int
castD Dice
d2
          Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
k1 Int
k2
        DiceMax Dice
d1 Dice
d2 -> do
          Int
k1 <- Dice -> m Int
castD Dice
d1
          Int
k2 <- Dice -> m Int
castD Dice
d2
          Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
k1 Int
k2
  Dice -> m Int
castD Dice
dice

-- | A die, rolled the given number of times. E.g., @1 `d` 2@ rolls 2-sided
-- die one time.
d :: Int -> Int -> Dice
d :: Int -> Int -> Dice
d Int
n Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"die must be positive" String -> (Int, Int) -> (String, (Int, Int))
forall v. String -> v -> (String, v)
`swith` (Int
n, Int
k))
        (Dice -> Dice) -> Dice -> Dice
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Dice
DiceD Int
n Int
k

-- | A die rolled the given number of times,
-- with the result scaled with dungeon level depth.
dL :: Int -> Int -> Dice
dL :: Int -> Int -> Dice
dL Int
n Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"die must be positive" String -> (Int, Int) -> (String, (Int, Int))
forall v. String -> v -> (String, v)
`swith` (Int
n, Int
k))
         (Dice -> Dice) -> Dice -> Dice
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Dice
DiceDL Int
n Int
k

-- | A die, starting from zero, ending at one less than second argument,
-- rolled the given number of times. E.g., @1 `z` 1@ always rolls zero.
z :: Int -> Int -> Dice
z :: Int -> Int -> Dice
z Int
n Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"die must be positive" String -> (Int, Int) -> (String, (Int, Int))
forall v. String -> v -> (String, v)
`swith` (Int
n, Int
k))
        (Dice -> Dice) -> Dice -> Dice
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Dice
DiceZ Int
n Int
k

-- | A die, starting from zero, ending at one less than second argument,
-- rolled the given number of times,
-- with the result scaled with dungeon level depth.
zL :: Int -> Int -> Dice
zL :: Int -> Int -> Dice
zL Int
n Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"die must be positive" String -> (Int, Int) -> (String, (Int, Int))
forall v. String -> v -> (String, v)
`swith` (Int
n, Int
k))
         (Dice -> Dice) -> Dice -> Dice
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Dice
DiceZL Int
n Int
k

intToDice :: Int -> Dice
intToDice :: Int -> Dice
intToDice = Int -> Dice
DiceI

minDice :: Dice -> Dice -> Dice
minDice :: Dice -> Dice -> Dice
minDice = Dice -> Dice -> Dice
DiceMin

maxDice :: Dice -> Dice -> Dice
maxDice :: Dice -> Dice -> Dice
maxDice = Dice -> Dice -> Dice
DiceMax

-- | Minimal and maximal possible value of the dice.
--
-- @divUp@ in the implementation corresponds to @ceiling@,
-- applied to results of @meanDice@ elsewhere in the code,
-- and prevents treating 1d1-power effects (on shallow levels) as null effects.
infsupDice :: Dice -> (Int, Int)
infsupDice :: Dice -> (Int, Int)
infsupDice Dice
dice1 = case Dice
dice1 of
  DiceI Int
k -> (Int
k, Int
k)
  DiceD Int
n Int
k -> (Int
n, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k)
  DiceDL Int
n Int
k -> (Int
1, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k)  -- bottom and top level considered
  DiceZ Int
n Int
k -> (Int
0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  DiceZL Int
n Int
k -> (Int
0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))  -- bottom and top level considered
  DicePlus Dice
d1 Dice
d2 ->
    let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (Int
infD2, Int
supD2) = Dice -> (Int, Int)
infsupDice Dice
d2
    in (Int
infD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
infD2, Int
supD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
supD2)
  DiceTimes (DiceI Int
k) Dice
d2 ->
    let (Int
infD2, Int
supD2) = Dice -> (Int, Int)
infsupDice Dice
d2
    in if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
infD2, Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
supD2) else (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
supD2, Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
infD2)
  DiceTimes Dice
d1 (DiceI Int
k) ->
    let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
    in if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
infD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k, Int
supD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k) else (Int
supD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k, Int
infD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k)
  -- Multiplication other than the two cases above is unlikely, but here it is.
  DiceTimes Dice
d1 Dice
d2 ->
    let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (Int
infD2, Int
supD2) = Dice -> (Int, Int)
infsupDice Dice
d2
        options :: [Int]
options = [Int
infD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
infD2, Int
infD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
supD2, Int
supD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
supD2, Int
supD1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
infD2]
    in ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
options, [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
options)
  DiceNegate Dice
d1 ->
    let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
    in (Int -> Int
forall a. Num a => a -> a
negate Int
supD1, Int -> Int
forall a. Num a => a -> a
negate Int
infD1)
  DiceMin Dice
d1 Dice
d2 ->
    let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (Int
infD2, Int
supD2) = Dice -> (Int, Int)
infsupDice Dice
d2
    in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
infD1 Int
infD2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
supD1 Int
supD2)
  DiceMax Dice
d1 Dice
d2 ->
    let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (Int
infD2, Int
supD2) = Dice -> (Int, Int)
infsupDice Dice
d2
    in (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
infD1 Int
infD2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
supD1 Int
supD2)

-- | Maximal value of dice. The scaled part taken assuming median level.
supDice :: Dice -> Int
supDice :: Dice -> Int
supDice = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Dice -> (Int, Int)) -> Dice -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dice -> (Int, Int)
infsupDice

-- | Minimal value of dice. The scaled part taken assuming median level.
infDice :: Dice -> Int
infDice :: Dice -> Int
infDice = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Dice -> (Int, Int)) -> Dice -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dice -> (Int, Int)
infsupDice

-- | Mean value of dice. The scaled part taken assuming median level,
-- but not taking into account rounding up, and so too low, especially
-- for dice small compared to depth. To fix this, depth would need
-- to be taken as argument.
meanDice :: Dice -> Double
meanDice :: Dice -> Double
meanDice Dice
dice1 = case Dice
dice1 of
  DiceI Int
k -> Int -> Double
intToDouble Int
k
  DiceD Int
n Int
k -> Int -> Double
intToDouble (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  DiceDL Int
n Int
k -> Int -> Double
intToDouble (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4
  DiceZ Int
n Int
k -> Int -> Double
intToDouble (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
  DiceZL Int
n Int
k -> Int -> Double
intToDouble (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4
  DicePlus Dice
d1 Dice
d2 -> Dice -> Double
meanDice Dice
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dice -> Double
meanDice Dice
d2
  DiceTimes Dice
d1 Dice
d2 -> Dice -> Double
meanDice Dice
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Dice -> Double
meanDice Dice
d2  -- I hope this is that simple
  DiceNegate Dice
d1 -> Double -> Double
forall a. Num a => a -> a
negate (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Dice -> Double
meanDice Dice
d1
  DiceMin Dice
d1 Dice
d2 -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Dice -> Double
meanDice Dice
d1) (Dice -> Double
meanDice Dice
d2)
    -- crude approximation, only exact if the distributions disjoint
  DiceMax Dice
d1 Dice
d2 -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Dice -> Double
meanDice Dice
d1) (Dice -> Double
meanDice Dice
d2)  -- crude approximation

reduceDice :: Dice -> Maybe Int
reduceDice :: Dice -> Maybe Int
reduceDice Dice
d1 =
  let (Int
infD1, Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
  in if Int
infD1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
supD1 then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
infD1 else Maybe Int
forall a. Maybe a
Nothing

-- | Dice for rolling a pair of integer parameters pertaining to,
-- respectively, the X and Y cartesian 2D coordinates.
data DiceXY = DiceXY Dice Dice
  deriving Int -> DiceXY -> ShowS
[DiceXY] -> ShowS
DiceXY -> String
(Int -> DiceXY -> ShowS)
-> (DiceXY -> String) -> ([DiceXY] -> ShowS) -> Show DiceXY
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiceXY] -> ShowS
$cshowList :: [DiceXY] -> ShowS
show :: DiceXY -> String
$cshow :: DiceXY -> String
showsPrec :: Int -> DiceXY -> ShowS
$cshowsPrec :: Int -> DiceXY -> ShowS
Show

-- | Maximal value of DiceXY.
supDiceXY :: DiceXY -> (Int, Int)
supDiceXY :: DiceXY -> (Int, Int)
supDiceXY (DiceXY Dice
x Dice
y) = (Dice -> Int
supDice Dice
x, Dice -> Int
supDice Dice
y)

-- | Minimal value of DiceXY.
infDiceXY :: DiceXY -> (Int, Int)
infDiceXY :: DiceXY -> (Int, Int)
infDiceXY (DiceXY Dice
x Dice
y) = (Dice -> Int
infDice Dice
x, Dice -> Int
infDice Dice
y)