multi_HMM: Fitting a Hidden Markov Model to multifactor Likelihoods
In pneff93/HMM: Fitting a Hidden Markov Model

Description Usage Arguments Details Value See Also Examples

Estimation of the transition probabilites, the initial state probabilites and the hidden state parameters of a Hidden Markov Model by using the Direct Maximisation of the likelihood or the Baum-Welch Algorithm

1 2	multi_HMM(x, theta, m, method = "DM", L1, L2, L3 = NULL, L4 = NULL, L5 = NULL, iterations = NULL, DELTA = NULL, decoding = FALSE)

`x`	sample of a Hidden Model
`theta`	list with initial number of Likelihood parameters (see details)
`m`	the number of states
`method`	choose between two different methods: "DM" as default, alternative "EM"
`L1`	likelihood of the first hidden state
`L2`	likelihood of the second hidden state
`L3`	optional. likelihood of the third hidden state
`L4`	optional. likelihood of the 4th hidden state
`L5`	optional. likelihood of the 5th hidden state
`iterations`	optional. number of iterations for the EM-Algorithm
`DELTA`	optional. stop criterion for the EM-Algorithm
`decoding`	if parameter set TRUE the function returns the most probable paths via local and global decoding

This package is designed to estimate the hidden states of a HMM-Model, given the underlying likelihoods of each state. It is important to support at least two likelihoods (L1, L2) for the function, which both depend on multiple unkown thetas. See examples for a suitable structur of the likelihood.

The multi_HMM() function is able to calculate with multiple Theta values for the individual likelihoods. For each likelihood the right number initial starting parameter has to be set, in order to compute the estimation of the corresponding Thetas. For each Likelihood the starting values must be in the format of a vector, which is then saved as a list element.

e.g.: theta[[i]] <- c(parameter1, parameter2, ...)

The function then extracts the right number of parameters per likelihood and optimizes the values.

Choose with "method" the underlying estimation function. If DM is selected, the HMM-function will estimate the parameters via a direct maximisation of the given likelihoods. If EM is selected the HMM-function will use a Baum-Welch estimation algorithm to compute the different states and the estimation of the underlying parameters.

For more detailed explanation we recommend the source Hidden Markov Models for Times Series by Walter Zucchini, Iain MacDonald & Roland Langrock.

The underlying functions are the multi_HMM_EM for the EM-Algorithm and the multi_HMM_DM for the Direct Maximisation.

Returns the Delta vector, Gamma matrix and the Thetas of the Likelihoods rounded by three decimals. If "EM" is selected the function also returns the number of iterations and the DELTA.

For Hidden Markov Models with only one theta per likelihood, please refer to HMM

################
#First: Generating the sample of the HMM with the true following true values:

#transition matrix
gamma <- matrix(c(0.7, 0.25, 0.05,
                0.1, 0.4, 0.5,
                0.3, 0.5, 0.2), byrow = TRUE, nrow = 3)

#initial state probabilities
delta <- c(0.5, 0.3, 0.2)

#sample size
n <- 500

#number of states 
m <- 3

#sampling from normal distribution with different mu's and sigma's: 
x <- c()
set.seed(100)
s1 <- rnorm(10000, 7, 1)
s2 <- rnorm(10000, 2, 4)
s3 <- rnorm(10000, 15, 3)


#initial state
random_number <- runif(1, 0, 1)

if (random_number < delta[1]){
  x[1] <- sample(s1, 1, replace = FALSE)
  p <- 1
} else if (random_number < sum(delta[1:2]) && random_number > delta[1]) {
  x[1] <- sample(s2, 1, replace = FALSE)
  p <- 2
} else {
  x[1] <- sample(s3, 1, replace = FALSE)
  p <- 3
}

#sample creation
for (i in 2:n){
  random_number <- runif(1, 0, 1)
  if (random_number < gamma[p,1]){
    p <- 1
    x[i] <- sample(s1, 1, replace = FALSE)
  } else if(random_number < sum(gamma[p,1:2]) && random_number > gamma[p,1]) {
    p <- 2
    x[i] <- sample(s2, 1, replace = FALSE)
  } else {
    p <- 3
    x[i] <- sample(s3, 1, replace = FALSE)
  }
}

#Display of the sample
hist(x)

################
#Second: Defining the likelihoods.

#To show complexity the first likelihood only requires one parameter,
#while the other two need two. Theta is always a vector. 

L1 <- function(x, theta){
  mu <- theta 
  p1 <- 1/sqrt(2*pi) * exp(-0.5*(x-mu)^2)
  return(p1)
}

L2 <- function(x, theta){
  mu <- theta[1]
  sd <- theta[2]
  p2 <- 1/sqrt(2*pi*(sd^2)) * exp(-((x-mu)^2) / (2*sd^2))
  return(p2)
}

L3 <- function(x, theta){
  mu <- theta[1]
  sd <- theta[2]
  p3 <- 1/sqrt(2*pi*(sd^2)) * exp(-((x-mu)^2) / (2*sd^2))
  return(p3)
}
################
#Third: Guessing the initial Theta and execution of multifactor function
#intial estimates of Theta
theta1 <- list(8, c(1, 1), c(20, 1))

#execution of both multi_HMM functions, with decoding=TRUE 
multi_HMM(x = x, theta = theta1, m = m, method = "EM", 
          L1 = L1, L2 = L2, L3 = L3, decoding = TRUE)
multi_HMM(x = x, theta = theta1, m = m, method = "DM",
          L1 = L1, L2 = L2, L3 = L3, decoding = TRUE)