module Numeric.Probability.Example.MontyHall where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Transition as Trans
import Numeric.Probability.Simulation ((~.), )

import Numeric.Probability.Percentage
    (Dist, RDist, Trans, )

import qualified Numeric.Probability.Monad as MonadExt

import Data.List ( (\\) )


{- no Random instance for Rational
type Probability = Rational
type Dist a  = Dist.T  Probability a
type RDist a = Rnd.Distribution Probability a
type Trans a = Transition    Probability a
-}

data Door = A | B | C
            deriving (Door -> Door -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Door -> Door -> Bool
$c/= :: Door -> Door -> Bool
== :: Door -> Door -> Bool
$c== :: Door -> Door -> Bool
Eq,Eq Door
Door -> Door -> Bool
Door -> Door -> Ordering
Door -> Door -> Door
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 :: Door -> Door -> Door
$cmin :: Door -> Door -> Door
max :: Door -> Door -> Door
$cmax :: Door -> Door -> Door
>= :: Door -> Door -> Bool
$c>= :: Door -> Door -> Bool
> :: Door -> Door -> Bool
$c> :: Door -> Door -> Bool
<= :: Door -> Door -> Bool
$c<= :: Door -> Door -> Bool
< :: Door -> Door -> Bool
$c< :: Door -> Door -> Bool
compare :: Door -> Door -> Ordering
$ccompare :: Door -> Door -> Ordering
Ord,Int -> Door -> ShowS
[Door] -> ShowS
Door -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Door] -> ShowS
$cshowList :: [Door] -> ShowS
show :: Door -> String
$cshow :: Door -> String
showsPrec :: Int -> Door -> ShowS
$cshowsPrec :: Int -> Door -> ShowS
Show)

doors :: [Door]
doors :: [Door]
doors = [Door
A,Door
B,Door
C]

data State = Doors {State -> Door
prize :: Door, State -> Door
chosen :: Door, State -> Door
opened :: Door}
             deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq,Eq State
State -> State -> Bool
State -> State -> Ordering
State -> State -> State
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 :: State -> State -> State
$cmin :: State -> State -> State
max :: State -> State -> State
$cmax :: State -> State -> State
>= :: State -> State -> Bool
$c>= :: State -> State -> Bool
> :: State -> State -> Bool
$c> :: State -> State -> Bool
<= :: State -> State -> Bool
$c<= :: State -> State -> Bool
< :: State -> State -> Bool
$c< :: State -> State -> Bool
compare :: State -> State -> Ordering
$ccompare :: State -> State -> Ordering
Ord,Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)


-- | initial configuration of the game status
start :: State
start :: State
start = Doors {prize :: Door
prize=forall {a}. a
u,chosen :: Door
chosen=forall {a}. a
u,opened :: Door
opened=forall {a}. a
u} where u :: a
u=forall a. HasCallStack => a
undefined


{- |
Steps of the game:

 (1) hide the prize

 (2) choose a door

 (3) open a non-open door, not revealing the prize

 (4) apply strategy: switch or stay
-}
hide :: Trans State
hide :: Trans State
hide State
s = forall prob a. Fractional prob => Spread prob a
Dist.uniform [State
s {prize :: Door
prize = Door
d} | Door
d <- [Door]
doors]

choose :: Trans State
choose :: Trans State
choose State
s = forall prob a. Fractional prob => Spread prob a
Dist.uniform [State
s {chosen :: Door
chosen = Door
d} | Door
d <- [Door]
doors]

open :: Trans State
open :: Trans State
open State
s = forall prob a. Fractional prob => Spread prob a
Dist.uniform [State
s {opened :: Door
opened = Door
d} | Door
d <- [Door]
doors forall a. Eq a => [a] -> [a] -> [a]
\\ [State -> Door
prize State
s,State -> Door
chosen State
s]]

type Strategy = Trans State

switch :: Strategy
switch :: Trans State
switch State
s = forall prob a. Fractional prob => Spread prob a
Dist.uniform [State
s {chosen :: Door
chosen = Door
d} | Door
d <- [Door]
doors forall a. Eq a => [a] -> [a] -> [a]
\\ [State -> Door
chosen State
s,State -> Door
opened State
s]]

stay :: Strategy
stay :: Trans State
stay = forall prob a. Num prob => T prob a
Trans.id

game :: Strategy -> Trans State
game :: Trans State -> Trans State
game Trans State
s = forall (m :: * -> *) a. Monad m => [a -> m a] -> a -> m a
MonadExt.compose [Trans State
hide,Trans State
choose,Trans State
open,Trans State
s]


