#' Pairwise Hilbert-Schmidt Independence Criterion
#'
#' Computes pairwise kernel dependence measures for the numeric columns of a
#' matrix or data frame using the Hilbert-Schmidt Independence Criterion
#' (HSIC). By default, `hsic()` returns a normalised kernel independence
#' correlation in `[0, 1]`, analogous to a distance-correlation matrix.
#'
#' @param data A numeric matrix or data frame with at least two numeric columns.
#'   Non-numeric columns are dropped.
#' @param kernel Kernel used to build univariate Gram matrices. Supported
#'   options are `"gaussian"` (RBF), `"linear"`, `"laplace"`, and
#'   `"polynomial"`.
#' @param bandwidth Bandwidth rule for Gaussian and Laplace kernels.
#'   `"median"` uses the upper median of finite off-diagonal pairwise
#'   distances divided by \eqn{\sqrt{2}}, with fallback `0.001` for degenerate
#'   columns. `"silverman"` uses Silverman's univariate rule, and `"scott"`
#'   uses Scott's univariate rule. Linear and polynomial kernels ignore this
#'   argument.
#' @param normalise Logical. If `TRUE`, return the normalised kernel
#'   independence correlation. If `FALSE`, return raw HSIC.
#' @param estimator HSIC estimator. `"biased"` uses the stable V-statistic
#'   \eqn{n^{-2}\mathrm{tr}(KHLH)}. `"unbiased"` uses the U-statistic estimator
#'   with zero diagonal Gram matrices and requires at least four complete
#'   observations per pair.
#' @param na_method Missing-data handling. `"error"` rejects missing, `NaN`, and
#'   infinite values; `"complete"` performs one listwise finite-row deletion;
#'   `"pairwise"` recomputes each pair on its pairwise complete rows.
#' @param p_value Logical. If `TRUE`, attach permutation p-values for the HSIC
#'   independence test.
#' @param B Positive integer. Number of permutations used when
#'   `p_value = TRUE`.
#' @param seed Optional positive integer seed for reproducible permutation
#'   inference. The seed is passed to the C++ permutation engine and does not
#'   mutate the user's global R RNG state.
#' @param n_threads Integer \eqn{\geq 1}. Number of OpenMP threads. Defaults to
#'   `getOption("matrixCorr.threads", 1L)`.
#' @param output Output representation: `"matrix"`, `"sparse"`, or
#'   `"edge_list"`.
#' @param threshold Non-negative absolute-value filter for non-matrix outputs.
#'   Must be `0` when `output = "matrix"`.
#' @param diag Logical; whether to include diagonal entries in sparse and
#'   edge-list outputs.
#'
#' @details
#' For paired observations \eqn{(x_i, y_i)}, HSIC measures the squared
#' Hilbert-Schmidt norm of the RKHS cross-covariance operator. With centred Gram
#' matrices \eqn{K_c = HKH} and \eqn{L_c = HLH}, the biased empirical estimator
#' is
#' \deqn{
#'   \widehat{\mathrm{HSIC}}_b =
#'   \frac{1}{n^2}\mathrm{tr}(KHLH)
#'   =
#'   \frac{1}{n^2}\sum_{ij} (K_c)_{ij}(L_c)_{ij}.
#' }
#'
#' With `normalise = TRUE`, the returned matrix contains the kernel
#' independence correlation
#' \deqn{
#'   \widehat{\mathrm{kCor}}(X,Y) =
#'   \frac{\widehat{\mathrm{HSIC}}(X,Y)}
#'        {\sqrt{\widehat{\mathrm{HSIC}}(X,X)
#'               \widehat{\mathrm{HSIC}}(Y,Y)}}.
#' }
#' The raw HSIC matrix is stored in `attr(x, "hsic_raw")`. When
#' `estimator = "unbiased"`, raw HSIC can be slightly negative in finite
#' samples; these signed raw values are retained in `hsic_raw`, while the
#' displayed normalised coefficient is clipped only for the user-facing matrix.
#'
#' Kernel formulas are:
#' Gaussian \eqn{\exp(-|x_i - x_j|^2 / (2\sigma^2))}, Laplace
#' \eqn{\exp(-|x_i - x_j| / \sigma)}, linear \eqn{x_i x_j}, and polynomial
#' \eqn{(x_i x_j + 1)^2}. For `bandwidth = "median"`, \eqn{\sigma} is the
#' upper median of \eqn{\{|x_i - x_j|: i < j\}} divided by \eqn{\sqrt{2}}; if
#' this is non-finite or non-positive, \eqn{\sigma = 0.001}.
#'
#' For `p_value = TRUE`, the test statistic is the raw HSIC estimate. The null
#' distribution is generated by permuting one variable within each pair, and the
#' p-value is \eqn{(1 + \#\{T_b \geq T_{\mathrm{obs}}\})/(B + 1)}. This is an
#' \eqn{O(B n^2)} pairwise procedure and can be expensive for large matrices or
#' large `B`.
#'
#' The polynomial kernel currently uses the fixed form
#' \eqn{(x_i x_j + 1)^2}. More polynomial controls can be added later without
#' changing the main HSIC object contract.
#'
#' @return A matrix-like correlation result. With `normalise = TRUE`, entries
#'   are normalised kernel independence correlations and the diagonal is `1`
#'   when the variable has positive kernel self-dependence. With
#'   `normalise = FALSE`, entries are raw HSIC estimates. Attributes record the
#'   kernel, bandwidth rule, estimator, raw HSIC matrix, diagnostics, and
#'   optional permutation inference.
#'
#' @references
#' Gretton, A., Bousquet, O., Smola, A., & Schoelkopf, B. (2005).
#' Measuring statistical dependence with Hilbert-Schmidt norms.
#' \emph{Algorithmic Learning Theory}.
#'
#' Gretton, A., Fukumizu, K., Teo, C. H., Song, L., Schoelkopf, B., & Smola,
#' A. J. (2007). A kernel statistical test of independence.
#' \emph{Advances in Neural Information Processing Systems}.
#'
#' Gretton, A., Bousquet, O., Smola, A., & Schoelkopf, B. (2005).
#' Kernel methods for measuring independence.
#' \emph{Journal of Machine Learning Research}, 6, 2075-2129.
#'
#' Pfister, N., Buhlmann, P., Scholkopf, B., & Peters, J. (2018).
#' Kernel-based tests for joint independence.
#' \emph{Journal of the Royal Statistical Society: Series B}, 80(1), 5-31.
#'
#' @examples
#' set.seed(1)
#' x <- rnorm(200)
#' y <- rnorm(200)
#' H0 <- hsic(cbind(x = x, y = y))
#' H0
#'
#' set.seed(2)
#' x <- rnorm(200)
#' y <- x^2 + rnorm(200, sd = 0.1)
#' H1 <- hsic(cbind(x = x, y = y))
#' H1
#'
#' set.seed(3)
#' X <- cbind(a = rnorm(80), b = rnorm(80), c = rnorm(80))
#' H_perm <- hsic(X, p_value = TRUE, B = 19, seed = 1)
#' summary(H_perm)
#' estimate(H_perm)
#' tidy(H_perm)
#'
#' @author Thiago de Paula Oliveira
#' @export
hsic <- function(data,
                 kernel = c("gaussian", "linear", "laplace", "polynomial"),
                 bandwidth = c("median", "silverman", "scott"),
                 normalise = TRUE,
                 estimator = c("biased", "unbiased"),
                 na_method = c("error", "pairwise", "complete"),
                 p_value = FALSE,
                 B = 499L,
                 seed = NULL,
                 n_threads = getOption("matrixCorr.threads", 1L),
                 output = c("matrix", "sparse", "edge_list"),
                 threshold = 0,
                 diag = TRUE) {
  if (
    is.matrix(data) &&
      is.numeric(data) &&
      (missing(kernel) || identical(kernel, "gaussian")) &&
      (missing(bandwidth) || identical(bandwidth, "median")) &&
      (missing(estimator) || identical(estimator, "biased")) &&
      (missing(na_method) || identical(na_method, "error")) &&
      !isTRUE(normalise) &&
      !isTRUE(p_value) &&
      (missing(output) || identical(output, "matrix")) &&
      isTRUE(threshold == 0) &&
      isTRUE(diag)
  ) {
    numeric_data <- validate_corr_input(data, check_na = TRUE)
    colnames_data <- colnames(numeric_data)
    if (is.null(colnames_data)) {
      colnames_data <- paste0("V", seq_len(ncol(numeric_data)))
    }
    return(hsic_raw_biased_matrix_object_cpp(
      numeric_data,
      kernel_code = 0L,
      bandwidth_code = 0L,
      kernel = "gaussian",
      bandwidth = "median",
      names = colnames_data
    ))
  }

  kernel <- match_arg(
    kernel,
    values = c("gaussian", "linear", "laplace", "polynomial"),
    arg_name = "kernel"
  )
  bandwidth <- match_arg(
    bandwidth,
    values = c("median", "silverman", "scott"),
    arg_name = "bandwidth"
  )
  estimator <- match_arg(
    estimator,
    values = c("biased", "unbiased"),
    arg_name = "estimator"
  )
  na_method <- match_arg(
    na_method,
    values = c("error", "pairwise", "complete"),
    arg_name = "na_method"
  )
  check_bool(normalise, arg = "normalise")
  check_bool(p_value, arg = "p_value")
  if (isTRUE(p_value)) {
    B <- check_scalar_int_pos(B, arg = "B")
    if (!is.null(seed)) {
      seed <- check_scalar_int_pos(seed, arg = "seed")
    }
  }
  output_cfg <- .mc_validate_output_args(
    output = output,
    threshold = threshold,
    diag = diag
  )

  kernel_code <- match(kernel, c("gaussian", "linear", "laplace", "polynomial")) - 1L
  bandwidth_code <- match(bandwidth, c("median", "silverman", "scott")) - 1L
  estimator_code <- match(estimator, c("biased", "unbiased")) - 1L

  if (
    identical(na_method, "error") &&
      !isTRUE(normalise) &&
      identical(estimator, "biased") &&
      !isTRUE(p_value) &&
      identical(output_cfg$output, "matrix") &&
      identical(output_cfg$threshold, 0) &&
      isTRUE(output_cfg$diag) &&
      is.matrix(data) &&
      is.numeric(data) &&
      nrow(data) >= 2L &&
      ncol(data) >= 2L
  ) {
    numeric_data <- validate_corr_input(data, check_na = TRUE)
    colnames_data <- colnames(numeric_data)
    if (is.null(colnames_data)) {
      colnames_data <- paste0("V", seq_len(ncol(numeric_data)))
    }
    return(hsic_raw_biased_matrix_object_cpp(
      numeric_data,
      kernel_code = kernel_code,
      bandwidth_code = bandwidth_code,
      kernel = kernel,
      bandwidth = bandwidth,
      names = colnames_data
    ))
  }

  numeric_data <- validate_corr_input(
    data,
    check_na = identical(na_method, "error")
  )
  min_n <- if (identical(estimator, "unbiased")) 4L else 2L
  diagnostics_extra <- NULL
  if (identical(na_method, "complete")) {
    cc <- .mc_complete_case_matrix(numeric_data, min_n = min_n, arg = "data")
    numeric_data <- cc$data
    diagnostics_extra <- cc$diagnostics
  }

  colnames_data <- colnames(numeric_data)
  dn <- .mc_square_dimnames(colnames_data)

  prev_threads <- .mc_prepare_omp_threads(
    n_threads
  )
  if (!is.null(prev_threads)) {
    on.exit(.mc_exit_omp_threads(prev_threads), add = TRUE)
  }

  pairwise_needed <- isTRUE(p_value) || identical(na_method, "pairwise") || isTRUE(normalise)
  if (isTRUE(pairwise_needed)) {
    pairwise <- hsic_matrix_pairwise_cpp(
      numeric_data,
      kernel_code = kernel_code,
      bandwidth_code = bandwidth_code,
      normalise = isTRUE(normalise),
      estimator_code = estimator_code,
      return_inference = isTRUE(p_value),
      B = if (isTRUE(p_value)) as.integer(B) else 1L,
      seed = if (is.null(seed)) NULL else as.integer(seed)
    )
    hsic_matrix <- pairwise$est
    raw_hsic <- pairwise$raw
    diagnostics <- list(
      n_complete = .mc_set_matrix_dimnames(unclass(pairwise$n_complete), colnames_data)
    )
    inference_attr <- if (isTRUE(p_value)) {
      list(
        method = "hsic_permutation_test",
        statistic = .mc_set_matrix_dimnames(unclass(pairwise$raw), colnames_data),
        p_value = .mc_set_matrix_dimnames(unclass(pairwise$p_value), colnames_data),
        B = as.integer(B),
        alternative = "greater"
      )
    } else {
      NULL
    }
  } else {
    hsic_matrix <- hsic_matrix_cpp(
      numeric_data,
      kernel_code = kernel_code,
      bandwidth_code = bandwidth_code,
      normalise = FALSE,
      estimator_code = estimator_code
    )
    raw_hsic <- hsic_matrix
    diagnostics <- NULL
    inference_attr <- NULL
  }

  diagnostics <- .mc_merge_diagnostics(diagnostics, diagnostics_extra)
  hsic_matrix <- .mc_set_matrix_dimnames(unclass(hsic_matrix), colnames_data)
  raw_hsic <- .mc_set_matrix_dimnames(unclass(raw_hsic), colnames_data)

  out <- .mc_structure_corr_matrix(
    hsic_matrix,
    class_name = "hsic",
    method = if (isTRUE(normalise)) {
      "kernel_independence_correlation"
    } else {
      "hsic"
    },
    description = if (isTRUE(normalise)) {
      "Pairwise normalised Hilbert-Schmidt independence criterion"
    } else {
      "Pairwise raw Hilbert-Schmidt independence criterion"
    },
    symmetric = TRUE,
    diagnostics = diagnostics,
    dimnames = dn,
    classes = c("hsic", "matrixCorr_dependence", "matrix"),
    extra_attrs = c(
      list(
        kernel = kernel,
        bandwidth = bandwidth,
        estimator = estimator,
        normalise = isTRUE(normalise),
        hsic_raw = raw_hsic
      ),
      if (!is.null(inference_attr)) list(inference = inference_attr) else list()
    )
  )

  .mc_finalize_corr_output_fast(
    out,
    output = output_cfg$output,
    threshold = output_cfg$threshold,
    diag = output_cfg$diag
  )
}

