# ============================================================
# KRONX :: run_kronx.R
# Public entry-point: run the full Clock of Regimes (KRONX)
# pipeline on either:
#   (i) a CSV file containing a close or Close price column, or
#   (ii) a numeric vector of returns supplied directly.
# ============================================================

#' Run the full Clock of Regimes (KRONX) analysis.
#'
#' Runs the KRONX pipeline on either a CSV file of prices or a numeric vector
#' of returns supplied directly. When \code{file} is used, the function reads
#' the CSV file, extracts the close-price column (case-insensitive match on
#' \code{"close"} or \code{"Close"}), and computes log returns. When
#' \code{x} is supplied, it is treated as a numeric return series and the
#' file-ingestion step is skipped.
#'
#' The function then fits Gaussian and Student-t Hidden Markov Models (HMMs),
#' builds the KRONX operator chain Q \eqn{\rightarrow} K \eqn{\rightarrow} N,
#' and computes a residence-weighted upper bound on extreme downside risk.
#' Results are returned as a named list and, optionally, written to
#' \code{output_dir}.
#'
#' @param file Path to a CSV file containing a close-price column. Ignored if
#'   \code{x} is supplied. Default: \code{NULL}.
#' @param x Optional numeric vector of returns. If supplied, \code{file} is
#'   ignored and no CSV is read. This is intended in particular for small,
#'   self-contained examples and tests. Default: \code{NULL}.
#' @param close_col Name of the close-price column. The function first tries
#'   the exact name, then a case-insensitive match, and finally falls back to
#'   any column whose name contains \code{"close"}. Default:
#'   \code{"close"}.
#' @param K Number of hidden states. Default: \code{3L}.
#' @param n_starts Number of EM random restarts. Default: \code{5L}.
#' @param max_iter Maximum EM iterations per restart. Default: \code{200L}.
#' @param tol Log-likelihood convergence tolerance. Default: \code{1e-6}.
#' @param seed Random seed for reproducibility. Default: \code{123L}.
#' @param epsilon_min Minimum baseline Talebian hazard. Default: \code{0.01}.
#' @param c_hazard Hazard sensitivity to tail thickness. Default:
#'   \code{0.05}.
#' @param tail_alpha Left-tail probability used for the empirical loss
#'   threshold. Default: \code{0.01}.
#' @param ruin_horizon Horizon, in observations, used in the risk bound.
#'   Default: \code{250L}.
#' @param nu_grid Candidate degrees-of-freedom values for Student-t fitting.
#'   Default: \code{c(3:30, 40, 60, 100)}.
#' @param verbose Logical; if \code{TRUE}, print progress and a summary.
#'   Default: \code{TRUE}.
#' @param output_dir Directory for output files. Created if it does not exist.
#'   Pass \code{NULL} to suppress file output. Default:
#'   \code{"kronx_output"}.
#'
#' @return A named list containing:
#' \describe{
#'   \item{close_px}{Numeric vector of raw close prices, or \code{NULL} when
#'     \code{x} is supplied directly.}
#'   \item{ret}{Numeric vector of log returns or supplied returns.}
#'   \item{K}{Number of hidden states.}
#'   \item{gauss_fit}{Fitted Gaussian HMM object.}
#'   \item{t_fit}{Fitted Student-t HMM object.}
#'   \item{A_gauss}{Gaussian transition matrix.}
#'   \item{A_t}{Student-t transition matrix.}
#'   \item{epsilon}{Per-state Talebian hazard vector.}
#'   \item{Q}{Hazard-adjusted operator.}
#'   \item{K_mat}{KRONX generator matrix.}
#'   \item{N_mat}{Fundamental matrix.}
#'   \item{pi_qs}{Quasi-stationary distribution.}
#'   \item{pi_res}{Residence-weight vector.}
#'   \item{loss_threshold}{Empirical left-tail return threshold.}
#'   \item{q_state}{Per-state tail probability.}
#'   \item{bar_q}{Residence-weighted tail probability.}
#'   \item{bar_lambda}{Residence-weighted hazard.}
#'   \item{ruin_bound}{Upper bound over \code{ruin_horizon}.}
#'   \item{tail_alpha}{The \code{tail_alpha} value used.}
#'   \item{ruin_horizon}{The \code{ruin_horizon} value used.}
#'   \item{state_summary}{A \code{data.frame} summarising per-state
#'     quantities.}
#'   \item{vpath_t}{Integer vector of Viterbi-decoded Student-t state labels.}
#'   \item{output_files}{Character vector of paths to written output files, or
#'     \code{NULL} if \code{output_dir} is \code{NULL}.}
#'   \item{input_source}{A short label describing the data source used.}
#' }
#' @examples
#' # Small self-contained example suitable for automatic checking
#' set.seed(123)
#' x <- rnorm(120, mean = 0, sd = 0.01)
#' res <- run_kronx(
#'   x = x,
#'   K = 2L,
#'   n_starts = 1L,
#'   max_iter = 10L,
#'   tol = 1e-4,
#'   tail_alpha = 0.05,
#'   ruin_horizon = 25L,
#'   verbose = FALSE,
#'   output_dir = NULL
#' )
#' res$ruin_bound
#' dim(res$A_t)
#' # Self-contained file-based example
#' tmp <- tempfile(fileext = ".csv")
#' dat <- data.frame(
#'   date = sprintf("2026-01-%02d", 1:20),
#'   close = c(
#'     100.0, 100.2, 100.1, 100.5, 100.4,
#'     100.8, 101.0, 100.9, 101.3, 101.1,
#'     101.6, 101.5, 101.9, 102.0, 101.8,
#'     102.2, 102.4, 102.3, 102.7, 102.9
#'   )
#' )
#' utils::write.csv(dat, tmp, row.names = FALSE)
#' res_file <- run_kronx(
#'   file = tmp,
#'   close_col = "close",
#'   K = 2L,
#'   n_starts = 1L,
#'   max_iter = 8L,
#'   tol = 1e-4,
#'   tail_alpha = 0.10,
#'   ruin_horizon = 10L,
#'   verbose = FALSE,
#'   output_dir = NULL
#' )
#' res_file$ruin_bound
#' @export

