{- |
You take part in a screening test for a disease
that you have with a probability 'pDisease'.
The test can fail in two ways:
If you are ill,
the test says with probability 'pFalseNegative' that you are healthy.
If you are healthy,
it says with probability 'pFalsePositive' that you are ill.

Now consider the test is positive -
what is the probability that you are indeed ill?
-}
module Numeric.Probability.Example.Diagnosis where

import qualified Numeric.Probability.Distribution as Dist
import Numeric.Probability.Distribution ((??), (?=<<), )


type Probability = Rational
type Dist a = Dist.T Probability a


data State = Healthy | Ill
   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, Int -> State
State -> Int
State -> [State]
State -> State
State -> State -> [State]
State -> State -> State -> [State]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: State -> State -> State -> [State]
$cenumFromThenTo :: State -> State -> State -> [State]
enumFromTo :: State -> State -> [State]
$cenumFromTo :: State -> State -> [State]
enumFromThen :: State -> State -> [State]
$cenumFromThen :: State -> State -> [State]
enumFrom :: State -> [State]
$cenumFrom :: State -> [State]
fromEnum :: State -> Int
$cfromEnum :: State -> Int
toEnum :: Int -> State
$ctoEnum :: Int -> State
pred :: State -> State
$cpred :: State -> State
succ :: State -> State
$csucc :: State -> State
Enum)

data Finding = Negative | Positive
   deriving (Finding -> Finding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finding -> Finding -> Bool
$c/= :: Finding -> Finding -> Bool
== :: Finding -> Finding -> Bool
$c== :: Finding -> Finding -> Bool
Eq, Eq Finding
Finding -> Finding -> Bool
Finding -> Finding -> Ordering
Finding -> Finding -> Finding
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 :: Finding -> Finding -> Finding
$cmin :: Finding -> Finding -> Finding
max :: Finding -> Finding -> Finding
$cmax :: Finding -> Finding -> Finding
>= :: Finding -> Finding -> Bool
$c>= :: Finding -> Finding -> Bool
> :: Finding -> Finding -> Bool
$c> :: Finding -> Finding -> Bool
<= :: Finding -> Finding -> Bool
$c<= :: Finding -> Finding -> Bool
< :: Finding -> Finding -> Bool
$c< :: Finding -> Finding -> Bool
compare :: Finding -> Finding -> Ordering
$ccompare :: Finding -> Finding -> Ordering
Ord, Int -> Finding -> ShowS
[Finding] -> ShowS
Finding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Finding] -> ShowS
$cshowList :: [Finding] -> ShowS
show :: Finding -> String
$cshow :: Finding -> String
showsPrec :: Int -> Finding -> ShowS
$cshowsPrec :: Int -> Finding -> ShowS
Show, Int -> Finding
Finding -> Int
Finding -> [Finding]
Finding -> Finding
Finding -> Finding -> [Finding]
Finding -> Finding -> Finding -> [Finding]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Finding -> Finding -> Finding -> [Finding]
$cenumFromThenTo :: Finding -> Finding -> Finding -> [Finding]
enumFromTo :: Finding -> Finding -> [Finding]
$cenumFromTo :: Finding -> Finding -> [Finding]
enumFromThen :: Finding -> Finding -> [Finding]
$cenumFromThen :: Finding -> Finding -> [Finding]
enumFrom :: Finding -> [Finding]
$cenumFrom :: Finding -> [Finding]
fromEnum :: Finding -> Int
$cfromEnum :: Finding -> Int
toEnum :: Int -> Finding
$ctoEnum :: Int -> Finding
pred :: Finding -> Finding
$cpred :: Finding -> Finding
succ :: Finding -> Finding
$csucc :: Finding -> Finding
Enum)


pDisease, pFalseNegative, pFalsePositive :: Probability
pDisease :: Probability
pDisease = Probability
0.001
pFalseNegative :: Probability
pFalseNegative = Probability
0.01
pFalsePositive :: Probability
pFalsePositive = Probability
0.01


dist :: Dist (State, Finding)
dist :: Dist (State, Finding)
dist =
   do State
s <- forall prob a. Num prob => prob -> a -> a -> T prob a
Dist.choose Probability
pDisease State
Ill State
Healthy
      Finding
f <- case State
s of
              State
Ill     -> forall prob a. Num prob => prob -> a -> a -> T prob a
Dist.choose Probability
pFalseNegative Finding
Negative Finding
Positive
              State
Healthy -> forall prob a. Num prob => prob -> a -> a -> T prob a
Dist.choose Probability
pFalsePositive Finding
Positive Finding
Negative
      forall (m :: * -> *) a. Monad m => a -> m a
return (State
s,Finding
f)


{- |
Alternative way for computing the distribution.
It is usually more efficient because we do not need to switch on the healthy state.
-}
distAlt :: Dist (State, Finding)
distAlt :: Dist (State, Finding)
distAlt =
   do (State
s,T Probability Finding
fr) <-
          forall prob a. Num prob => prob -> a -> a -> T prob a
Dist.choose Probability
pDisease
             (State
Ill,     forall prob a. Num prob => prob -> a -> a -> T prob a
Dist.choose Probability
pFalseNegative Finding
Negative Finding
Positive)
             (State
Healthy, forall prob a. Num prob => prob -> a -> a -> T prob a
Dist.choose Probability
pFalsePositive Finding
Positive Finding
Negative)
      Finding
f <- T Probability Finding
fr
      forall (m :: * -> *) a. Monad m => a -> m a
return (State
s,Finding
f)


p :: Probability
p :: Probability
p = (forall a. Eq a => a -> Event a
Dist.just State
Ill forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall prob a. Num prob => Event a -> T prob a -> prob
?? (forall a. Eq a => a -> Event a
Dist.just Finding
Positive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall prob a.
Fractional prob =>
(a -> Bool) -> T prob a -> T prob a
?=<< Dist (State, Finding)
dist