Commit ce1f7413 authored by Cezar Ionescu's avatar Cezar Ionescu
Browse files

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.
parent e9d83efa
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment