#' @title Pairwise (or Two-Vector) Kendall's Tau Rank Correlation
#'
#' @description
#' Computes pairwise Kendall's tau correlations for numeric data using a
#' high-performance 'C++' backend. Optional confidence intervals are available
#' for matrix and data-frame input.
#'
#' @param data
#' For matrix/data frame mode, a numeric matrix or a data frame with at least
#' two numeric columns. All non-numeric columns are excluded. For two-vector
#' mode, a numeric vector \code{x}.
#' @param y Optional numeric vector \code{y} of the same length as \code{data}
#' when \code{data} is a vector. If supplied, the function computes the
#' Kendall correlation \emph{between \code{data} and \code{y}} using a
#' low-overhead scalar path and returns a single number.
#' @param na_method Character scalar controlling missing-data handling.
#'   \code{"error"} rejects missing, \code{NaN}, and infinite values.
#'   \code{"pairwise"} recomputes each correlation on its own pairwise
#'   complete-case overlap. This is permissive, but different matrix entries
#'   may be based on different rows. \code{"complete"} performs listwise
#'   deletion once across the retained numeric columns and then computes the
#'   estimator on the common complete sample.
#' @param ci Logical (default \code{FALSE}). If \code{TRUE}, attach pairwise
#' confidence intervals for the off-diagonal Kendall correlations in
#' matrix/data-frame mode.
#' @param conf_level Confidence level used when \code{ci = TRUE}. Default is
#' \code{0.95}.
#' @param ci_method Confidence-interval engine used when \code{ci = TRUE}.
#' Supported Kendall methods are \code{"fieller"} (default),
#' \code{"brown_benedetti"}, and \code{"if_el"}.
#' @param n_threads Integer \eqn{\geq 1}. Number of OpenMP threads. Defaults to
#'   \code{getOption("matrixCorr.threads", 1L)}.
#' @param output Output representation for the computed estimates.
#'   \itemize{
#'   \item \code{"matrix"} (default): full dense matrix; best when you need
#'   matrix algebra, dense heatmaps, or full compatibility with existing code.
#'   \item \code{"sparse"}: sparse matrix from \pkg{Matrix} containing only
#'   retained entries; best when many values are dropped by thresholding.
#'   \item \code{"edge_list"}: long-form data frame with columns
#'   \code{row}, \code{col}, \code{value}; convenient for filtering, joins,
#'   and network-style workflows.
#'   }
#' @param threshold Non-negative absolute-value filter for non-matrix outputs:
#'   keep entries with \code{abs(value) >= threshold}. Use
#'   \code{threshold > 0} when you want only stronger associations (typically
#'   with \code{output = "sparse"} or \code{"edge_list"}). Keep
#'   \code{threshold = 0} to retain all values. Must be \code{0} when
#'   \code{output = "matrix"}.
#' @param diag Logical; whether to include diagonal entries in
#'   \code{"sparse"} and \code{"edge_list"} outputs.
#'
#' @return
#' \itemize{
#'   \item If \code{y} is \code{NULL} and \code{data} is a matrix/data frame: a
#'   symmetric numeric matrix where entry \code{(i, j)} is the Kendall's tau
#'   correlation between the \code{i}-th and \code{j}-th numeric columns. When
#'   \code{ci = TRUE}, the object also carries a \code{ci} attribute with
#'   elements \code{est}, \code{lwr.ci}, \code{upr.ci}, \code{conf.level}, and
#'   \code{ci.method}. Pairwise complete-case sample sizes are stored in
#'   \code{attr(x, "diagnostics")$n_complete}.
#'   \item If \code{y} is provided (two-vector mode): a single numeric scalar,
#'   the Kendall's tau correlation between \code{data} and \code{y}.
#' }
#'
#' @details
#' Kendall's tau is a rank-based measure of association between two variables.
#' For a dataset with \eqn{n} observations on variables \eqn{X} and \eqn{Y},
#' let \eqn{n_0 = n(n - 1)/2} be the number of unordered pairs, \eqn{C} the
#' number of concordant pairs, and \eqn{D} the number of discordant pairs.
#' Let \eqn{T_x = \sum_g t_g (t_g - 1)/2} and \eqn{T_y = \sum_h u_h (u_h - 1)/2}
#' be the numbers of tied pairs within \eqn{X} and within \eqn{Y}, respectively,
#' where \eqn{t_g} and \eqn{u_h} are tie-group sizes in \eqn{X} and \eqn{Y}.
#'
#' The tie-robust Kendall's tau-b is:
#' \deqn{ \tau_b = \frac{C - D}{\sqrt{(n_0 - T_x)\,(n_0 - T_y)}}. }
#' When there are no ties (\eqn{T_x = T_y = 0}), this reduces to tau-a:
#' \deqn{ \tau_a = \frac{C - D}{n(n-1)/2}. }
#'
#' The function automatically handles ties. In degenerate cases where a
#' variable is constant (\eqn{n_0 = T_x} or \eqn{n_0 = T_y}), the tau-b
#' denominator is zero and the correlation is undefined (returned as \code{NA}
#' off the diagonal).
#'
#' When \code{na_method = "pairwise"}, each \eqn{(i,j)} estimate is recomputed
#' on the pairwise complete-case overlap of columns \eqn{i} and \eqn{j}.
#' Confidence intervals use the observed pairwise-complete Kendall estimate and
#' the same pairwise complete-case overlap.
#'
#' With \code{ci_method = "fieller"}, the interval is built on the Fisher-style
#' transformed scale \eqn{z = \operatorname{atanh}(\hat\tau)} using Fieller's
#' asymptotic standard error
#' \deqn{ \operatorname{SE}(z) = \sqrt{\frac{0.437}{n - 4}}, }
#' where \eqn{n} is the pairwise complete-case sample size. The interval is then
#' mapped back with \code{tanh()} and clipped to \eqn{[-1, 1]} for numerical
#' safety. This is the default Kendall CI and is intended to be the fast,
#' production-oriented choice.
#'
#' With \code{ci_method = "brown_benedetti"}, the interval is computed on the
#' Kendall tau scale using the Brown-Benedetti large-sample variance for
#' Kendall's tau-b. This path is tie-aware, remains on the original Kendall
#' scale, and is intended as a conventional asymptotic alternative when a
#' direct tau-scale interval is preferred.
#'
#' With \code{ci_method = "if_el"}, the interval is computed in 'C++' using an
#' influence-function empirical-likelihood construction built from the
#' linearised Kendall estimating equation. The lower and upper limits are found
#' by solving the empirical-likelihood ratio equation against the
#' \eqn{\chi^2_1}-cutoff implied by \code{conf_level}. This method is slower
#' than \code{"fieller"} and is intended for specialised inference.
#'
#' \strong{Performance:}
#' \itemize{
#'   \item In the \strong{two-vector mode} (\code{y} supplied), the C++ backend uses a
#'   raw-double path with minimal overhead.
#'   \item In the \strong{matrix/data-frame mode}, the no-missing estimate-only path
#'   uses the Knight (1966) \eqn{O(n \log n)} algorithm. Pairwise-complete
#'   inference paths recompute each pair on its complete-case overlap; the
#'   \code{"brown_benedetti"} interval adds tie-aware large-sample variance
#'   calculations and \code{"if_el"} adds extra per-pair likelihood solving.
#' }
#'
#' @note Missing values are rejected when \code{na_method = "error"}. Columns
#' with fewer than two usable observations are excluded. Confidence intervals
#' are not available in the two-vector interface.
#'
#' @references
#' Kendall, M. G. (1938). A New Measure of Rank Correlation. \emph{Biometrika},
#' 30(1/2), 81-93.
#'
#' Knight, W. R. (1966). A Computer Method for Calculating Kendall's Tau with
#' Ungrouped Data. \emph{Journal of the American Statistical Association},
#' 61(314), 436-439.
#'
#' Fieller, E. C., Hartley, H. O., & Pearson, E. S. (1957). Tests for rank
#' correlation coefficients. I. \emph{Biometrika}, 44(3/4), 470-481.
#'
#' Brown, M. B., & Benedetti, J. K. (1977). Sampling behavior of tests for
#' correlation in two-way contingency tables. \emph{Journal of the American
#' Statistical Association}, 72(358), 309-315.
#'
#' Huang, Z., & Qin, G. (2023). Influence function-based confidence intervals
#' for the Kendall rank correlation coefficient. \emph{Computational
#' Statistics}, 38(2), 1041-1055.
#'
#' Croux, C., & Dehon, C. (2010). Influence functions of the Spearman and
#' Kendall correlation measures. \emph{Statistical Methods & Applications},
#' 19, 497-515.
#'
#' @examples
#' # Basic usage with a matrix
#' mat <- cbind(a = rnorm(100), b = rnorm(100), c = rnorm(100))
#' kt <- kendall_tau(mat)
#' print(kt)
#' summary(kt)
#' plot(kt)
#'
#' # Confidence intervals
#' kt_ci <- kendall_tau(mat[, 1:3], ci = TRUE)
#' print(kt_ci, show_ci = "yes")
#' summary(kt_ci)
#' estimate(kt_ci)
#' tidy(kt_ci)
#' ci(kt_ci)
#' confint(kt_ci)
#'
#' # Two-vector mode (scalar path)
#' x <- rnorm(1000); y <- 0.5 * x + rnorm(1000)
#' kendall_tau(x, y)
#'
#' # Including ties
#' tied_df <- data.frame(
#'   v1 = rep(1:5, each = 20),
#'   v2 = rep(5:1, each = 20),
#'   v3 = rnorm(100)
#' )
#' kt_tied <- kendall_tau(tied_df, ci = TRUE, ci_method = "fieller")
#' print(kt_tied, show_ci = "yes")
#'
#' # Interactive viewing (requires shiny)
#' if (interactive() && requireNamespace("shiny", quietly = TRUE)) {
#'   view_corr_shiny(kt)
#' }
#'
#' @seealso \code{\link{print.kendall_matrix}}, \code{\link{plot.kendall_matrix}}
#' @author Thiago de Paula Oliveira
#' @export
kendall_tau <- function(data,
                        y = NULL,
                        na_method = c("error", "pairwise", "complete"),
                        ci = FALSE,
                        conf_level = 0.95,
                        ci_method = c("fieller", "if_el", "brown_benedetti"),
                        n_threads = getOption("matrixCorr.threads", 1L),
                        output = c("matrix", "sparse", "edge_list"),
                        threshold = 0,
                        diag = TRUE,
                        ...) {
  output_cfg <- .mc_prepare_corr_output(
    output = output,
    threshold = threshold,
    diag = diag
  )
  if (is.null(y) && ...length() == 0L && missing(na_method) && isFALSE(ci)) {
    input <- .mc_prepare_corr_input(
      data,
      na_cfg = list(na_method = "error", check_na = TRUE),
      min_n = 2L
    )
    return(.mc_with_omp_threads(
      n_threads,
      {
        .mc_finalize_corr_result(
          mat = kendall_matrix_cpp(input$data),
          class_name = "kendall_matrix",
          method = "kendall",
          description = "Pairwise Kendall's tau (auto tau-a/tau-b) correlation matrix",
          output_cfg = output_cfg,
          dimnames = input$dimnames,
          symmetric = TRUE
        )
      }
    ))
  }

  na_cfg <- .mc_resolve_corr_na(
    na_method = na_method,
    dots = list(...),
    na_method_missing = missing(na_method),
    allowed = c("error", "pairwise", "complete")
  )
  if (!isFALSE(ci)) {
    check_bool(ci, arg = "ci")
  } else if (!is.logical(ci) || length(ci) != 1L || is.na(ci)) {
    check_bool(ci, arg = "ci")
  }
  ci_method <- match.arg(ci_method)
  if (isTRUE(ci)) {
    check_prob_scalar(conf_level, arg = "conf_level", open_ends = TRUE)
  }

  if (!is.null(y)) {
    if (!identical(output_cfg$output, "matrix")) {
      abort_bad_arg(
        "output",
        message = "non-matrix output modes are unavailable in two-vector mode."
      )
    }
    if (isTRUE(ci)) {
      abort_bad_arg("ci",
        message = "Confidence intervals are not available when {.arg y} is supplied."
      )
    }
    if (!is.numeric(data) || !is.numeric(y)) {
      abort_bad_arg("data",
        message = "and {.arg y} must be numeric vectors for two-vector mode."
      )
    }
    check_same_length(data, y, arg_x = "data", arg_y = "y")
    if (na_cfg$check_na && (any(!is.finite(data)) || any(!is.finite(y)))) {
      abort_bad_arg("data",
        message = "and {.arg y} must be free of NA/NaN/Inf when {.arg na_method} is {.val error}.",
        .hint   = "Set `na_method = \"pairwise\"` to use complete-case overlaps."
      )
    }
    if (identical(na_cfg$na_method, "complete")) {
      keep <- is.finite(data) & is.finite(y)
      if (sum(keep) < 2L) {
        abort_bad_arg(
          "data",
          message = "must retain at least 2 complete rows when {.arg na_method} is {.val complete}; retained {sum(keep)}."
        )
      }
      data <- data[keep]
      y <- y[keep]
    }

    tau <- kendall_tau2_cpp(as.numeric(data), as.numeric(y))
    return(as.numeric(tau))
  }

  input <- .mc_prepare_corr_input(data, na_cfg = na_cfg, min_n = 2L)
  diagnostics <- NULL
  ci_attr <- NULL

  .mc_with_omp_threads(
    n_threads,
    {
      if (!identical(na_cfg$na_method, "pairwise") && !isTRUE(ci)) {
        result <- kendall_matrix_cpp(input$data)
      } else {
        pairwise <- kendall_matrix_pairwise_cpp(
          input$data,
          return_ci = ci,
          conf_level = conf_level,
          ci_method = ci_method
        )
        result <- pairwise$est
        diagnostics <- list(
          n_complete = .mc_set_matrix_dimnames(pairwise$n_complete, input$colnames)
        )
        if (isTRUE(ci)) {
          ci_attr <- list(
            est = .mc_set_matrix_dimnames(unclass(result), input$colnames),
            lwr.ci = .mc_set_matrix_dimnames(unclass(pairwise$lwr), input$colnames),
            upr.ci = .mc_set_matrix_dimnames(unclass(pairwise$upr), input$colnames),
            conf.level = pairwise$conf_level,
            ci.method = pairwise$ci_method
          )
        }
      }

      .mc_finalize_corr_result(
        mat = result,
        class_name = "kendall_matrix",
        method = "kendall",
        description = "Pairwise Kendall's tau (auto tau-a/tau-b) correlation matrix",
        output_cfg = output_cfg,
        diagnostics = .mc_merge_diagnostics(diagnostics, input$diagnostics),
        dimnames = input$dimnames,
        symmetric = TRUE,
        extra_attrs = if (!is.null(ci_attr)) {
          list(
            ci = ci_attr,
            conf.level = conf_level,
            ci.method = ci_method
          )
        }
      )
    }
  )
}

