{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Core.Dice
(
Dice, AbsDepth(..), castDice, d, dL, z, zL, intToDice, minDice, maxDice
, infsupDice, supDice, infDice, meanDice, reduceDice
, DiceXY(..), supDiceXY, infDiceXY
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
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
signum :: Dice -> Dice
signum = Dice -> Dice
forall a. HasCallStack => a
undefined
fromInteger :: Integer -> Dice
fromInteger n :: Integer
n = Int -> Dice
DiceI (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
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)
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
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
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
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
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
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)
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))
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)
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)
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
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
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
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)
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)
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
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
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)
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)