Problem Set 1

Your colleague either commutes by train or by the bus. 20 days of the month, she takes the train and the remaining 10 days she takes the bus. If she takes the train, she reaches work on time with a probability of 0.9. If she takes the bus, she frequently gets stuck in trac and reaches work on time with a probability of 0.5. Given that she was on time today, what is the probability that she took the bus to work today?

Using a Bayesian approach:

\[P(Bus|On\space Time) = \frac{P(On\space Time|Bus)\times P(Bus)}{P(On\space Time)} \\ = \frac{P(On\space Time|Bus)\times P(Bus)}{P(On\space Time|Bus)\times P(Bus)+P(On\space Time|Train)\times P(Train)} \\ = \frac{0.5\times 1/3}{0.5\times 1/3+0.9\times 2/3} = 0.2174\]

Problem Set 2

In the Grade Network that we looked at in the notes, (a) what happens to the probability of Diffculty of Course when you present the evidence that the received recommendation letter was good? (b) In addition, now present the evidence that both SAT scores were good and the letter of recommendation was good. What is the probability of the Diffculty of Course now? You should use the gRain package in R to build your network and perform these calculations. You may need to install RBGL package from BioConductor in R to get gRain working. See http://www.bioconductor.org/packages/release/bioc/html/RBGL.html for instructions on RBGL.

First we need to set the conditional probability tables:

#---Levels---#
ny <- c("No", "Yes")

#Low & High Levels
lh <- c("Low","High")
 
#---Conditional Probabilities---#

#difficulty
d <- cptable(~difficulty,
             values=c(0.3, 0.7),
             levels = ny )
 
#intelligence
i <- cptable(~intelligence,
             values=c(0.8, 0.2),
             levels = lh)

#grade | difficulty, intelligence
g.di <- cptable(~grade|difficulty+intelligence,
                 values = c(0.6, 0.4, 0.01, 0.99,0.8, 0.2, 0.1, 0.9),
                 levels = lh)

#SAT | intelligence
s.i <- cptable(~SAT|intelligence,
               values = c(0.9, 0.1, 0.2, 0.8),
               levels = lh)

#Letter | grade
l.g <- cptable(~letter|grade,
             values = c(0.9, 0.1, 0.05, 0.95),
             levels = lh)

# Compile conditoinal probability table
(plist <- compileCPT(list(d, i, g.di, s.i, l.g)))
## CPTspec with probabilities:
##  P( difficulty )
##  P( intelligence )
##  P( grade | difficulty intelligence )
##  P( SAT | intelligence )
##  P( letter | grade )

With our conditional probability tables compiled, we can construct our Bayesian Network with the grain function.

bnet <- grain(plist)
plot(bnet)

(a) What happens to the probability of Diffculty of Course when you present the evidence that the received recommendation letter was good?

Looking at the marginal probability of difficulty of the course we see, unsurprisingly, that it is as it was defined:

querygrain(bnet, nodes = "difficulty")
## $difficulty
## difficulty
##  No Yes 
## 0.3 0.7

Setting evidence that the recommendation letter was good, i.e. it was High, we can see how the marginal probability of difficulty has changed:

bnet.ev1 <- setEvidence(bnet, nodes = "letter", states = "High")
querygrain(bnet.ev1, nodes = "difficulty")
## $difficulty
## difficulty
##        No       Yes 
## 0.1581531 0.8418469

(b) Present evidence that both SAT scores were good and the letter of recommendation was good. What is the probability of the Diffculty of Course now?

Using the same method outlined above:

bnet.ev2 <- setEvidence(bnet, nodes = c("SAT", "letter"), states = c("High", "High"))
querygrain(bnet.ev2, nodes = "difficulty")
## $difficulty
## difficulty
##        No       Yes 
## 0.1358564 0.8641436