.mc_hsic_inference_attr <- function(x) {
  attr(x, "inference", exact = TRUE)
}

.mc_hsic_pairwise_summary <- function(object,
                                      digits = 4,
                                      p_digits = 4) {
  check_inherits(object, "hsic")
  est <- as.matrix(object)
  rn <- rownames(est)
  cn <- colnames(est)
  if (is.null(rn)) rn <- as.character(seq_len(nrow(est)))
  if (is.null(cn)) cn <- as.character(seq_len(ncol(est)))

  inf <- .mc_hsic_inference_attr(object)
  diag_attr <- attr(object, "diagnostics", exact = TRUE)
  raw <- attr(object, "hsic_raw", exact = TRUE)

  n_pairs <- nrow(est) * (ncol(est) - 1L) / 2L
  var1 <- character(n_pairs)
  var2 <- character(n_pairs)
  estimate <- numeric(n_pairs)
  hsic_raw <- numeric(n_pairs)
  n_complete <- if (is.list(diag_attr) && is.matrix(diag_attr$n_complete)) integer(n_pairs) else NULL
  p_value <- if (is.list(inf)) numeric(n_pairs) else NULL

  k <- 0L
  for (i in seq_len(nrow(est) - 1L)) {
    for (j in (i + 1L):ncol(est)) {
      k <- k + 1L
      var1[k] <- rn[i]
      var2[k] <- cn[j]
      estimate[k] <- round(est[i, j], digits)
      hsic_raw[k] <- if (is.matrix(raw)) round(raw[i, j], digits) else NA_real_
      if (!is.null(n_complete)) n_complete[k] <- as.integer(diag_attr$n_complete[i, j])
      if (!is.null(p_value)) {
        p_value[k] <- if (is.matrix(inf$p_value) && is.finite(inf$p_value[i, j])) {
          round(inf$p_value[i, j], p_digits)
        } else {
          NA_real_
        }
      }
    }
  }

  df <- data.frame(
    var1 = var1,
    var2 = var2,
    estimate = as.numeric(estimate),
    hsic_raw = as.numeric(hsic_raw),
    stringsAsFactors = FALSE,
    check.names = FALSE
  )
  if (!is.null(n_complete)) df$n_complete <- as.integer(n_complete)
  if (!is.null(p_value)) df$p_value <- as.numeric(p_value)
  rownames(df) <- NULL

  out <- .mc_finalize_summary_df(df, class_name = "summary.hsic")
  attr(out, "overview") <- .mc_summary_corr_matrix(object)
  attr(out, "has_p") <- is.list(inf) && is.matrix(inf$p_value)
  attr(out, "digits") <- digits
  attr(out, "p_digits") <- p_digits
  attr(out, "inference_method") <- if (isTRUE(attr(out, "has_p", exact = TRUE))) inf$method %||% NA_character_ else NA_character_
  out
}

