# =============================================================================
# 02_cor_regime_detection.R — Full Clock of Regimes (COR) workflow
#
# Demonstrates the complete pipeline used in the empirical application:
#   - Six-feature synthetic dataset (mimics hourly E-mini S&P 500 data)
#   - Rationale for random vs chronological train/test split
#   - Model fitting, evaluation, and parameter interpretation
#   - COR Stress Alert signal construction
#   - Sensitivity of the alert threshold
# =============================================================================

library(kronxNBC)

# ---- 1. Synthetic COR dataset ------------------------------------------------
#
# Six features computed over a 24-hour rolling window on the real data pipeline.
# Here we generate synthetic observations that match the distributional shape of
# each regime.

set.seed(123L)
n  <- 600L
mk <- n / 3L     # 200 observations per regime

make_regime <- function(ret_fn, vol_mu, vol_sd,
                        dd_mu,  dd_sd, ts_mu, ts_sd,
                        rp_lambda, ruin_a, ruin_b) {
  data.frame(
    log_return         = ret_fn(mk),
    rolling_volatility = pmax(rnorm(mk, vol_mu, vol_sd), 0.0001),
    drawdown           = rnorm(mk, dd_mu, dd_sd),
    transition_stress  = pmax(rnorm(mk, ts_mu, ts_sd), 0.0001),
    residence_pressure = pmax(as.numeric(rpois(mk, rp_lambda)), 0.0001),
    ruin_proxy         = rbeta(mk, ruin_a, ruin_b)
  )
}

cor_data <- rbind(
  # Calm: near-Gaussian, low volatility, shallow drawdowns
  make_regime(
    ret_fn    = function(n) rnorm(n, 2e-4, 3e-3),
    vol_mu    = 0.004, vol_sd = 0.001,
    dd_mu     = -0.002, dd_sd = 0.002,
    ts_mu     = 0.001, ts_sd = 5e-4,
    rp_lambda = 1, ruin_a = 1, ruin_b = 20
  ),
  # Steady: positive drift, moderate drawdowns
  make_regime(
    ret_fn    = function(n) rnorm(n, 5e-4, 5e-3),
    vol_mu    = 0.008, vol_sd = 0.002,
    dd_mu     = -0.008, dd_sd = 0.004,
    ts_mu     = 0.003, ts_sd = 1e-3,
    rp_lambda = 3, ruin_a = 2, ruin_b = 10
  ),
  # Stress: fat-tailed t(3) returns, high volatility, deep drawdowns
  make_regime(
    ret_fn    = function(n) rt(n, df = 3L) * 0.012,
    vol_mu    = 0.022, vol_sd = 0.005,
    dd_mu     = -0.030, dd_sd = 0.010,
    ts_mu     = 0.015, ts_sd = 5e-3,
    rp_lambda = 12, ruin_a = 5, ruin_b = 3
  )
)

cor_data$regime <- factor(
  rep(c("Calm", "Steady", "Stress"), each = mk),
  levels = c("Calm", "Steady", "Stress")
)

features <- c("log_return", "rolling_volatility", "drawdown",
              "transition_stress", "residence_pressure", "ruin_proxy")

cat("Dataset summary:\n")
print(summary(cor_data[, c(features, "regime")]))

# ---- 2. Why random split, not chronological ----------------------------------
#
# Regime data cluster in time: a Stress episode may span 48-200 consecutive
# hours.  A chronological cut risks placing an entire cluster in the test set
# so the training set has zero Stress observations.
#
# Random sampling ensures class balance in both partitions.

set.seed(456L)
tr_idx  <- sample(nrow(cor_data), size = floor(0.80 * nrow(cor_data)))
x_train <- as.matrix(cor_data[ tr_idx, features])
y_train <- cor_data$regime[ tr_idx]
x_test  <- as.matrix(cor_data[-tr_idx, features])
y_test  <- cor_data$regime[-tr_idx]

cat("\nTrain class distribution:\n")
print(table(y_train))
cat("Test class distribution:\n")
print(table(y_test))

# ---- 3. Fit the Student-t Naive Bayes classifier ----------------------------

model <- student_t_naive_bayes(x_train, y_train)
summary(model)

# ---- 4. Inspect fitted parameters -------------------------------------------

cat("\n--- Degrees-of-freedom matrix (nu) ---\n")
print(model$params$nu)

cat("\n--- Location matrix (mu) ---\n")
print(round(model$params$mu, 6))

cat("\n--- Scale matrix (sd) ---\n")
print(round(model$params$sd, 6))

# Identify which regime has the heaviest tail per feature
cat("\n--- Regime with lowest nu (heaviest tail) per feature ---\n")
apply(model$params$nu, 2L, function(col) rownames(model$params$nu)[which.min(col)])

# ---- 5. Out-of-sample performance -------------------------------------------

pred_class <- predict(model, newdata = x_test, type = "class")
pred_prob  <- predict(model, newdata = x_test, type = "prob")

overall_acc   <- mean(pred_class == y_test)
stress_recall <- mean(pred_class[y_test == "Stress"] == "Stress")
calm_prec     <- mean(y_test[pred_class == "Calm"] == "Calm")

cat(sprintf("\nOverall accuracy:  %.1f%%\n", 100 * overall_acc))
cat(sprintf("Stress recall:     %.1f%%\n",  100 * stress_recall))
cat(sprintf("Calm precision:    %.1f%%\n",  100 * calm_prec))

cat("\nConfusion matrix:\n")
print(table(Actual = y_test, Predicted = pred_class))

# ---- 6. COR Stress Alert signal ----------------------------------------------
#
# A Stress Alert is triggered when P(Stress | x) > threshold.
# The 0.60 threshold balances alert sensitivity with false-positive rate.

stress_prob <- pred_prob[, "Stress"]

cat("\n--- Stress probability distribution (test set) ---\n")
print(quantile(stress_prob, probs = c(0, 0.25, 0.50, 0.75, 0.90, 0.95, 1)))

# Sensitivity analysis across threshold values
cat("\n--- Alert sensitivity by threshold ---\n")
thresholds <- c(0.40, 0.50, 0.60, 0.70, 0.80)
results    <- lapply(thresholds, function(thr) {
  alert   <- stress_prob > thr
  tp      <- sum(alert & y_test == "Stress")
  fp      <- sum(alert & y_test != "Stress")
  fn      <- sum(!alert & y_test == "Stress")
  recall  <- if ((tp + fn) > 0) tp / (tp + fn) else NA
  prec    <- if ((tp + fp) > 0) tp / (tp + fp) else NA
  data.frame(threshold = thr, alerts = sum(alert),
             TP = tp, FP = fp, FN = fn,
             recall = round(recall, 3), precision = round(prec, 3))
})
print(do.call(rbind, results), row.names = FALSE)

# ---- 7. Feature-level diagnostics -------------------------------------------

# Posterior probabilities for observations where the model is most uncertain
entropy <- -rowSums(pred_prob * log(pred_prob + 1e-15))
cat("\nHighest-entropy (most uncertain) test observations:\n")
top_uncertain <- order(entropy, decreasing = TRUE)[1:5]
cat("  Indices:", top_uncertain, "\n")
cat("  True labels:", as.character(y_test[top_uncertain]), "\n")
cat("  Predicted:  ", as.character(pred_class[top_uncertain]), "\n")
cat("  Posteriors:\n")
print(round(pred_prob[top_uncertain, ], 4))
