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?

# Define what we know
ontime_train <- 0.9 #If she takes the train, she reaches work on time with a probability of 0.9
late_train <- 0.1 #Complimentary probability
ontime_bus <- 0.5 #If she takes the bus, she reaches work on time with a probability of 0.5
late_bus <- 0.5 #Complimentary probability

train <- 20/30 #20 days of the month, she takes the train
bus <- 10/30 #The remaining 10 days she takes the bus


bus_ontime <- (ontime_bus * bus) / ((ontime_bus * bus) + (ontime_train * train))
cat("Given that she was on time today, the probability that she took the bus is:", bus_ontime)

## Given that she was on time today, the probability that she took the bus is: 0.2173913

Problem Set 2

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?

## Loading required package: gRain
## Loading required package: gRbase
## Loading required package: Rgraphviz
## Loading required package: graph
## Loading required package: grid

Define levels

ny <- c("no", "yes")
lh <- c("low", "high")

Compile list of conditional probabilities

d <- cptable(~difficulty, values=c(0.3, 0.7), levels=ny)
i <- cptable(~intelligence, values=c(0.8, 0.2), levels=lh)
g.di <- cptable(~grade | difficulty:intelligence, values=c(0.6, 0.4, 0.8, 0.2, 0.01, 0.99, 0.1, 0.9), levels=lh)
s.i <- cptable(~sat | intelligence, values=c(0.9, 0.1, 0.2, 0.8), levels=lh)
l.g <- cptable(~letter | grade, values=c(0.9, 0.1, 0.05, 0.95), levels=lh)

cptlist <- compileCPT(list(d, i, g.di, s.i, l.g))
print(cptlist)

## CPTspec with probabilities:
##  P( difficulty )
##  P( intelligence )
##  P( grade | difficulty intelligence )
##  P( sat | intelligence )
##  P( letter | grade )

Verify CPTs with those provided in assignment

print(cptlist$difficulty)

## difficulty
##  no yes 
## 0.3 0.7

print(cptlist$intelligence)

## intelligence
##  low high 
##  0.8  0.2

print(cptlist$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

print(cptlist$sat)

##       intelligence
## sat    low high
##   low  0.9  0.2
##   high 0.1  0.8

print(cptlist$letter)

##       grade
## letter low high
##   low  0.9 0.05
##   high 0.1 0.95

Create and plot Bayesian Network

bn <- grain(cptlist)
plot(bn)

What happens to the probability of Difficulty of Course when you present the evidence that the received recommendation letter was good?

# Set evidence (letter=high) and query network (difficulty=?)
bn.ev1 <- setEvidence(bn, evidence=list(letter="high"))
diff.course <- querygrain(bn.ev1, nodes="difficulty")
print(diff.course)

## $difficulty
## difficulty
##        no       yes 
## 0.3731439 0.6268561

cat("Probability of Difficulty of Course (difficulty=yes) is now:", diff.course$difficulty[2])

## Probability of Difficulty of Course (difficulty=yes) is now: 0.6268561

if (diff.course$difficulty[2] > d$values[2])
  print("Difficulty of Course (difficulty=yes) is now higher than original value")
  print("Difficulty of Course (difficulty=yes) is now lower than original value")

## [1] "Difficulty of Course (difficulty=yes) is now lower than original value"

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?

# Set evidence (sat=high, letter=high) and query network (difficulty=?)
bn.ev2 <- setEvidence(bn, evidence=list(letter="high", sat="high"))
sat.letter <- querygrain(bn.ev2, nodes="difficulty")
print(sat.letter$difficulty[2])

##       yes 
## 0.6676522

cat("Probability of Difficulty of Course (difficulty=yes) is now:", sat.letter$difficulty[2])

## Probability of Difficulty of Course (difficulty=yes) is now: 0.6676522

if(diff.course$difficulty[2] > sat.letter$difficulty[2])
  cat("Difficulty of Course (difficulty=yes) is now lower than recommendation letter alone")
  cat("Difficulty of Course (difficulty=yes) is now higher than recommendation letter alone")

## Difficulty of Course (difficulty=yes) is now higher than recommendation letter alone