#' @rdname hsic
#' @method print hsic
#' @param x An object of class `hsic`.
#' @param digits Integer; number of decimal places to print.
#' @param n Optional row threshold for compact preview output.
#' @param topn Optional number of leading/trailing rows to show when truncated.
#' @param max_vars Optional maximum number of visible columns.
#' @param width Optional display width.
#' @param show_ci One of `"yes"` or `"no"`; accepted for compatibility with
#'   shared matrix-printing methods.
#' @param ... Additional arguments passed to print or plot methods.
#' @export
print.hsic <- function(x, digits = 4, n = NULL, topn = NULL,
                       max_vars = NULL, width = NULL, show_ci = NULL, ...) {
  .mc_print_corr_matrix(
    x,
    header = if (isTRUE(attr(x, "normalise", exact = TRUE))) {
      "Kernel independence correlation matrix"
    } else {
      "HSIC matrix"
    },
    digits = digits,
    n = n,
    topn = topn,
    max_vars = max_vars,
    width = width,
    show_ci = show_ci,
    ...
  )
}

#' @rdname hsic
#' @method summary hsic
#' @param object An object of class `hsic`.
#' @export
summary.hsic <- function(object, n = NULL, topn = NULL,
                         max_vars = NULL, width = NULL,
                         show_ci = NULL, ...) {
  check_inherits(object, "hsic")
  inf <- .mc_hsic_inference_attr(object)
  diagnostics <- attr(object, "diagnostics", exact = TRUE)
  if (!is.list(inf) && !(is.list(diagnostics) && is.matrix(diagnostics$n_complete))) {
    return(.mc_summary_corr_matrix(object, topn = topn))
  }
  .mc_hsic_pairwise_summary(object)
}

