Commit ce1f7413 by Cezar Ionescu

### 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!