ADM Task 1

# Define the state and observation space
states = c("1","2","3","H")
observations <- c("fever", "ok")

# Define the start probabilities
startProbs <- c(1,0,0,0)

# Define the transition probabilities
transProbs <- matrix(data = c(0.6,0.3 ,0   ,0.1,
                              0  ,0.75,0.15,0.1,
                              0  ,0   ,0.9 ,0.1,
                              0  ,0   ,0   ,1),
                                  byrow = T,nrow = 4)

# Define the emission probabilities
emitProbs <- matrix(c(0.1, 0.9, 0.5, 0.5, 0.8, 0.2, 0, 1), byrow=T, nrow=4)

# Create the HMM
hmm <- initHMM(States=states, Symbols=observations, startProbs=startProbs, transProbs=transProbs, emissionProbs=emitProbs)

# Print the HMM
print(hmm)

## $States
## [1] "1" "2" "3" "H"
## 
## $Symbols
## [1] "fever" "ok"   
## 
## $startProbs
## 1 2 3 H 
## 1 0 0 0 
## 
## $transProbs
##     to
## from   1    2    3   H
##    1 0.6 0.30 0.00 0.1
##    2 0.0 0.75 0.15 0.1
##    3 0.0 0.00 0.90 0.1
##    H 0.0 0.00 0.00 1.0
## 
## $emissionProbs
##       symbols
## states fever  ok
##      1   0.1 0.9
##      2   0.5 0.5
##      3   0.8 0.2
##      H   0.0 1.0

simHMM(hmm,15)

## $states
##  [1] "1" "2" "2" "2" "2" "2" "2" "3" "3" "3" "3" "3" "3" "3" "H"
## 
## $observation
##  [1] "ok"    "fever" "ok"    "fever" "ok"    "ok"    "fever" "fever" "fever"
## [10] "ok"    "fever" "fever" "fever" "fever" "ok"

What is the most likely sequence of test results in the first three days in the hospital?

which.max(c(
sum(exp(forward(hmm,c("fever","fever","fever")))[,3]),
sum(exp(forward(hmm,c("fever","fever","ok")))[,3]),
sum(exp(forward(hmm,c("fever","ok","fever")))[,3]),
sum(exp(forward(hmm,c("ok","fever","fever")))[,3]),
sum(exp(forward(hmm,c("fever","ok","ok")))[,3]),
sum(exp(forward(hmm,c("ok","fever","ok")))[,3]),
sum(exp(forward(hmm,c("ok","ok","fever")))[,3]),
sum(exp(forward(hmm,c("ok","ok","ok")))[,3])))

## [1] 8

print(sum(exp(forward(hmm,c("ok","ok","ok")))[,3]))

## [1] 0.542115

print(" -ok,ok,ok- most likely ")

## [1] " -ok,ok,ok- most likely "

What is the probability of three days with fever in a row (trace: fever, fever, fever) in the first three days in the hospital?

sum(exp(forward(hmm,c("fever","fever","fever")))[,3])

## [1] 0.008685

What is the probability of that trace (fever, fever, fever) after 5 days in the hospital?

sum(
sum(exp(forward(hmm,c("fever","fever","fever","fever","fever")))[,5]),
sum(exp(forward(hmm,c("fever","ok","fever","fever","fever")))[,5]),
sum(exp(forward(hmm,c("ok","fever","fever","fever","fever")))[,5]),
sum(exp(forward(hmm,c("ok","ok","fever","fever","fever")))[,5])
)

## [1] 0.07687406

What is the most likely path that led to observing three days without fever in a row (trace: OK, OK, OK) in the first three days in the hospital?

viterbi(hmm,c("ok","ok","ok"))

## [1] "1" "1" "1"

What is the most likely path of that trace (OK, OK, OK) after 5 days in the hospital?

viterbi(hmm,c("fever","fever","ok","ok","ok"))

## [1] "1" "2" "H" "H" "H"

viterbi(hmm,c("fever","ok","ok","ok","ok"))

## [1] "1" "H" "H" "H" "H"

viterbi(hmm,c("ok","fever","ok","ok","ok"))

## [1] "1" "2" "H" "H" "H"

viterbi(hmm,c("ok","ok","ok","ok","ok"))

## [1] "1" "H" "H" "H" "H"

print(" most likely path is -H,H,H- ")

## [1] " most likely path is -H,H,H- "