moduleNumeric.Probability.Example.MontyHallwhereimportqualifiedNumeric.Probability.Distribution asDistimportqualifiedNumeric.Probability.Transition asTransimportNumeric.Probability.Simulation ((~.) ,)importNumeric.Probability.Percentage (Dist ,RDist ,Trans ,)importqualifiedNumeric.Probability.Monad asMonadExtimportData.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
-}dataDoor =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 ]dataState =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 statusstart ::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 }whereu :: 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 ]]typeStrategy =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 gamedataOutcome =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 =ifState -> Door
chosen State
s forall a. Eq a => a -> a -> Bool
==State -> Door
prize State
s thenOutcome
Win elseOutcome
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 modelingfirstChoice ::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 waytypeStrategyM =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 ]inDoor
finalDoor evalM ::StrategyM ->Dist Outcome evalM :: (Door -> Door -> Door) -> Dist Outcome
evalM Door -> Door -> Door
chooseFinalDoor =doDoor
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(ifDoor -> Door -> Door
chooseFinalDoor Door
chosenDoor Door
openedDoor forall a. Eq a => a -> a -> Bool
==Door
prizeDoor thenOutcome
Win elseOutcome
Lose )