.mc_kendall_pairwise_summary <- function(object,
                                         digits = 4,
                                         ci_digits = 3,
                                         show_ci = NULL) {
  show_ci <- .mc_validate_yes_no(
    show_ci,
    arg = "show_ci",
    default = .mc_display_option("summary_show_ci", "yes")
  )
  check_inherits(object, "kendall_matrix")

  ci <- .mc_ci_attr(object)
  .mc_pairwise_matrix_summary(
    object,
    class_name = "summary.kendall_matrix",
    digits = digits,
    ci_digits = ci_digits,
    show_ci = show_ci,
    ci_attr = ci,
    include_p = NULL,
    extra_attrs = list(
      ci.method = if (is.null(ci)) NA_character_ else ci$ci.method
    )
  )
}

#' @rdname kendall_tau
#' @method print kendall_matrix
#' @title Print Method for \code{kendall_matrix} Objects
#'
#' @param x An object of class \code{kendall_matrix}.
#' @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; `NULL` derives this
#'   from console width.
#' @param width Optional display width; defaults to \code{getOption("width")}.
#' @param ci_digits Integer; digits for Kendall confidence limits.
#' @param show_ci One of \code{"yes"} or \code{"no"}.
#' @param ... Additional arguments passed to \code{print}.
#'
#' @return Invisibly returns the \code{kendall_matrix} object.
#' @export
print.kendall_matrix <- function(x, digits = 4, n = NULL,
                                 topn = NULL, max_vars = NULL,
                                 width = NULL, ci_digits = 3,
                                 show_ci = NULL, ...) {
  .mc_print_corr_matrix(
    x,
    header = "Kendall correlation matrix",
    digits = digits,
    n = n,
    topn = topn,
    max_vars = max_vars,
    width = width,
    show_ci = show_ci,
    ...
  )
  invisible(x)
}

