# ============================================================
# smsncut: Monte Carlo simulation
# ============================================================

#' Run one Monte Carlo replication
#'
#' @param theta0_true True parameter vector for group 0.
#' @param theta1_true True parameter vector for group 1.
#' @param family0 Family for group 0.
#' @param family1 Family for group 1.
#' @param c_true True optimal cutoff.
#' @param lambda0 Cost of a false positive.
#' @param lambda1 Cost of a false negative.
#' @param pi0 Prevalence of group 0.
#' @param pi1 Prevalence of group 1.
#' @param n0 Sample size for group 0.
#' @param n1 Sample size for group 1.
#' @param flat_tol Minimum admissible value of the identifiability diagnostic.
#' @param conf_level Confidence level.
#'
#' @return A list describing the replication outcome.
#' @export
mc_one_rep <- function(theta0_true, theta1_true, family0, family1,
                       c_true, lambda0, lambda1, pi0, pi1,
                       n0, n1,
                       flat_tol = 1e-3,
                       conf_level = 0.95) {
  family0 <- .check_family(family0)
  family1 <- .check_family(family1)
  
  x0 <- smsn_rdist(n0, theta0_true, family0)
  x1 <- smsn_rdist(n1, theta1_true, family1)
  
  fit0 <- tryCatch(smsn_fit(x0, family0), error = function(e) NULL)
  fit1 <- tryCatch(smsn_fit(x1, family1), error = function(e) NULL)
  
  if (is.null(fit0) || is.null(fit1) ||
      fit0$convergence != 0 || fit1$convergence != 0) {
    return(list(ok = FALSE, reason = "mle_fail",
                initial_bracket = NA, boundary_ok = NA))
  }
  
  theta0_hat <- fit0$par
  theta1_hat <- fit1$par
  theta_hat <- c(theta0_hat, theta1_hat)
  
  # Check initial interval (pad=0) for "Bracket" column of Table 3
  ab_init <- cutoff_build_interval(theta_hat, family0, family1, pad = 0)
  bc_init <- if (any(!is.finite(ab_init))) {
    list(satisfied = FALSE)
  } else {
    cutoff_boundary_check(
      ab_init["a"], ab_init["b"],
      theta0_hat, theta1_hat, family0, family1,
      lambda0, lambda1, pi0, pi1
    )
  }
  initial_bracket <- isTRUE(bc_init$satisfied)

  # Expand until boundary conditions hold
  interval_info <- tryCatch(
    cutoff_expand_interval_until_valid(
      theta = theta_hat,
      family0 = family0,
      family1 = family1,
      lambda0 = lambda0,
      lambda1 = lambda1,
      pi0 = pi0,
      pi1 = pi1,
      pad_init = 0,
      pad_step = 0.20,
      max_iter = 20L
    ),
    error = function(e) NULL
  )

  boundary_ok <- FALSE
  if (is.null(interval_info) || any(!is.finite(c(interval_info$a, interval_info$b)))) {
    ab <- c(a = -10, b = 10)
  } else {
    ab <- c(a = interval_info$a, b = interval_info$b)
    boundary_ok <- isTRUE(interval_info$ok)
  }
  
  res <- tryCatch(
    cutoff_optimal(
      theta0_hat, theta1_hat, family0, family1,
      lambda0, lambda1, pi0, pi1,
      interval = ab
    ),
    error = function(e) NULL
  )
  
  if (is.null(res) || !is.finite(res$cutoff)) {
    return(list(ok = FALSE, reason = "cutoff_fail",
                initial_bracket = initial_bracket, boundary_ok = boundary_ok))
  }
  c_hat <- res$cutoff
  
  dphi_dc <- tryCatch(
    cutoff_identifiability(
      c_hat, theta0_hat, theta1_hat, family0, family1,
      lambda0, lambda1, pi0, pi1
    ),
    error = function(e) NA_real_
  )
  
  if (!is.finite(dphi_dc) || dphi_dc < flat_tol) {
    return(list(ok = FALSE, reason = "flat_phi",
                initial_bracket = initial_bracket, boundary_ok = boundary_ok))
  }
  
  V_hat <- tryCatch(
    cutoff_variance(
      c_hat, theta0_hat, theta1_hat, family0, family1,
      lambda0, lambda1, pi0, pi1,
      fit0$hessian, fit1$hessian, n0, n1
    ),
    error = function(e) NA_real_
  )
  
  if (!is.finite(V_hat) || V_hat <= 0) {
    return(list(ok = FALSE, reason = "variance_fail",
                initial_bracket = initial_bracket, boundary_ok = boundary_ok))
  }
  
  n <- n0 + n1
  ci <- cutoff_ci(c_hat, V_hat, n, conf_level)
  
  list(
    ok = TRUE,
    reason = "ok",
    c_hat = c_hat,
    V_hat = V_hat,
    dphi_dc = dphi_dc,
    wald_lower = ci["lower"],
    wald_upper = ci["upper"],
    wald_length = ci["length"],
    wald_cover = (ci["lower"] <= c_true) && (c_true <= ci["upper"]),
    initial_bracket = initial_bracket,
    boundary_ok = boundary_ok
  )
}

