Added Nicola's tests. Changed "act" to return inferred probability...

Added Nicola's tests.  Changed "act" to return inferred probability distributions over actions, instead of actions.

IntegerLineMPD/prob1.lhs

@@ -35,23 +35,23 @@ What is the probability of ~a~?  (If ~a~ is not in the support of pd, we "round"
 >   lookup a [(_, p)] = p
 >   lookup a ((a', p):rest) = if a <= a' then p else lookup a rest
 
-Probabilities:
+Probability of an event:
 
-> prob :: (a -> Bool) -> PD a -> Double
+> type Event a = a -> Bool
+
+> prob :: Event a -> PD a -> Double
 > prob e (PD aps) = sum [p | (a, p) <- aps, e a == True]
 
-> lift :: (Bool -> Bool -> Bool) -> (a -> Bool) -> (a -> Bool) -> (a -> Bool)
-> lift op f g = \ a -> op (f a) (g a) 
+Conditional probability:
 
-> condProb :: (a -> Bool) -> (a -> Bool) -> PD a -> Maybe Double
+> condProb :: Event a -> Event a -> PD a -> Maybe Double
 > condProb e1 e2 pd = let pe2 = prob e2 pd in
->                     if pe2 == 0.0 
->                     then Nothing
->                     else Just (prob (lift (&&) e1 e2) pd / pe2)
+>                  if pe2 == 0.0
+>                  then Nothing
+>                  else Just (prob (\ a -> e1 a && e2 a) pd / pe2)
 
 Cummulative probabilities:
 
-> cprobs :: PD a -> [Double]
 > cprobs = scanl1 (+) . probs
 
 > type CPD a = [(a, Double)]
@@ -64,7 +64,6 @@ Expected value:
 > expectation :: PD Double -> Double
 > expectation (PD as) = sum (map (uncurry (*)) as) 
 
-
 Some distributions
 
 > bernoulli :: Double -> PD Double
@@ -200,7 +199,6 @@ Example: Monty Hall
 
 What is the probability of the first flip being a head given that there are at least two heads?
 
-> twoOutOfThree :: RV Double
 > twoOutOfThree =
 >   do a <- toss 0.5
 >      b <- toss 0.5
@@ -209,9 +207,17 @@ What is the probability of the first flip being a head given that there are at l
 >         then return a 
 >         else twoOutOfThree
 
-> fstHtwoHs1 :: Nat -> Double
-> fstHtwoHs1 n = let pd = PD (get_pd n twoOutOfThree) in
->                get_prob 1.0 pd
+> pdProd :: PD a -> PD b -> PD (a, b)
+> pdProd (PD aps) (PD bps) = PD [((a, b), pa*pb) | (a, pa) <- aps, (b, pb) <- bps]
+
+Nicola:
+
+> toss3 :: PD (Double, Double, Double)
+> toss3 = arrange (pdProd coin (pdProd coin coin))
+>   where coin = bernoulli 0.5
+>         arrange = fmap f
+>         f (x, (y, z)) = (x, y, z)
+
 
 > fstH :: (Double, Double, Double) -> Bool
 > fstH (x, _, _) = x == 1.0
@@ -219,29 +225,7 @@ What is the probability of the first flip being a head given that there are at l
 > twoHs :: (Double, Double, Double) -> Bool
 > twoHs (x, y, z) = x + y + z >= 2.0
 
-> toss3 :: RV (Double, Double, Double)
-> toss3 = do a <- toss 0.5
->            b <- toss 0.5
->            c <- toss 0.5
->            return (a, b, c)
-
-> fstHtwoHs2 :: Nat -> Maybe Double
-> fstHtwoHs2 n = let pd = PD (get_pd n toss3) in
->                condProb fstH twoHs pd
-
-> fstHtwoHs3 :: Nat -> Maybe Double
-> fstHtwoHs3 n = let t1 = get_pd n (toss 0.5) in
->                let pd = PD [((x, y, z), px * py * pz) | (x, px) <- t1, (y, py) <- t1, (z, pz) <- t1] in
->                condProb fstH twoHs pd
-
-> fstHtwoHs4 :: Maybe Double
-> fstHtwoHs4 = let t1 = pd2List (bernoulli 0.5) in
->              let pd = PD [((x, y, z), px * py * pz) | (x, px) <- t1, (y, py) <- t1, (z, pz) <- t1] in
->              condProb fstH twoHs pd
-
-
-
-
+> lala = condProb fstH twoHs toss3          
 
 3.2 Factor
 
@@ -337,17 +321,18 @@ From https://agentmodels.org/chapters/3a-mdp.html.
 > random_actions = sample (uniform actions)
 
 > numsamp = 5
-> act :: State -> Int -> RV Action
-> act s n = act'
+
+> act :: State -> Int -> RV (PD Action)
+> act s n = infer numsamp ra
 >   where
->     f a = do e <- expectedUtility s n a
->              return (100 * e)
->     inferred = infer numsamp (random_actions >>= f)
->     act' = do a <- random_actions
->               e <- f a
->               accept <- factor inferred e
->               if accept then return a else act'
-> 
+>   f a = do e <- expectedUtility s n a
+>            return (100 * e)
+>   inferred = infer numsamp (random_actions >>= f)
+>   ra = do a <- random_actions
+>           e <- f a
+>           accept <- factor inferred e
+>           if accept then return a else ra
+
 > expectedUtility s n a = if n == 0
 >                           then return u
 >                           else do rexp <- inferred
@@ -356,13 +341,15 @@ From https://agentmodels.org/chapters/3a-mdp.html.
 >   u = utility s
 >   n' = n - 1
 >   s' = transition s a
->   re = do a' <- act s' n'
+>   re = do pa' <- act s' n'
+>           a'  <- sample pa'
 >           expectedUtility s' n' a'
 >   inferred = infer numsamp re
-
+ 
 > simulate s n = do if n == 0
 >                     then return []
->                     else do a <- act s n
+>                     else do pa <- act s n
+>                             a  <- sample pa
 >                             s' <- return (transition s a)
 >                             ss <- simulate s' (n-1)
 >                             return (s':ss)