R/chi.R

In eFCM: Exponential Factor Copula Model

#' Tail Dependence Coefficient (Chi Statistic)
#'
#' Compute the conditional exceedance probability \eqn{\chi_h(u)},
#' either from a fitted eFCM model (\code{\link{chi.fcm}}) or empirically (\code{\link{Echi}}).
#' \eqn{\chi_h(u)} measures the probability of simultaneous exceedances at high but finite thresholds.
#'
#' @name chi
#' @rdname chi
#' @section Methods:
#' - `chi.fcm()`: Model-based estimate from an object of class `"fcm"`.
#' - `Echi()`: Empirical estimate.
#'
#' @param object an object of class `"fcm"`, created by [fcm()].
#' @param h a positive numeric value representing the spatial distance (in kilometers).
#' @param u a numeric value between 0 and 1 specifying the quantile threshold. Default is 0.95.
#' @param ... currently ignored.
#'
#' @return A named numeric value, the chi statistic for given `h` and `u`.
#'
#' @details
#' For two locations \eqn{s_1} and \eqn{s_2} separated by distance \eqn{h},
#' with respective vector components \eqn{W(s_1)} and \eqn{W(s_2)},
#' the conditional exceedance probability is defined as
#' \deqn{ \chi_h(u) \;=\; \lim_{u \to 1} \Pr\!\big( F_{s_1}(W(s_1)) > u \;\mid\; F_{s_2}(W(s_2)) > u \big). }
#' For the eFCM, the conditional exceedance probability \eqn{\chi_{\mathrm{eFCM}}(u)}
#' can be computed as
#' \deqn{
#' \chi_{\mathrm{eFCM}}(u) =
#' \frac{1 - 2u + \Phi_2\big(z(u), z(u); \rho\big)
#' - 2 \exp\!\left( \frac{\lambda^2}{2} - \lambda\, z(u)\, \Phi_2\big(q; 0, \Omega\big) \right)}
#' {1 - u}.
#' }
#' Here, \eqn{z(u) = F_1^{-1}(u; \lambda)} is the marginal quantile function,
#' \eqn{\Phi_2(\cdot,\cdot;\rho)} denotes the bivariate standard normal CDF with correlation \eqn{\rho},
#' \eqn{q = \lambda(1-\rho)}, and \eqn{\Omega} is the correlation matrix.
#'
#' @references
#' Castro-Camilo, D. and Huser, R. (2020).
#' Local likelihood estimation of complex tail dependence structures,
#' applied to US precipitation extremes.
#' *Journal of the American Statistical Association*, 115(531), 1037–1054.
#'
#' @examples
#' \donttest{
#' fit <- fcm(...)
#' chi(fit, h = 150, u = 0.95)
#' }
#'
#' @srrstats {G1.0, G1.5, G2.1, G2.2, G2.6, G2.10}
#' @method chi fcm
#' @export
chi.fcm <- function(object, h, u = 0.95, ...) {
  stopifnot(inherits(object, "fcm"))
  if (!is.numeric(h) || length(h) != 1 || h <= 0)
    stop("`h` must be a single positive number.")
  if (!is.numeric(u) || length(u) != 1 || u <= 0 || u >= 1)
    stop("`u` must be a scalar in (0, 1).")

  lbda  <- object$par[1]
  delta <- object$par[2]

  chi <- chi_fcm(h, u, lbda, delta, nu = object$arg$nu)
  names(chi) <- "chi"
  chi
}
#' @export
chi <- function(object, ...) {
  UseMethod("chi")
}
#' @rdname chi
#' @export
#' @param which A length-two integer vector giving the indices of the
#'   columns in \code{object$data} to be used for the empirical
#'   chi calculation.
Echi <- function(object, which = c(1, 2), u = 0.95) {
  stopifnot(inherits(object, "fcm"))
  stopifnot(length(which) == 2)
  stopifnot(length(u) == 1, u > 0, u < 1)

  dt <- object$data[, which]
  ranks <- apply(dt, 2, rank)
  d <- ncol(ranks)
  n <- nrow(ranks)
  k <- n * (1 - u)
  chiu <- 2 - ecGeneral(ranks, d, as.double(rep(1, d)), n, k, double(1))
  names(chiu) <- "Echi"
  return(chiu)
}