#' Run the Nested Particle Filter for a stochastic SEIR model
#'
#' Performs online Bayesian joint state and parameter estimation for the
#' stochastic SEIR model with latent Ornstein-Uhlenbeck transmission dynamics,
#' using the nested particle filter (NPF) of Crisan and Miguez (2018).
#'
#' @param observations Numeric vector of length \eqn{T}. Daily confirmed case
#'   counts \eqn{P_1, \ldots, P_T}.
#' @param fixed Named list of fixed model parameters (see \code{\link{seir_simulate}}).
#' @param K Integer. Number of outer (parameter) particles. Default 100.
#' @param M Integer. Number of inner (state) particles per outer particle.
#'   Default 200.
#' @param tau_outer Numeric in (0,1). ESS threshold for outer resampling.
#'   Outer resampling is triggered when
#'   \eqn{\mathrm{ESS}_\mathrm{outer} < \tau_\mathrm{outer} \cdot K}.
#'   Default 0.3.
#' @param x0 Numeric vector of length 5, or \code{NULL}. Initial state
#'   \eqn{(S_0, E_0, I_0, R_0, \Psi_0)}.  If \code{NULL}, derived from
#'   \code{observations[1]} via quasi-steady-state initialization; in that
#'   case the first observation is used only for initialization and excluded
#'   from the filtering updates.
#' @param seed Integer or \code{NULL}. Random seed for reproducibility.
#' @param h_min,h_max,rho Jittering bandwidth schedule parameters. The
#'   bandwidth at step \eqn{n} is
#'   \eqn{h_n = h_{min} + (h_{max} - h_{min}) \rho^n}.
#'   Defaults: \code{h_min = 0.01}, \code{h_max = 0.10}, \code{rho = 0.995}.
#' @param verbose Logical. Print progress every 50 steps. Default \code{FALSE}.
#'
#' @return An object of class \code{"npf_seir"}, a list with components:
#' \describe{
#'   \item{\code{Rt_mean}, \code{Rt_lo}, \code{Rt_hi}}{Numeric vectors of
#'     length \eqn{T}. Posterior mean and 95\% credible interval for
#'     \eqn{R_t = \beta_t S_t / ((\gamma+\delta)N)}.}
#'   \item{\code{beta_mean}, \code{beta_lo}, \code{beta_hi}}{Posterior
#'     summaries for \eqn{\beta_t}.}
#'   \item{\code{theta_mean}}{Matrix of size \eqn{T \times 3}. Weighted
#'     posterior mean of \eqn{\theta = (\kappa, \sigma_\Psi, \mu_\Psi)} at
#'     each step.}
#'   \item{\code{final_theta}}{Matrix \eqn{K \times 3}. Outer particles at
#'     time \eqn{T}.}
#'   \item{\code{final_w}}{Numeric vector of length \eqn{K}. Outer weights
#'     at time \eqn{T}.}
#'   \item{\code{final_inner}}{List of length \eqn{K}. Final inner state
#'     particles used for posterior predictive simulation.}
#'   \item{\code{outer_ess}}{Numeric vector of length \eqn{T}. Outer ESS
#'     trace.}
#'   \item{\code{observations}, \code{fixed}, \code{call}}{Input metadata.}
#' }
#'
#' @references
#' Crisan, D. and Miguez, J. (2018). Nested particle filters for online
#' parameter estimation in discrete-time state-space Markov models.
#' \emph{Bernoulli}, 24(4A):3039--3086.
#'
#' Feng, W. and Wang, W. (2025). Bayesian sequential inference for a stochastic SEIR model
#' with latent transmission dynamics. \emph{Preprint}.
#'
#' @export
#' @examples
#' \donttest{
#' # Simulate and recover
#' fixed <- list(eps = 1/5, gamma = 1/10, delta = 1/(70*365),
#'               b = 1/(70*365), q = 0.3, N = 1e6, sigma_comp = 0.01)
#' x0    <- c(1e6 - 100, 50, 50, 0, log(0.25))
#' set.seed(1)
#' traj  <- seir_simulate(200, kappa=0.05, sigma_psi=0.10,
#'                        mu_psi=log(0.25), x0=x0, fixed=fixed)
#' fit   <- npf_seir(traj$obs[-1], fixed=fixed, K=50, M=100, seed=42)
#' plot(fit)
#' summary(fit)
#' }
npf_seir <- function(observations,
                     fixed,
                     K         = 100L,
                     M         = 200L,
                     tau_outer = 0.3,
                     x0        = NULL,
                     seed      = NULL,
                     h_min     = 0.01,
                     h_max     = 0.10,
                     rho       = 0.995,
                     verbose   = FALSE) {

  cl <- match.call()
  if (!is.null(seed)) set.seed(seed)

  n_obs <- length(observations)
  N <- fixed$N

  # -- Initialise outer particles ---------------------------------------------
  thetas  <- .sample_prior(K)          # K x 3
  outer_w <- rep(1/K, K)

  # -- Initialise inner particles ---------------------------------------------
  obs_used_for_init <- FALSE
  if (is.null(x0)) {
    obs_used_for_init <- TRUE
    E0 <- max(observations[1] / (fixed$q * fixed$eps), 1)
    I0 <- E0 * fixed$eps / (fixed$gamma + fixed$delta)
    x0 <- c(N - E0 - I0, E0, I0, 0, log(0.3))
  }

  init_noise_sd <- c(100, 10, 10, 0, 0.1)
  inner <- lapply(seq_len(K), function(k) {
    s0       <- matrix(x0, M, 5, byrow = TRUE) +
                matrix(rnorm(M * 5) * rep(init_noise_sd, each = M), M, 5)
    s0[, 1:4] <- pmax(s0[, 1:4], 0)
    s0
  })

  # -- Output storage ---------------------------------------------------------
  beta_mean  <- rep(NA_real_, n_obs); beta_lo  <- rep(NA_real_, n_obs); beta_hi  <- rep(NA_real_, n_obs)
  Rt_mean    <- rep(NA_real_, n_obs); Rt_lo    <- rep(NA_real_, n_obs); Rt_hi    <- rep(NA_real_, n_obs)
  theta_mean <- matrix(NA_real_, n_obs, 3, dimnames = list(NULL, c("kappa","sigma_psi","mu_psi")))
  outer_ess  <- rep(NA_real_, n_obs)

  n_start <- if (obs_used_for_init) 2L else 1L   # 1-indexed observations

  # -- Main NPF recursion -----------------------------------------------------
  for (n in seq(n_start, n_obs)) {
    obs_n    <- observations[n]
    log_marg <- numeric(K)

    # Step 1: inner filter update
    for (k in seq_len(K)) {

      # (a) Propagate
      inner[[k]] <- .propagate_inner(inner[[k]], thetas[k, ], fixed)

      # (b) Log-likelihood + log-sum-exp marginal likelihood
      ll      <- .log_lik(inner[[k]], obs_n, fixed)
      ll_max  <- max(ll)
      w_unnorm <- exp(ll - ll_max)
      w_sum   <- sum(w_unnorm)

      if (w_sum < 1e-300) {
        log_marg[k] <- -1e10
        w_norm      <- rep(1/M, M)
      } else {
        log_marg[k] <- log(w_sum / M) + ll_max
        w_norm      <- w_unnorm / w_sum
      }

      # (c) Unconditional inner resampling (Section 3.3)
      idx        <- .systematic_resample(w_norm)
      inner[[k]] <- inner[[k]][idx, , drop = FALSE]
    }

    # Step 2: outer weight update
    log_marg <- log_marg - max(log_marg)
    outer_w  <- outer_w * exp(log_marg)
    w_sum_out <- sum(outer_w)
    outer_w   <- if (w_sum_out < 1e-300) rep(1/K, K) else outer_w / w_sum_out

    ess_out      <- 1 / sum(outer_w^2)
    outer_ess[n] <- ess_out

    # Posterior summaries
    all_psi <- do.call(rbind, lapply(inner, function(s) s[, 5]))  # K x M
    all_S   <- do.call(rbind, lapply(inner, function(s) s[, 1]))
    flat_w  <- as.vector(outer_w %o% rep(1/M, M))  # length K*M
    flat_psi <- as.vector(all_psi)
    flat_S   <- as.vector(all_S)

    bsamp <- exp(flat_psi)
    rsamp <- bsamp * flat_S / ((fixed$gamma + fixed$delta) * N)

    bq <- .wquantile(bsamp, flat_w)
    rq <- .wquantile(rsamp, flat_w)

    beta_mean[n] <- sum(flat_w * bsamp)
    beta_lo[n]   <- bq[1]; beta_hi[n] <- bq[3]
    Rt_mean[n]   <- sum(flat_w * rsamp)
    Rt_lo[n]     <- rq[1]; Rt_hi[n]   <- rq[3]

    theta_mean[n, ] <- colSums(thetas * outer_w)

    # Step 3: outer resampling + jittering
    if (ess_out < tau_outer * K) {
      idx    <- .systematic_resample(outer_w)
      thetas <- thetas[idx, , drop = FALSE]
      inner  <- inner[idx]
      h      <- .bandwidth(n - 1L, h_min, h_max, rho)
      for (k in seq_len(K))
        thetas[k, ] <- .jitter_theta(thetas[k, ], h)
      outer_w <- rep(1/K, K)
    }

    if (verbose && (n %% 50 == 0))
      message(sprintf("  Step %d/%d  outer ESS = %.1f", n, n_obs, ess_out))
  }

  structure(
    list(
      Rt_mean    = Rt_mean,   Rt_lo    = Rt_lo,   Rt_hi    = Rt_hi,
      beta_mean  = beta_mean, beta_lo  = beta_lo, beta_hi  = beta_hi,
      theta_mean = theta_mean,
      final_theta = thetas,
      final_w     = outer_w,
      final_inner = inner,
      outer_ess   = outer_ess,
      observations = observations,
      fixed        = fixed,
      K = K, M = M,
      call = cl
    ),
    class = "npf_seir"
  )
}