-- * Playing the game

data Outcome = Win | Lose
               deriving (Outcome -> Outcome -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outcome -> Outcome -> Bool
$c/= :: Outcome -> Outcome -> Bool
== :: Outcome -> Outcome -> Bool
$c== :: Outcome -> Outcome -> Bool
Eq,Eq Outcome
Outcome -> Outcome -> Bool
Outcome -> Outcome -> Ordering
Outcome -> Outcome -> Outcome
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 :: Outcome -> Outcome -> Outcome
$cmin :: Outcome -> Outcome -> Outcome
max :: Outcome -> Outcome -> Outcome
$cmax :: Outcome -> Outcome -> Outcome
>= :: Outcome -> Outcome -> Bool
$c>= :: Outcome -> Outcome -> Bool
> :: Outcome -> Outcome -> Bool
$c> :: Outcome -> Outcome -> Bool
<= :: Outcome -> Outcome -> Bool
$c<= :: Outcome -> Outcome -> Bool
< :: Outcome -> Outcome -> Bool
$c< :: Outcome -> Outcome -> Bool
compare :: Outcome -> Outcome -> Ordering
$ccompare :: Outcome -> Outcome -> Ordering
Ord,Int -> Outcome -> ShowS
[Outcome] -> ShowS
Outcome -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outcome] -> ShowS
$cshowList :: [Outcome] -> ShowS
show :: Outcome -> String
$cshow :: Outcome -> String
showsPrec :: Int -> Outcome -> ShowS
$cshowsPrec :: Int -> Outcome -> ShowS
Show)

result :: State -> Outcome
result :: State -> Outcome
result State
s = if State -> Door
chosen State
sforall a. Eq a => a -> a -> Bool
==State -> Door
prize State
s then Outcome
Win else Outcome
Lose

eval :: Strategy -> Dist Outcome
eval :: Trans State -> Dist Outcome
eval Trans State
s = forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map State -> Outcome
result (Trans State -> Trans State
game Trans State
s State
start)

simEval :: Int -> Strategy -> RDist Outcome
simEval :: Int -> Trans State -> RDist Outcome
simEval Int
k Trans State
s = forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map State -> Outcome
result forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Int
k forall (c :: * -> *) prob a.
(C c, Fractional prob, Ord prob, Random prob, Ord a) =>
Int -> (a -> c a) -> Transition prob a
~. Trans State -> Trans State
game Trans State
s) State
start


-- * Alternative modeling

firstChoice :: Dist Outcome
firstChoice :: Dist Outcome
firstChoice = forall prob a. Fractional prob => Spread prob a
Dist.uniform [Outcome
Win,Outcome
Lose,Outcome
Lose]

switch' :: Trans Outcome
switch' :: Trans Outcome
switch' Outcome
Win  = forall prob a. Num prob => T prob a
Dist.certainly Outcome
Lose
switch' Outcome
Lose = forall prob a. Num prob => T prob a
Dist.certainly Outcome
Win


-- * Play the game the monadic way

type StrategyM = Door -> Door -> Door

stayM :: StrategyM
stayM :: Door -> Door -> Door
stayM Door
chosenDoor Door
_openedDoor = Door
chosenDoor

switchM :: StrategyM
switchM :: Door -> Door -> Door
switchM Door
chosenDoor Door
openedDoor =
   let [Door
finalDoor] = [Door]
doors forall a. Eq a => [a] -> [a] -> [a]
\\ [Door
chosenDoor, Door
openedDoor]
   in  Door
finalDoor

evalM :: StrategyM -> Dist Outcome
evalM :: (Door -> Door -> Door) -> Dist Outcome
evalM Door -> Door -> Door
chooseFinalDoor =
   do Door
prizeDoor  <- forall prob a. Fractional prob => Spread prob a
Dist.uniform [Door]
doors
      Door
chosenDoor <- forall prob a. Fractional prob => Spread prob a
Dist.uniform [Door]
doors
      Door
openedDoor <- forall prob a. Fractional prob => Spread prob a
Dist.uniform ([Door]
doors forall a. Eq a => [a] -> [a] -> [a]
\\ [Door
prizeDoor, Door
chosenDoor])
      forall (m :: * -> *) a. Monad m => a -> m a
return (if Door -> Door -> Door
chooseFinalDoor Door
chosenDoor Door
openedDoor forall a. Eq a => a -> a -> Bool
== Door
prizeDoor
                then Outcome
Win else Outcome
Lose)