#' @rdname kendall_tau
#' @method plot kendall_matrix
#' @title Plot Method for \code{kendall_matrix} Objects
#'
#' @param x An object of class \code{kendall_matrix}.
#' @param title Plot title. Default is \code{"Kendall's Tau correlation
#' heatmap"}.
#' @param low_color Color for the minimum tau value. Default is
#' \code{"indianred1"}.
#' @param high_color Color for the maximum tau value. Default is
#' \code{"steelblue1"}.
#' @param mid_color Color for zero correlation. Default is \code{"white"}.
#' @param value_text_size Font size for displaying correlation values. Default
#' is \code{4}.
#' @param ci_text_size Text size for confidence intervals in the heatmap.
#' @param show_value Logical; if \code{TRUE} (default), overlay numeric values
#'   on the heatmap tiles.
#' @param ... Additional arguments passed to \code{ggplot2::theme()} or other
#' \code{ggplot2} layers.
#'
#' @return A \code{ggplot} object representing the heatmap.
#' @import ggplot2
#' @export
plot.kendall_matrix <- function(x, title = "Kendall's Tau correlation heatmap",
                                low_color = "indianred1", high_color = "steelblue1",
                                mid_color = "white", value_text_size = 4,
                                ci_text_size = 3, show_value = TRUE, ...) {
  check_bool(show_value, arg = "show_value")
  ci <- .mc_ci_attr(x)
  if (is.null(ci) || is.null(ci$lwr.ci) || is.null(ci$upr.ci)) {
    return(.mc_plot_corr_matrix(
      x, class_name = "kendall_matrix", fill_name = "Tau",
      title = title, low_color = low_color, high_color = high_color,
      mid_color = mid_color, value_text_size = value_text_size,
      show_value = show_value, ...
    ))
  }

  est_mat <- as.matrix(x)
  df_est <- as.data.frame(as.table(est_mat))
  names(df_est) <- c("Var1", "Var2", "tau")

  df_lwr <- as.data.frame(as.table(ci$lwr.ci))
  names(df_lwr)[3] <- "lwr"
  df_upr <- as.data.frame(as.table(ci$upr.ci))
  names(df_upr)[3] <- "upr"
  df <- Reduce(
    function(a, b) merge(a, b, by = c("Var1", "Var2"), all = TRUE),
    list(df_est, df_lwr, df_upr)
  )

  diag_idx <- df$Var1 == df$Var2
  df$lwr[diag_idx] <- NA_real_
  df$upr[diag_idx] <- NA_real_
  df$ci_label <- ifelse(
    is.na(df$lwr) | is.na(df$upr),
    NA_character_,
    sprintf("[%.3f, %.3f]", df$lwr, df$upr)
  )

  lev_row <- unique(df_est$Var1)
  lev_col <- unique(df_est$Var2)
  df$Var1 <- factor(df$Var1, levels = rev(lev_row))
  df$Var2 <- factor(df$Var2, levels = lev_col)
  df$label <- sprintf("%.2f", df$tau)

  p <- ggplot2::ggplot(df, ggplot2::aes(x = Var2, y = Var1, fill = .data$tau)) +
    ggplot2::geom_tile(color = "white") +
    ggplot2::scale_fill_gradient2(
      low = low_color,
      high = high_color,
      mid = mid_color,
      midpoint = 0,
      limits = c(-1, 1),
      name = "Tau"
    ) +
    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, x = NULL, y = NULL)

  if (isTRUE(show_value)) {
    p <- p + ggplot2::geom_text(ggplot2::aes(label = label), size = value_text_size, color = "black")
  }

  if (isTRUE(show_value) && any(!is.na(df$ci_label))) {
    p <- p + ggplot2::geom_text(
      ggplot2::aes(label = ci_label, y = as.numeric(Var1) - 0.25),
      size = ci_text_size,
      color = "gray30",
      na.rm = TRUE
    )
  }

  p
}

