R/parameter_labels.R

In fHMM: Fitting Hidden Markov Models to Financial Data

#' Create labels for estimated parameters
#'
#' @description
#' This helper function creates labels for the estimated HMM parameters.
#'
#' @param controls
#' An object of class \code{fHMM_controls}.
#'
#' @param expected_length
#' The expected output length.
#'
#' @return
#' A \code{character} vector of parameter labels.
#'
#' @examples
#' \dontrun{
#' parameter_labels(set_controls(), 8)
#' }
#' 
#' @keywords internal

parameter_labels <- function(controls, expected_length) {

  ### check input
  if (!inherits(controls,"fHMM_controls")) {
    stop("'controls' is not of class 'fHMM_controls'.", call. = FALSE)
  }
  if (!is_number(expected_length, pos = TRUE, int = TRUE)) {
    stop("'expected_length' must be a positive integer.", call. = FALSE)
  }

  ### helper function for tpm labels
  tpm_labels <- function(dim) {
    out <- outer(1:dim, 1:dim, paste, sep = ".")
    return(out[row(out) != col(out)])
  }

  ### create parameter labels
  labels <- paste0("Gamma_", tpm_labels(controls$states[1]))
  for (par in c("mu", "sigma", if (controls[["sdds"]][[1]]$name == "t") "df")) {
    if (is.null(controls[["sdds"]][[1]]$pars[[par]])) {
      labels <- c(labels, paste0(par, "_", 1:controls$states[1]))
    }
  }
  if (controls[["hierarchy"]]) {
    for (i in 1:controls$states[1]) {
      labels <- c(labels, paste0("Gamma*", i, "_", tpm_labels(controls$states[2])))
      for (par in c("mu", "sigma", if (controls[["sdds"]][[2]]$name == "t") "df")) {
        if (is.null(controls[["sdds"]][[2]]$pars[[par]])) {
          labels <- c(labels, paste0(par, "*", i, "_", 1:controls$states[2]))
        }
      }
    }
  }

  ### check and return parameter labels
  stopifnot(length(labels) == expected_length)
  return(labels)
}