{- |

Approach: model a node with k predecessors as a function with k
          parameters

-}
module Numeric.Probability.Example.Bayesian where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Transition as Trans
import qualified Numeric.Probability.Monad as MonadExt
import Numeric.Probability.Distribution ((??), (?=<<), )



-- * Abbreviations, smart constructors

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

type State  a = [a]
type PState a = Dist (State a)
type STrans a = State a -> PState a
type SPred  a = a -> State a -> Bool

event :: Probability -> a -> STrans a
event :: forall a. Probability -> a -> STrans a
event Probability
p a
e0 = Probability -> Change (State a) -> T Probability (State a)
forall prob a. Num prob => prob -> Change a -> T prob a
Trans.maybe Probability
p (a
e0a -> Change (State a)
forall a. a -> [a] -> [a]
:)

happens :: Eq a => SPred a
happens :: forall a. Eq a => SPred a
happens = a -> [a] -> Bool
forall a. Eq a => SPred a
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem

network :: [STrans a] -> PState a
network :: forall a. [STrans a] -> PState a
network = ([STrans a] -> STrans a) -> State a -> [STrans a] -> PState a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [STrans a] -> STrans a
forall (m :: * -> *) a. Monad m => [a -> m a] -> a -> m a
MonadExt.compose []


source :: Probability -> a -> STrans a
source :: forall a. Probability -> a -> STrans a
source = Probability -> a -> STrans a
forall a. Probability -> a -> STrans a
event

bin :: Eq a =>
   a -> a -> Probability -> Probability -> Probability -> Probability ->
   a -> STrans a
bin :: forall a.
Eq a =>
a
-> a
-> Probability
-> Probability
-> Probability
-> Probability
-> a
-> STrans a
bin a
x a
y Probability
a Probability
b Probability
c Probability
d a
z State a
s | a -> State a -> Bool
forall a. Eq a => SPred a
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x State a
s Bool -> Bool -> Bool
&& a -> State a -> Bool
forall a. Eq a => SPred a
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
y State a
s = Probability -> a -> STrans a
forall a. Probability -> a -> STrans a
event Probability
a a
z State a
s
                    | a -> State a -> Bool
forall a. Eq a => SPred a
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
x State a
s             = Probability -> a -> STrans a
forall a. Probability -> a -> STrans a
event Probability
b a
z State a
s
                    | a -> State a -> Bool
forall a. Eq a => SPred a
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
y State a
s             = Probability -> a -> STrans a
forall a. Probability -> a -> STrans a
event Probability
c a
z State a
s
                    | Bool
otherwise            = Probability -> a -> STrans a
forall a. Probability -> a -> STrans a
event Probability
d a
z State a
s


-- | Two possible causes for one effect

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

g :: PState Nodes
g :: PState Nodes
g = [STrans Nodes] -> PState Nodes
forall a. [STrans a] -> PState a
network [Probability -> Nodes -> STrans Nodes
forall a. Probability -> a -> STrans a
source Probability
0.1 Nodes
A,
             Probability -> Nodes -> STrans Nodes
forall a. Probability -> a -> STrans a
source Probability
0.2 Nodes
B,
             Nodes
-> Nodes
-> Probability
-> Probability
-> Probability
-> Probability
-> Nodes
-> STrans Nodes
forall a.
Eq a =>
a
-> a
-> Probability
-> Probability
-> Probability
-> Probability
-> a
-> STrans a
bin Nodes
A Nodes
B Probability
1 Probability
1 Probability
0.5 Probability
0 Nodes
E]

-- * queries

e, aE, bE :: Probability
e :: Probability
e  = SPred Nodes
forall a. Eq a => SPred a
happens Nodes
E Event [Nodes] -> PState Nodes -> Probability
forall prob a. Num prob => Event a -> T prob a -> prob
??                PState Nodes
g
aE :: Probability
aE = SPred Nodes
forall a. Eq a => SPred a
happens Nodes
A Event [Nodes] -> PState Nodes -> Probability
forall prob a. Num prob => Event a -> T prob a -> prob
?? SPred Nodes
forall a. Eq a => SPred a
happens Nodes
E Event [Nodes] -> PState Nodes -> PState Nodes
forall prob a.
Fractional prob =>
(a -> Bool) -> T prob a -> T prob a
?=<< PState Nodes
g
bE :: Probability
bE = SPred Nodes
forall a. Eq a => SPred a
happens Nodes
B Event [Nodes] -> PState Nodes -> Probability
forall prob a. Num prob => Event a -> T prob a -> prob
?? SPred Nodes
forall a. Eq a => SPred a
happens Nodes
E Event [Nodes] -> PState Nodes -> PState Nodes
forall prob a.
Fractional prob =>
(a -> Bool) -> T prob a -> T prob a
?=<< PState Nodes
g


{-
data State = State {causeA :: Bool, causeB :: Bool, effect :: Bool}
             deriving (Eq,Ord,Show)

nCauseA s = s{causeA=True}
-}

--
-- Wet grass example
--
-- cloudy = true 0.5
--
-- sprinkler c = dep c 0.1 0.5
--
-- rain c = dep c 0.8 0.2
--
-- wetGrass s r = bin s r 0.99 0.9 0.9 0
--
-- c = cloudy
-- s = sprinkler cloudy
-- r = rain cloudy
-- w = wetGrass s r


-- alarm :: Prob -> Prob -> Prob
-- alarm b e = cond b (pTrue 0.8)
--                    (cond e (pTrue 0.1) (pTrue 0.01))
--
-- john :: Prob -> Prob
-- john a = cond a (pTrue 0.7) (pTrue 0.1)
--
-- mary :: Prob -> Prob
-- mary a = cond a (pTrue 0.6) (pTrue 0.2)
--
--
-- maryWhenJohn = mary a ?? john a
--                where a = alarm (pTrue 0.5) (pTrue 0.1)