ExamplesPi <- matrix(c(1/2, 1/2, 0, 0, 0, 1/3, 1/3, 1/3, 0, 0, 0, 1/3, 1/3, 1/3, 0, 0, 0, 1/3, 1/3, 1/3, 0, 0, 0, 1/2, 1/2), byrow=TRUE, nrow=5)delta <- c(0, 1, 0, 0, 0)lambda <- c(1, 4, 2, 5, 3)m <- nrow(Pi)x <- dthmm(NULL, Pi, delta, "pois", list(lambda=lambda), discrete=TRUE)x <- simulate(x, nsim=2000)#------ Global Decoding ------states <- Viterbi(x)states <- factor(states, levels=1:m)# Compare predicted states with true states# p[j,k] = Pr{Viterbi predicts state k | true state is j}p <- matrix(NA, nrow=m, ncol=m)for (j in 1:m){ a <- (x$y==j) p[j,] <- table(states[a])/sum(a)}print(p)#------ Local Decoding ------# locally decode at i=100print(which.max(Estep(x$x, Pi, delta, "pois", list(lambda=lambda))$u[100,]))#---------------------------------------------------# simulate a beta HMMPi <- matrix(c(0.8, 0.2, 0.3, 0.7), byrow=TRUE, nrow=2)delta <- c(0, 1)y <- seq(0.01, 0.99, 0.01)plot(y, dbeta(y, 2, 6), type="l", ylab="Density", col="blue")points(y, dbeta(y, 6, 2), type="l", col="red")n <- 100x <- dthmm(NULL, Pi, delta, "beta", list(shape1=c(2, 6), shape2=c(6, 2)))x <- simulate(x, nsim=n)# colour denotes actual hidden Markov stateplot(1:n, x$x, type="l", xlab="Time", ylab="Observed Process")points((1:n)[x$y==1], x$x[x$y==1], col="blue", pch=15)points((1:n)[x$y==2], x$x[x$y==2], col="red", pch=15)states <- Viterbi(x)# mark the wrongly predicted stateswrong <- (states != x$y)points((1:n)[wrong], x$x[wrong], pch=1, cex=2.5, lwd=2)