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?
Bayes Rule: \(P(X=x|e) = \frac{P(e|X=x) \times P(X=x)} {P(e)}\)
Probability of Took-Bus given On-Time = Probability of On-Time given Took-Bus times Probability of Took-Bus over Probability of On-Time
\(X=x\) is Took-Bus and \(e\) is On-Time (today)
P(Took-Bus|On-Time) \(= \frac{P(On-Time|Took-Bus) \times P(Took-Bus)} {P(On-Time)}\)
P(Took-Bus|On-Time) \(= \frac{(0.5) \times (10/30)} {(0.9)(20/30) + (0.5)(10/30)}\) \(= \frac{(1/2) \times (1/3)} {(9/10)(2/3) + (1/2)(1/3)}\) \(= \frac{1/6} {18/30 + 1/6}\)
P(Took-Bus|On-Time) \(= \frac{1/6} {23/30}\) \(= \frac{30} {138}\) \(= \frac{5} {23}\) \(= 0.217\)
P(Took-Bus|On-Time) = 21.7%
In the Grade Network that we looked at in the notes, what happens to the probability of Difficulty of Course when you present the evidence that the received recommendation letter was good? 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 Difficulty of Course now?
library(gRain)## Loading required package: gRbaseyn <- c("yes","no")
hl <- c("high","low")
# Difficulty of course is Yes 70% of the time and No 30%
d <- cptable(~diff, values=c(70, 30),levels=yn)
# Intelligence is High 20% of the time and Low 80%
i <- cptable(~intel, values=c(20, 80),levels=hl)
# SAT scores given Intelligence: SAT High given intelligence is High 80%, SAT is Low given intelligence is high 20%,
# SAT is High given Intelligence is Low 10%, SAT is Low given Intelligence is Low 90%
s.i <- cptable(~sat|intel, values=c(80, 20, 10, 90),levels=hl)
# Grade is High or Low given Difficulty of course and Intelligence
g.di <- cptable(~grade|diff:intel,values=c(90, 10, 99, 1, 20, 80, 40, 60),levels=hl)
# Recommendation Letter quality given Grade: Letter High given Grade High 95%, Letter High given Grade Low 10%, ...
l.g <- cptable(~lett|grade, values=c(95, 5, 10, 90),levels=hl)
# Compile list of conditional probability tables and create the network:
plist <- compileCPT(list(d, i, s.i, g.di, l.g))
plist## CPTspec with probabilities:
## P( diff )
## P( intel )
## P( sat | intel )
## P( grade | diff intel )
## P( lett | grade )# To check probabilities to values in Figure 1
plist$diff## diff
## yes no
## 0.7 0.3
## attr(,"class")
## [1] "parray" "array"plist$intel## intel
## high low
## 0.2 0.8
## attr(,"class")
## [1] "parray" "array"plist$sat## intel
## sat high low
## high 0.8 0.1
## low 0.2 0.9
## attr(,"class")
## [1] "parray" "array"plist$grade## , , intel = high
##
## diff
## grade yes no
## high 0.9 0.99
## low 0.1 0.01
##
## , , intel = low
##
## diff
## grade yes no
## high 0.2 0.4
## low 0.8 0.6
##
## attr(,"class")
## [1] "parray" "array"plist$lett## grade
## lett high low
## high 0.95 0.1
## low 0.05 0.9
## attr(,"class")
## [1] "parray" "array"net1 <- grain(plist)
net1## Independence network: Compiled: FALSE Propagated: FALSE
## Nodes: chr [1:5] "diff" "intel" "sat" "grade" "lett"net2 <- setEvidence(net1, evidence = list(lett = "high"))
querygrain(net2, nodes = c("diff"), type = "marginal")## $diff
## diff
## yes no
## 0.6268561 0.3731439The probability of Difficulty of Course goes from Y = 0.7 & N = 0.3, to Y = 0.627 & N = 0.373
net3 <- setEvidence(net1, evidence = list(sat = "high", lett = "high"))
querygrain(net3, nodes = c("diff"), type = "marginal")## $diff
## diff
## yes no
## 0.6676522 0.3323478The probability of Difficulty of Course goes from Y = 0.7 & N = 0.3, to Y = 0.668 & N = 0.332