run_kronx <- function(
    file         = NULL,
    x            = NULL,
    close_col    = "close",
    K            = 3L,
    n_starts     = 5L,
    max_iter     = 200L,
    tol          = 1e-6,
    seed         = 123L,
    epsilon_min  = 0.01,
    c_hazard     = 0.05,
    tail_alpha   = 0.01,
    ruin_horizon = 250L,
    nu_grid      = c(3:30, 40, 60, 100),
    verbose      = TRUE,
    output_dir   = "kronx_output"

) {
  old_opts <- options(stringsAsFactors = FALSE)
  on.exit(options(old_opts), add = TRUE)

  set.seed(seed)

  # ---- 1. Input validation ----
  if (is.null(file) && is.null(x)) {
    stop("Provide either 'file' or 'x'.", call. = FALSE)
  }

  if (!is.null(file)) {
    if (!is.character(file) || length(file) != 1L || is.na(file)) {
      stop("'file' must be NULL or a single character string.", call. = FALSE)
    }
  }

  if (!is.null(x)) {
    if (!is.numeric(x)) {
      stop("'x' must be a numeric vector.", call. = FALSE)
    }
    x <- as.numeric(x)
    x <- x[is.finite(x)]
    if (length(x) < 10L) {
      stop("'x' must contain at least 10 finite observations.", call. = FALSE)
    }
  }

  if (!is.character(close_col) || length(close_col) != 1L || is.na(close_col)) {
    stop("'close_col' must be a single character string.", call. = FALSE)
  }

  if (!is.numeric(K) || length(K) != 1L || is.na(K) || K < 1L) {
    stop("'K' must be a positive integer.", call. = FALSE)
  }
  K <- as.integer(K)

  if (!is.numeric(n_starts) || length(n_starts) != 1L ||
      is.na(n_starts) || n_starts < 1L) {
    stop("'n_starts' must be a positive integer.", call. = FALSE)
  }
  n_starts <- as.integer(n_starts)

  if (!is.numeric(max_iter) || length(max_iter) != 1L ||
      is.na(max_iter) || max_iter < 1L) {
    stop("'max_iter' must be a positive integer.", call. = FALSE)
  }
  max_iter <- as.integer(max_iter)

  if (!is.numeric(tol) || length(tol) != 1L || is.na(tol) || tol <= 0) {
    stop("'tol' must be a positive number.", call. = FALSE)
  }

  if (!is.numeric(seed) || length(seed) != 1L || is.na(seed)) {
    stop("'seed' must be a single numeric value.", call. = FALSE)
  }
  seed <- as.integer(seed)

  if (!is.numeric(epsilon_min) || length(epsilon_min) != 1L ||
      is.na(epsilon_min) || epsilon_min < 0) {
    stop("'epsilon_min' must be a non-negative number.", call. = FALSE)
  }

  if (!is.numeric(c_hazard) || length(c_hazard) != 1L ||
      is.na(c_hazard) || c_hazard < 0) {
    stop("'c_hazard' must be a non-negative number.", call. = FALSE)
  }

  if (!is.numeric(tail_alpha) || length(tail_alpha) != 1L ||
      is.na(tail_alpha) || tail_alpha <= 0 || tail_alpha >= 1) {
    stop("'tail_alpha' must lie strictly between 0 and 1.", call. = FALSE)
  }

  if (!is.numeric(ruin_horizon) || length(ruin_horizon) != 1L ||
      is.na(ruin_horizon) || ruin_horizon < 1L) {
    stop("'ruin_horizon' must be a positive integer.", call. = FALSE)
  }
  ruin_horizon <- as.integer(ruin_horizon)

  if (!is.numeric(nu_grid) || length(nu_grid) < 1L || any(!is.finite(nu_grid))) {
    stop("'nu_grid' must be a numeric vector of finite values.", call. = FALSE)
  }

  if (!is.logical(verbose) || length(verbose) != 1L || is.na(verbose)) {
    stop("'verbose' must be TRUE or FALSE.", call. = FALSE)
  }

  if (!is.null(output_dir)) {
    if (!is.character(output_dir) || length(output_dir) != 1L || is.na(output_dir)) {
      stop("'output_dir' must be NULL or a single character string.",
           call. = FALSE)
    }
  }

  # ---- 2. Data ingestion or direct return input ----
  close_px <- NULL

  if (!is.null(x)) {
    ret <- x
    input_source <- "supplied numeric return series"

    if (verbose) {
      message(sprintf(
        "Loaded %d returns from supplied numeric vector.",
        length(ret)
      ))
    }
  } else {
    close_px <- read_close_series(file, close_col = close_col)
    ret <- compute_log_returns(close_px)
    input_source <- file

    if (verbose) {
      message(sprintf(
        "Loaded %d closes and %d log returns from '%s'.",
        length(close_px), length(ret), file
      ))
    }
  }

  if (!is.numeric(ret) || length(ret) < 10L || any(!is.finite(ret))) {
    stop("Return series must contain at least 10 finite numeric observations.",
         call. = FALSE)
  }

  # ---- 3. Fit Gaussian HMM ----
  if (verbose) {
    message("Fitting Gaussian HMM...")
  }

  gauss_fit <- fit_hmm_em(
    x        = ret,
    K        = K,
    model    = "gaussian",
    n_starts = n_starts,
    max_iter = max_iter,
    tol      = tol,
    nu_grid  = nu_grid,
    verbose  = verbose
  )
  gauss_fit <- reorder_fit_by_scale(gauss_fit)

  # ---- 4. Fit Student-t HMM ----
  if (verbose) {
    message("Fitting Student-t HMM...")
  }

  t_fit <- fit_hmm_em(
    x        = ret,
    K        = K,
    model    = "student",
    n_starts = n_starts,
    max_iter = max_iter,
    tol      = tol,
    nu_grid  = nu_grid,
    verbose  = verbose
  )
  t_fit <- reorder_fit_by_scale(t_fit)

  # ---- 5. Transition matrices and spell lengths ----
  A_gauss <- gauss_fit$A
  A_t     <- t_fit$A

  spell_gauss <- expected_spell_lengths(A_gauss)
  spell_t     <- expected_spell_lengths(A_t)
  cond_var_t  <- (t_fit$params$nu / (t_fit$params$nu - 2)) * t_fit$params$sigma^2

  # ---- 6. Viterbi decoding ----
  vpath_t <- viterbi_decode(ret, t_fit)

  # ---- 7. KRONX operator chain ----
  epsilon <- hazard_from_nu(t_fit$params$nu, epsilon_min, c_hazard)
  Q       <- build_Q(A_t, epsilon)
  K_mat   <- build_K(Q)
  N_mat   <- fundamental_matrix(K_mat)

  # ---- 8. Quasi-stationary and residence weights ----
  pi_qs  <- quasi_stationary_distribution(Q)
  pi_res <- residence_weight_vector(N_mat, init = pi_qs)

  # ---- 9. Risk bound ----
  loss_threshold <- as.numeric(
    stats::quantile(ret, probs = tail_alpha, na.rm = TRUE)
  )
  q_state    <- left_tail_state_probs(t_fit, loss_threshold)
  bar_q      <- sum(pi_res * q_state)
  bar_lambda <- sum(pi_res * epsilon)
  ruin_bound <- 1 - exp(-bar_lambda * bar_q * ruin_horizon)

  # ---- 10. State summary ----
  state_summary <- data.frame(
    state               = seq_len(K),
    mu_gaussian         = gauss_fit$params$mu,
    sigma_gaussian      = gauss_fit$params$sigma,
    spell_gaussian      = spell_gauss,
    mu_student          = t_fit$params$mu,
    sigma_student       = t_fit$params$sigma,
    nu_student          = t_fit$params$nu,
    cond_var_student    = cond_var_t,
    spell_student       = spell_t,
    epsilon             = epsilon,
    q_tail              = q_state,
    pi_quasi_stationary = pi_qs,
    pi_residence        = pi_res
  )

  # ---- 11. Assemble result ----
  result <- list(
    close_px       = close_px,
    ret            = ret,
    K              = K,
    gauss_fit      = gauss_fit,
    t_fit          = t_fit,
    A_gauss        = A_gauss,
    A_t            = A_t,
    epsilon        = epsilon,
    Q              = Q,
    K_mat          = K_mat,
    N_mat          = N_mat,
    pi_qs          = pi_qs,
    pi_res         = pi_res,
    loss_threshold = loss_threshold,
    q_state        = q_state,
    bar_q          = bar_q,
    bar_lambda     = bar_lambda,
    ruin_bound     = ruin_bound,
    tail_alpha     = tail_alpha,
    ruin_horizon   = ruin_horizon,
    state_summary  = state_summary,
    vpath_t        = vpath_t,
    output_files   = NULL,
    input_source   = input_source
  )

  # ---- 12. Optional summary output ----
  if (verbose) {
    message("------------------------------------------------------------")
    message("CLOCK OF REGIMES (KRONX) -- SUMMARY")
    message("------------------------------------------------------------")
    message(sprintf("Gaussian HMM log-likelihood : %.10f", gauss_fit$logLik))
    message(sprintf("Student-t HMM log-likelihood: %.10f", t_fit$logLik))
    message(sprintf("Loss threshold (alpha=%.4f): %.8f", tail_alpha, loss_threshold))
    message(sprintf("Residence-weighted qbar     : %.8f", bar_q))
    message(sprintf("Residence-weighted lambda   : %.8f", bar_lambda))
    message(sprintf("Risk bound (T=%d)           : %.8f", ruin_horizon, ruin_bound))
    message("------------------------------------------------------------")
    print(state_summary, row.names = FALSE)
  }

  # ---- 13. Optional file output ----
  if (!is.null(output_dir)) {
    paths <- write_kronx_outputs(result, output_dir, input_source)
    result$output_files <- paths

    if (verbose) {
      message(sprintf("Output files written to: %s", output_dir))
      message(paste(sprintf(" - %s", basename(paths)), collapse = "\n"))
    }
  }

  invisible(result)
}