.inter_multiplier_weights <- function(design) {
  data <- design$data
  original <- data[[design$weights]]
  if (!is.null(design$psu)) {
    cluster_variables <- c(design$strata, design$psu)
    cluster_variables <- cluster_variables[!is.null(cluster_variables)]
    cluster_key <- .inter_key(data, cluster_variables)
    cluster_levels <- unique(cluster_key)
    multiplier_by_cluster <- stats::setNames(
      stats::rexp(length(cluster_levels)), cluster_levels
    )
    multiplier <- as.numeric(multiplier_by_cluster[cluster_key])
  } else {
    multiplier <- stats::rexp(nrow(data))
  }
  if (is.null(design$strata)) {
    multiplier <- multiplier * sum(original) /
      sum(original * multiplier)
  } else {
    strata_key <- as.character(data[[design$strata]])
    for (stratum in unique(strata_key)) {
      index <- strata_key == stratum
      denominator <- sum(original[index] * multiplier[index])
      if (denominator > 0) {
        multiplier[index] <- multiplier[index] *
          sum(original[index]) / denominator
      }
    }
  }
  original * multiplier
}

.inter_refit <- function(object, weights) {
  data <- object$design$data
  data$.inter_boot_weight <- weights
  design <- inter_design(
    data,
    weights = ".inter_boot_weight",
    area = object$design$area,
    strata = object$design$strata,
    psu = object$design$psu
  )
  fit_inter_sae(
    object$formula,
    design = design,
    margins = object$margins,
    family = object$family,
    domain = object$domain,
    prior = object$control$prior,
    max_iter = object$control$max_iter,
    tol = object$control$tol,
    residual_correction = object$control$residual_correction,
    max_cells = object$control$max_cells,
    model_args = object$control$model_args
  )
}

#' Bootstrap intersectional estimates
#'
#' @param object A fitted `inter_sae` object.
#' @param R Number of bootstrap replicates.
#' @param type `"multiplier"` or `"replicate"`. The latter uses columns named
#'   in `inter_design(..., replicate_weights=)`.
#' @param seed Random seed for multiplier bootstrap.
#' @param level Confidence level.
#' @param progress Print progress every ten replicates.
#' @return An object of class `inter_bootstrap`.
#' @export
inter_bootstrap <- function(object, R = 199L,
                            type = c("multiplier", "replicate"),
                            seed = 123, level = 0.95, progress = FALSE) {
  if (!inherits(object, "inter_sae")) {
    stop("`object` must be a fitted `inter_sae` object.", call. = FALSE)
  }
  type <- match.arg(type)
  if (!is.numeric(R) || length(R) != 1L || R < 2) {
    stop("`R` must be an integer of at least 2.", call. = FALSE)
  }
  R <- as.integer(R)
  if (!is.numeric(level) || length(level) != 1L || level <= 0 || level >= 1) {
    stop("`level` must lie strictly between 0 and 1.", call. = FALSE)
  }
  replicate_names <- object$design$replicate_weights
  if (type == "replicate") {
    if (is.null(replicate_names)) {
      stop("No replicate-weight columns were supplied to `inter_design()`.",
           call. = FALSE)
    }
    if (length(replicate_names) < 2L) {
      stop("At least two replicate-weight columns are required.",
           call. = FALSE)
    }
    R <- min(R, length(replicate_names))
  }

  old_seed <- if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) {
    get(".Random.seed", envir = .GlobalEnv, inherits = FALSE)
  } else {
    NULL
  }
  on.exit(.inter_restore_rng(old_seed), add = TRUE)
  if (type == "multiplier") set.seed(as.integer(seed))

  base <- object$estimates
  replicate_values <- matrix(NA_real_, nrow = nrow(base), ncol = R)
  failures <- character(0)
  for (r in seq_len(R)) {
    current_weights <- if (type == "multiplier") {
      .inter_multiplier_weights(object$design)
    } else {
      object$design$data[[replicate_names[r]]]
    }
    current <- try(.inter_refit(object, current_weights), silent = TRUE)
    if (inherits(current, "try-error")) {
      failures <- c(failures, as.character(current))
    } else {
      current_key <- .inter_key(current$estimates, object$domain)
      base_key <- .inter_key(base, object$domain)
      replicate_values[, r] <-
        current$estimates$estimate[match(base_key, current_key)]
    }
    if (isTRUE(progress) && (r %% 10L == 0L || r == R)) {
      message("Completed ", r, " of ", R, " bootstrap replicates")
    }
  }
  alpha <- (1 - level) / 2
  summary <- base[c(object$domain, "estimate")]
  summary$bootstrap_se <- apply(replicate_values, 1L, stats::sd, na.rm = TRUE)
  summary$lower <- apply(replicate_values, 1L, function(x) {
    if (sum(is.finite(x)) < 2L) return(NA_real_)
    as.numeric(stats::quantile(x, alpha, na.rm = TRUE, names = FALSE,
                               type = 8))
  })
  summary$upper <- apply(replicate_values, 1L, function(x) {
    if (sum(is.finite(x)) < 2L) return(NA_real_)
    as.numeric(stats::quantile(x, 1 - alpha, na.rm = TRUE, names = FALSE,
                               type = 8))
  })
  summary$successful_replicates <- rowSums(is.finite(replicate_values))

  structure(
    list(
      summary = summary,
      replicates = replicate_values,
      type = type,
      requested = R,
      level = level,
      failures = failures
    ),
    class = "inter_bootstrap"
  )
}

