{-# 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@('(' : rest :: 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 (')', middle :: String
middle) -> ShowS
forall a. [a] -> [a]
reverse String
middle
  _ -> String
s
stripOuterParens s :: String
s = String
s

showDiceWithParens :: Dice -> String
showDiceWithParens :: Dice -> String
showDiceWithParens = Dice -> String
sh
 where
  sh :: Dice -> String
sh dice1 :: Dice
dice1 = case Dice
dice1 of
    DiceI k :: Int
k -> Int -> String
forall a. Show a => a -> String
show Int
k
    DiceD n :: Int
n k :: Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "d" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DiceDL n :: Int
n k :: Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "dL" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DiceZ n :: Int
n k :: Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "z" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DiceZL n :: Int
n k :: Int
k -> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "zL" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
    DicePlus d1 :: Dice
d1 (DiceNegate d2 :: 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DicePlus (DiceNegate d1 :: Dice
d1) d2 :: Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DicePlus d1 :: Dice
d1 (DicePlus d2 :: Dice
d2 d3 :: 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 d1 :: Dice
d1 d2 :: Dice
d2) d3 :: 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d3
    DicePlus d1 :: Dice
d1 d2 :: 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DiceTimes d1 :: Dice
d1 d2 :: 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d2
    DiceNegate d1 :: Dice
d1 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dice -> String
sh Dice
d1
    DiceMin d1 :: Dice
d1 d2 :: Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "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 d1 :: Dice
d1 d2 :: Dice
d2 -> ShowS
wrapInParens ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "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 "" = ""
wrapInParens t :: String
t = "(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ")"

instance Num Dice where
  d1 :: Dice
d1 + :: Dice -> Dice -> Dice
+ d2 :: Dice
d2 = Dice -> Dice -> Dice
DicePlus Dice
d1 Dice
d2
  d1 :: Dice
d1 * :: Dice -> Dice -> Dice
* d2 :: Dice
d2 = Dice -> Dice -> Dice
DiceTimes Dice
d1 Dice
d2
  d1 :: Dice
d1 - :: Dice -> Dice -> Dice
- d2 :: 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 n :: 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 randomR :: (Int, Int) -> m Int
randomR (AbsDepth lvlDepth :: Int
lvlDepth) (AbsDepth maxDepth :: Int
maxDepth) dice :: 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
>= 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` "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 n :: Int
n start :: Int
start k :: 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 0 = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc
              f acc :: Int
acc count :: 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
- 1)
          Int -> Int -> m Int
f 0 Int
n
      scaleL :: Int -> Int
scaleL k :: 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 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 1 Int
maxDepth
      castD :: Dice -> m Int
      castD :: Dice -> m Int
castD dice1 :: Dice
dice1 = case Dice
dice1 of
        DiceI k :: Int
k -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
        DiceD n :: Int
n k :: Int
k -> Int -> Int -> Int -> m Int
castNK Int
n 1 Int
k
        DiceDL n :: Int
n k :: 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 1 Int
k
        DiceZ n :: Int
n k :: Int
k -> Int -> Int -> Int -> m Int
castNK Int
n 0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
        DiceZL n :: Int
n k :: 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 0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
        DicePlus d1 :: Dice
d1 d2 :: 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 d1 :: Dice
d1 d2 :: 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 d1 :: 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 d1 :: Dice
d1 d2 :: 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 d1 :: Dice
d1 d2 :: 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 n :: Int
n k :: Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "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 n :: Int
n k :: Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "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 n :: Int
n k :: Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "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 n :: Int
n k :: Int
k = Bool -> Dice -> Dice
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> (String, (Int, Int)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "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 dice1 :: Dice
dice1 = case Dice
dice1 of
  DiceI k :: Int
k -> (Int
k, Int
k)
  DiceD n :: Int
n k :: Int
k -> (Int
n, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k)
  DiceDL n :: Int
n k :: Int
k -> (1, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
k)  -- bottom and top level considered
  DiceZ n :: Int
n k :: Int
k -> (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
- 1))
  DiceZL n :: Int
n k :: Int
k -> (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
- 1))  -- bottom and top level considered
  DicePlus d1 :: Dice
d1 d2 :: Dice
d2 ->
    let (infD1 :: Int
infD1, supD1 :: Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (infD2 :: Int
infD2, supD2 :: 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 k :: Int
k) d2 :: Dice
d2 ->
    let (infD2 :: Int
infD2, supD2 :: Int
supD2) = Dice -> (Int, Int)
infsupDice Dice
d2
    in if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 d1 :: Dice
d1 (DiceI k :: Int
k) ->
    let (infD1 :: Int
infD1, supD1 :: Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
    in if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 d1 :: Dice
d1 d2 :: Dice
d2 ->
    let (infD1 :: Int
infD1, supD1 :: Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (infD2 :: Int
infD2, supD2 :: 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 d1 :: Dice
d1 ->
    let (infD1 :: Int
infD1, supD1 :: 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 d1 :: Dice
d1 d2 :: Dice
d2 ->
    let (infD1 :: Int
infD1, supD1 :: Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (infD2 :: Int
infD2, supD2 :: 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 d1 :: Dice
d1 d2 :: Dice
d2 ->
    let (infD1 :: Int
infD1, supD1 :: Int
supD1) = Dice -> (Int, Int)
infsupDice Dice
d1
        (infD2 :: Int
infD2, supD2 :: 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 dice1 :: Dice
dice1 = case Dice
dice1 of
  DiceI k :: Int
k -> Int -> Double
intToDouble Int
k
  DiceD n :: Int
n k :: 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
+ 1)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2
  DiceDL n :: Int
n k :: 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
+ 1)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 4
  DiceZ n :: Int
n k :: 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
/ 2
  DiceZL n :: Int
n k :: 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
/ 4
  DicePlus d1 :: Dice
d1 d2 :: Dice
d2 -> Dice -> Double
meanDice Dice
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Dice -> Double
meanDice Dice
d2
  DiceTimes d1 :: Dice
d1 d2 :: 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 d1 :: 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 d1 :: Dice
d1 d2 :: 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 d1 :: Dice
d1 d2 :: 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 d1 :: Dice
d1 =
  let (infD1 :: Int
infD1, supD1 :: 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 x :: Dice
x y :: 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 x :: Dice
x y :: Dice
y) = (Dice -> Int
infDice Dice
x, Dice -> Int
infDice Dice
y)