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 traffic 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?

$$

\[\begin{equation} P(A|B) = \frac{P(B|A) * P(A)}{P(B)}\end{equation}\]

$$

library(MASS)

#Probability that she is on time given that she took the bus
busO = fractions(1/2 * 1/3)
busO
## [1] 1/6
#Probability that she is late given that she took the bus
busL = fractions(1/2 * 1/3)
busL
## [1] 1/6
#Probability that she is on time given that she took the train
trainO = fractions(9/10 * 2/3)
trainO
## [1] 3/5
#Probability that she is late given that she took the train
trainL = fractions(1/10 * 2/3)
trainL
## [1] 1/15
#Overall probability that she is on time
onTime = busO+trainO
onTime
## [1] 23/30
#Overall probability that she is late
late = 1 - onTime
late
## [1] 7/30
#probability that she took the bus given that she was on time
tookBus = busO/onTime
tookBus
## [1] 5/23

Problem set 2

You should use the gRain package in R to build your network and perform these cal-culations. 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.

Create conditional probability tables and then compile them using gRain

library(gRain)
## Warning: package 'gRain' was built under R version 3.3.3
## Loading required package: gRbase
## Warning: package 'gRbase' was built under R version 3.3.3
ny   <- c("no","yes")
#good/bad is intuitively binary so we will use low and high to account for it as well
lh  <- c("low","high")

# conditional probability tables
int <- cptable(~intelligence, values = c(0.8,0.2), levels = lh)
dif <- cptable(~difficulty, values = c(0.3,0.7), levels = ny)
sat <- cptable(~sat | intelligence, values = c(0.9,0.1,0.2,0.8), levels = lh)
grade <- cptable(~grade | difficulty : intelligence, values = c(0.6,0.4,0.8,0.2,0.01,0.99,0.1,0.9), levels = lh)
letter <- cptable(~letter | grade, values = c(0.9, 0.1, 0.05, 0.95), levels = lh)

plist <- compileCPT(list(int, dif, sat, grade, letter))
plist
## CPTspec with probabilities:
##  P( intelligence )
##  P( difficulty )
##  P( sat | intelligence )
##  P( grade | difficulty intelligence )
##  P( letter | grade )
#a good way to double check the probability tables. Here I am double checking the one with the most values
plist$grade
## , , intelligence = low
## 
##       difficulty
## grade   no yes
##   low  0.6 0.8
##   high 0.4 0.2
## 
## , , intelligence = high
## 
##       difficulty
## grade    no yes
##   low  0.01 0.1
##   high 0.99 0.9
## 
## attr(,"class")
## [1] "parray" "array"
#create the network
network <- grain(plist)

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?

#check the initial probability that the course is difficult
plist$difficulty
## difficulty
##  no yes 
## 0.3 0.7 
## attr(,"class")
## [1] "parray" "array"
# set evidence
net2 <- setEvidence(network, evidence = list(letter="high"))

#What is the probability that the course is difficult now that we have established that the letter is good
# P(difficult | letter=good)

pnew2 <- querygrain(net2, nodes = "difficulty")
pnew2
## $difficulty
## difficulty
##        no       yes 
## 0.3731439 0.6268561

The probability that the course is difficult decreases

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?

net3 <- setEvidence(network, evidence = list(letter="high", sat="high"))
pnew3 <- querygrain(net3, nodes = "difficulty")

pnew3
## $difficulty
## difficulty
##        no       yes 
## 0.3323478 0.6676522

The probability that the course is difficult is still lower that the initial state, but higher than when we only knew that the letter of recommendation was good.