#' @export
print.inter_bootstrap <- function(x, ...) {
  cat("interSAE bootstrap inference\n")
  cat("  Type: ", x$type, "\n", sep = "")
  cat("  Requested replicates: ", x$requested, "\n", sep = "")
  cat("  Completely failed fits: ", length(x$failures), "\n", sep = "")
  print(x$summary, row.names = FALSE)
  invisible(x)
}

#' Summarize available uncertainty components
#'
#' @param object A fitted `inter_sae` object.
#' @param bootstrap Optional result from [inter_bootstrap()].
#' @param bounds Optional single-domain result from
#'   [identification_bounds()].
#' @return A data frame. Bootstrap refitting combines sampling and fitted-model
#'   variation; identification width is reported separately.
#' @export
decompose_uncertainty <- function(object, bootstrap = NULL, bounds = NULL) {
  if (!inherits(object, "inter_sae")) {
    stop("`object` must be a fitted `inter_sae` object.", call. = FALSE)
  }
  out <- object$estimates[c(object$domain, "estimate")]
  out$sampling_model_se <- NA_real_
  out$bootstrap_lower <- NA_real_
  out$bootstrap_upper <- NA_real_
  if (!is.null(bootstrap)) {
    if (!inherits(bootstrap, "inter_bootstrap")) {
      stop("`bootstrap` must be returned by `inter_bootstrap()`.",
           call. = FALSE)
    }
    out$sampling_model_se <- bootstrap$summary$bootstrap_se
    out$bootstrap_lower <- bootstrap$summary$lower
    out$bootstrap_upper <- bootstrap$summary$upper
  }
  out$identification_lower <- NA_real_
  out$identification_upper <- NA_real_
  out$identification_width <- NA_real_
  if (!is.null(bounds)) {
    if (!inherits(bounds, "inter_bounds")) {
      stop("`bounds` must be returned by `identification_bounds()`.",
           call. = FALSE)
    }
    selected <- .inter_match_rows(out, bounds$domain)
    if (sum(selected) != 1L) {
      stop("The bounds domain must identify exactly one output row.",
           call. = FALSE)
    }
    out$identification_lower[selected] <- bounds$lower
    out$identification_upper[selected] <- bounds$upper
    out$identification_width[selected] <- bounds$upper - bounds$lower
  }
  out
}