#' Monte Carlo simulation for one scenario
#'
#' @inheritParams mc_one_rep
#' @param B Number of replications.
#' @param seed Optional random seed.
#'
#' @return A list of Monte Carlo summary statistics.
#' @export
mc_simulate_scenario <- function(theta0_true, theta1_true, family0, family1,
                                 c_true, lambda0, lambda1, pi0, pi1,
                                 n0, n1,
                                 B = 2000L,
                                 flat_tol = 1e-3,
                                 conf_level = 0.95,
                                 seed = NULL) {
  if (!is.null(seed)) set.seed(seed)
  
  out <- vector("list", B)
  for (b in seq_len(B)) {
    out[[b]] <- mc_one_rep(
      theta0_true, theta1_true, family0, family1,
      c_true, lambda0, lambda1, pi0, pi1,
      n0, n1, flat_tol, conf_level
    )
  }
  
  ok <- vapply(out, function(z) isTRUE(z$ok), logical(1))
  out_ok <- out[ok]
  reasons <- vapply(out, function(z) z$reason, character(1))
  n <- n0 + n1
  
  if (length(out_ok) == 0L) {
    return(list(
      n = n,
      B = B,
      B_ok = 0L,
      success_rate = 0,
      mean_c_hat = NA_real_,
      bias = NA_real_,
      rmse = NA_real_,
      sd = NA_real_,
      emp_var_z = NA_real_,
      mean_V_hat = NA_real_,
      ratio = NA_real_,
      mean_dphi = NA_real_,
      coverage = NA_real_,
      mean_length = NA_real_,
      bracket_rate = NA_real_,
      fail_table = sort(table(reasons), decreasing = TRUE)
    ))
  }
  
  c_hat <- vapply(out_ok, `[[`, numeric(1), "c_hat")
  V_hat <- vapply(out_ok, `[[`, numeric(1), "V_hat")
  dphi <- vapply(out_ok, `[[`, numeric(1), "dphi_dc")
  wald_len <- vapply(out_ok, `[[`, numeric(1), "wald_length")
  wald_cov <- vapply(out_ok, `[[`, logical(1), "wald_cover")
  bracket_ok <- vapply(out_ok, `[[`, logical(1), "initial_bracket")
  
  z <- sqrt(n) * (c_hat - c_true)
  
  list(
    n = n,
    B = B,
    B_ok = length(out_ok),
    success_rate = length(out_ok) / B,
    mean_c_hat = mean(c_hat),
    bias = mean(c_hat) - c_true,
    rmse = sqrt(mean((c_hat - c_true)^2)),
    sd = stats::sd(c_hat),
    emp_var_z = stats::var(z),
    mean_V_hat = mean(V_hat),
    ratio = stats::var(z) / mean(V_hat),
    mean_dphi = mean(dphi),
    coverage = mean(wald_cov),
    mean_length = mean(wald_len),
    bracket_rate = mean(bracket_ok),
    fail_table = sort(table(reasons), decreasing = TRUE),
    z = z
  )
}

#' Run all scenarios
#'
#' @param scenarios Named list of scenarios.
#' @param n_vec Vector of total sample sizes.
#' @param B Number of replications.
#' @param flat_tol Identifiability tolerance.
#' @param conf_level Confidence level.
#' @param seed Optional random seed.
#'
#' @return Named list of simulation outputs.
#' @export
mc_run_all <- function(scenarios,
                       n_vec = c(200L, 400L, 1000L),
                       B = 2000L,
                       flat_tol = 1e-3,
                       conf_level = 0.95,
                       seed = NULL) {
  if (!is.null(seed)) set.seed(seed)
  
  lapply(names(scenarios), function(sc_name) {
    sc <- scenarios[[sc_name]]
    
    interval_true_info <- cutoff_expand_interval_until_valid(
      theta = c(sc$theta0_true, sc$theta1_true),
      family0 = sc$family0,
      family1 = sc$family1,
      lambda0 = sc$lambda0,
      lambda1 = sc$lambda1,
      pi0 = sc$pi0,
      pi1 = sc$pi1,
      pad_init = 0,
      pad_step = 0.20,
      max_iter = 20L
    )
    
    ab_true <- c(a = interval_true_info$a, b = interval_true_info$b)
    
    res_true <- cutoff_optimal(
      sc$theta0_true, sc$theta1_true, sc$family0, sc$family1,
      sc$lambda0, sc$lambda1, sc$pi0, sc$pi1,
      interval = ab_true
    )
    c_true <- res_true$cutoff
    
    out_n <- lapply(n_vec, function(n) {
      mc_simulate_scenario(
        theta0_true = sc$theta0_true,
        theta1_true = sc$theta1_true,
        family0 = sc$family0,
        family1 = sc$family1,
        c_true = c_true,
        lambda0 = sc$lambda0,
        lambda1 = sc$lambda1,
        pi0 = sc$pi0,
        pi1 = sc$pi1,
        n0 = n %/% 2L,
        n1 = n %/% 2L,
        B = B,
        flat_tol = flat_tol,
        conf_level = conf_level
      )
    })
    names(out_n) <- paste0("n", n_vec)
    
    list(
      scenario_name = sc_name,
      c_true = c_true,
      results = out_n
    )
  }) |> stats::setNames(names(scenarios))
}