R/forward_probabilities.R

In ricky-kotecha/rkHMM:

#' Generate the forward probabilities
#'
#' @param model_fit A fitted regime model
#' @param time_series A input time series to generate the model from
#' @param initial_state The initial state of the model
#' @param initial_p The initial probabilities of the model
#'
#' @return a time series with the forward regime probabilities
#' @export
#'
#' @examples
forward_probabilities = function(time_series,
                                 model_fit,
                                 initial_state = c(1, 0),
                                 initial_p = NULL) {
  p_states = data.frame()
  last_state = initial_state
  time_series = data.frame(time_series)
  begin = 1

  if(ncol(time_series) > 1) {
    d1 = multivariate_density(
      time_series,
      matrix(model_fit$means[[1]], nrow(time_series), ncol(time_series), byrow = T),
      model_fit$cov_matrices[[1]]
    )
    d2 = multivariate_density(
      time_series,
      matrix(model_fit$means[[2]], nrow(time_series), ncol(time_series), byrow = T),
      model_fit$cov_matrices[[2]]
    )
    model_fit$density = cbind(d1, d2)
  }


  if (!is.null(initial_p)) {
    d1 = initial_p * model_fit$density[1, ]
    last_state = d1 / sum(d1)
    begin = 2
    p_states = rbind(p_states, last_state)
  }

  for (i in begin:nrow(time_series)) {
    last_state = markov_step(
      model_fit,
      time_series[i, ],
      last_state,
      model_fit$density[i, ]
    )
    p_states = rbind(p_states, last_state)
  }
  names(p_states) = paste("S", 1:2, sep="")
  row.names(p_states) = row.names(time_series)
  p_states
}