#' Confidence intervals for regional GEV parameters
#'
#' @name Reg_parCI
#' @param add_data
#' A numeric matrix of air temperature data as calculated by `Dataset_add()`.
#' @param model
#' A single integer number from 1 to 4 defining the GEV model.
#' May be provided by `Best_model()`.
#' @param reg_par
#' A 5-column and 1-row data.frame or matrix as generated by `Reg_par()`.
#' * 1st column is the mu0 parameter,
#' * 2nd is the mu1 parameter,
#' * 3rd is the sigma0 parameter,
#' * 4th is the sigma1 parameter,
#' * 5th is the shape parameter.
#' @param n.boots
#' A single number describing the number of bootstrap replicates.
#' Whenever possible, `n.boots` should be set to 999 (default),
#' as suggested by Burn (2003) <10.1623/hysj.48.1.25.43485>
#' and O'Brien and Burn (2014) <10.1016/j.jhydrol.2014.09.041>.
#' @param progress
#' Logical scalar controlling whether a progress bar is displayed.
#' `TRUE` forces the bar on, `FALSE` forces it off, and
#' `NULL` (default) defers to `getOption("NSTempRFA.progress")`,
#' which itself falls back to `interactive()`. Set
#' `options(NSTempRFA.progress = FALSE)` to suppress the bar globally.
#'
#' @returns
#' A matrix containing the 95% confidence intervals (lower and upper bounds)
#' of the time-varying parameter estimates. The spatial dependence between
#' sites is preserved.
#'
#' @export
#' @importFrom stats quantile
#' @importFrom utils txtProgressBar setTxtProgressBar
#'
#' @examplesIf interactive()
#' add.data <- Dataset_add(TmaxCPC_SP)
#' best.parms <- Best_model(add.data = add.data$add_data)
#' regional.parms <- Reg_par(best_model = best.parms$atsite.models)
#'
#' Reg_parCI(
#'   add_data  = add.data$add_data,
#'   model     = best.parms$best,
#'   reg_par   = regional.parms,
#'   n.boots   = 100
#' )
Reg_parCI <- function(
    add_data,
    model,
    reg_par,
    n.boots = 999,
    progress = NULL
) {

  # ============================================================
  # Input checks
  # ============================================================

  check_model(model)
  check_n.boots(n.boots)

  add_data <- check_add_data(add_data)
  reg_par <- check_reg_par(reg_par)

  max_time <- nrow(add_data)

  # ============================================================
  # Construct temporal parameters
  # ============================================================

  time <- seq_len(max_time)

  par.temporal <- matrix(NA_real_, max_time, 3)

  par.temporal[, 1] <- reg_par[1] + reg_par[2] * time
  par.temporal[, 2] <- reg_par[3] + reg_par[4] * time
  par.temporal[, 3] <- reg_par[5]

  if (any(par.temporal[, 2] <= 0)) {
    stop(
      "Time-varying scale parameter became non-positive.",
      call. = FALSE
    )
  }

  # ============================================================
  # Transform to Gumbel space
  # ============================================================

  mu_vec <- par.temporal[, 1]
  sigma_vec <- par.temporal[, 2]
  xi <- reg_par[5]

  z <-
    1 +
    xi *
    sweep(
      sweep(add_data, 1, mu_vec, "-"),
      1,
      sigma_vec,
      "/"
    )

  if (any(z <= 0, na.rm = TRUE)) {
    stop(
      "Invalid transformed values encountered.",
      call. = FALSE
    )
  }

  IDD.series <- (1 / xi) * log(z)

  # ============================================================
  # Bootstrap setup
  # ============================================================

  sigma_over_xi <- sigma_vec / xi

  reg_par.overall.boot <-
    matrix(
      NA_real_,
      n.boots,
      5
    )

  message("This calculation may take some time.")

  show_pb <- use_progress_bar(progress)

  if (show_pb) {
    pb <- utils::txtProgressBar(
      min = 0,
      max = n.boots,
      style = 3
    )
  }

  # ============================================================
  # Bootstrap loop
  # ============================================================

  for (r in seq_len(n.boots)) {

    rows <- sample.int(
      max_time,
      size = max_time,
      replace = TRUE
    )

    resampled_IDD <-
      IDD.series[rows, , drop = FALSE]

    back.orig <-
      sweep(
        sigma_over_xi *
          (exp(resampled_IDD * xi) - 1),
        1,
        mu_vec,
        "+"
      )

    fit.boot <-
      tryCatch(
        Fit_model(
          temperatures = back.orig,
          model = model
        ),
        error = function(e) NULL
      )

    if (!is.null(fit.boot)) {

      reg_par.overall.boot[r, ] <-
        tryCatch(
          as.numeric(
            Reg_par(fit.boot)
          ),
          error = function(e) rep(NA_real_, 5)
        )
    }

    if (show_pb) {
      utils::setTxtProgressBar(pb, r)
    }
  }

  if (show_pb) {
    close(pb)
  }

  # ============================================================
  # Confidence intervals
  # ============================================================

  CI_lower <-
    apply(
      reg_par.overall.boot,
      2,
      quantile,
      probs = 0.025,
      na.rm = TRUE
    )

  CI_upper <-
    apply(
      reg_par.overall.boot,
      2,
      quantile,
      probs = 0.975,
      na.rm = TRUE
    )

  CI_matrix <-
    rbind(
      CI_lower,
      CI_upper
    )

  rownames(CI_matrix) <-
    c(
      "Lower 95% CI",
      "Upper 95% CI"
    )

  colnames(CI_matrix) <-
    paste0(
      "weighted_",
      c(
        "mu0",
        "mu1",
        "sigma0",
        "sigma1",
        "shape"
      )
    )

  return(CI_matrix)
}