#' @rdname hsic
#' @method print summary.hsic
#' @export
print.summary.hsic <- function(x, digits = NULL, n = NULL,
                               topn = NULL, max_vars = NULL,
                               width = NULL, show_ci = NULL, ...) {
  .mc_print_pairwise_summary_digest(
    x,
    title = "HSIC summary",
    digits = .mc_coalesce(digits, 4),
    n = n,
    topn = topn,
    max_vars = max_vars,
    width = width,
    show_ci = show_ci,
    extra_items = c(inference = attr(x, "inference_method", exact = TRUE)),
    ...
  )
  invisible(x)
}

#' @rdname hsic
#' @method plot hsic
#' @param title Optional plot title.
#' @param low_color Colour for low HSIC values.
#' @param high_color Colour for high HSIC values.
#' @param value_text_size Font size for tile labels.
#' @param show_value Logical; whether to overlay numeric values on the heatmap.
#' @export
plot.hsic <- function(x,
                      title = NULL,
                      low_color = "white",
                      high_color = "steelblue1",
                      value_text_size = 4,
                      show_value = TRUE,
                      ...) {
  check_inherits(x, "hsic")
  check_bool(show_value, arg = "show_value")
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    cli::cli_abort("Package {.pkg ggplot2} is required for plotting.")
  }

  mat <- as.matrix(x)
  df <- as.data.frame(as.table(mat))
  colnames(df) <- c("Var1", "Var2", "HSIC")
  df$Var1 <- factor(df$Var1, levels = rev(unique(df$Var1)))

  p <- ggplot2::ggplot(df, ggplot2::aes(.data$Var2, .data$Var1, fill = .data$HSIC)) +
    ggplot2::geom_tile(color = "white") +
    ggplot2::scale_fill_gradient(
      low = low_color, high = high_color,
      limits = if (isTRUE(attr(x, "normalise", exact = TRUE))) c(0, 1) else NULL,
      name = if (isTRUE(attr(x, "normalise", exact = TRUE))) "kCor" else "HSIC"
    ) +
    ggplot2::theme_minimal(base_size = 12) +
    ggplot2::theme(
      axis.text.x = ggplot2::element_text(angle = 45, hjust = 1),
      panel.grid = ggplot2::element_blank(),
      ...
    ) +
    ggplot2::coord_fixed() +
    ggplot2::labs(
      title = title %||% if (isTRUE(attr(x, "normalise", exact = TRUE))) {
        "Kernel independence correlation heatmap"
      } else {
        "HSIC heatmap"
      },
      x = NULL,
      y = NULL
    )

  if (isTRUE(show_value) && !is.null(value_text_size) && is.finite(value_text_size)) {
    p <- p + ggplot2::geom_text(
      ggplot2::aes(label = sprintf("%.2f", .data$HSIC)),
      size = value_text_size,
      color = "black"
    )
  }

  p
}