#' @rdname kendall_tau
#' @method summary kendall_matrix
#' @param object An object of class \code{kendall_matrix}.
#' @param ci_digits Integer; digits for Kendall confidence limits in the
#'   pairwise summary.
#' @param show_ci One of \code{"yes"} or \code{"no"}.
#' @export
summary.kendall_matrix <- function(object,
                                   n = NULL,
                                   topn = NULL,
                                   max_vars = NULL,
                                   width = NULL,
                                   ci_digits = 3,
                                   show_ci = NULL,
                                   ...) {
  check_inherits(object, "kendall_matrix")
  show_ci <- .mc_validate_yes_no(
    show_ci,
    arg = "show_ci",
    default = .mc_display_option("summary_show_ci", "yes")
  )
  if (is.null(.mc_ci_attr(object))) {
    return(.mc_summary_corr_matrix(object, topn = topn))
  }
  .mc_kendall_pairwise_summary(
    object,
    ci_digits = ci_digits,
    show_ci = show_ci
  )
}

#' @rdname kendall_tau
#' @method print summary.kendall_matrix
#' @param x An object of class \code{summary.kendall_matrix}.
#' @export
print.summary.kendall_matrix <- function(x, digits = NULL, n = NULL,
                                         topn = NULL, max_vars = NULL,
                                         width = NULL, show_ci = NULL, ...) {
  ci_method <- attr(x, "ci.method", exact = TRUE)
  .mc_print_pairwise_summary_digest(
    x,
    title = "Kendall correlation summary",
    digits = .mc_coalesce(digits, 4),
    n = n,
    topn = topn,
    max_vars = max_vars,
    width = width,
    show_ci = show_ci,
    ci_method = ci_method,
    ...
  )
  invisible(x)
}


