#' Partial Gamma Local Dependence Analysis
#'
#' Computes partial gamma coefficients for Local Dependence (LD) assessment
#' using \code{iarm::partgam_LD()}. Each pair of items is tested for residual
#' association, controlling for the rest score (total score minus one of the
#' items in the pair).
#'
#' @param data A data.frame or matrix of item responses. Items must be scored
#'   starting at 0 (non-negative integers). Missing values (`NA`) are allowed,
#'   but at least one complete case must exist.
#' @param cutoff Optional. Default `NULL` (no cutoff applied). Can be:
#'   * The return value of \code{\link{RMlocdepGammaCutoff}} (a list with
#'     `$pair_cutoffs`): the data.frame is extracted automatically and
#'     simulation metadata is included in the kable caption.
#'   * The `$pair_cutoffs` data.frame from \code{\link{RMlocdepGammaCutoff}}
#'     directly: must have columns `Item1`, `Item2`, `gamma_low`, `gamma_high`.
#'   When provided, adds columns `Gamma_low`, `Gamma_high`, and `Flagged`
#'   (logical; `TRUE` when the observed partial gamma falls outside the
#'   credible range) to the result.
#' @param p_value Logical. When `TRUE`, adds one-sided bootstrap p-values for
#'   *excess positive* local dependence (`p_gamma`, `padj_gamma`), matching
#'   the `p_value` semantics of \code{\link{RMlocdepQ3}}, and `flagged`
#'   reflects `padj_gamma < alpha` (positive deviations only) instead of the
#'   credible range. One test per item pair: the p-value is computed in the
#'   canonical direction (direction 1, rest score = total - Item2, the
#'   direction that was simulated) and repeated in the direction-2 table for
#'   the same pair. The asymptotic BH-adjusted p-value and star columns from
#'   `iarm::partgam_LD()` are **dropped** in this mode; the simulated
#'   `gamma_low` / `gamma_high` band is kept as the effect-size reference.
#'   Requires the **full** \code{\link{RMlocdepGammaCutoff}} object as
#'   `cutoff` (it carries the simulated distributions in `$results`).
#'   Default `FALSE`.
#' @param correction Character. Multiplicity correction for the bootstrap
#'   p-values, applied over the family of all item pairs (before any
#'   `n_pairs` display filter): `"fwer"` (default; Westfall-Young
#'   studentised-max step-down), `"fdr_bh"`, `"fdr_by"`, or `"none"`. Ignored
#'   when `p_value = FALSE`.
#' @param alpha Numeric in (0, 1). Significance level used to flag pairs on
#'   the corrected p-value. Default `0.05`. Ignored when `p_value = FALSE`.
#' @param output Character string controlling the return value. Either
#'   `"kable"` (default) for a formatted `knitr::kable()` table, or
#'   `"dataframe"` for the underlying data.frame.
#' @param n_pairs Optional positive integer. When supplied, only the
#'   `n_pairs` item pairs with the largest absolute partial-gamma values
#'   (i.e., strongest residual dependence in either direction) are
#'   retained per rest-score direction, sorted by `|gamma|` descending.
#'   When `NULL` (default), all pairs are returned in `iarm`'s native
#'   ordering. Values larger than the total number of pairs are silently
#'   capped at that total.
#'
#' @return
#' * If `output = "kable"`: an object of class `"RMlocdepGamma"`. Internally
#'   a list with two `knitr_kable` elements, `$direction1` and
#'   `$direction2`. In both, the rest score is the total score minus
#'   Item 2 (the second column); the two elements list each item pair in
#'   the two possible orders, so together they cover both rest-score
#'   directions for every pair. Each has columns "Item 1", "Item 2",
#'   "Partial gamma",
#'   "Adj. p-value (BH)", and "p-value sign." (a star-string indicator
#'   from `iarm::partgam_LD()`). When `cutoff` is provided, additional
#'   columns "Gamma low", "Gamma high", and "Flagged" are included.
#'
#'   The object has custom `print()` and `knitr::knit_print()` methods:
#'   in the R console it prints the two tables stacked vertically; in a
#'   Quarto / R Markdown chunk it renders as two distinct pipe tables.
#'   Access the individual tables explicitly as `result$direction1` and
#'   `result$direction2` if needed.
#' * If `output = "dataframe"`: a named list of two data.frames
#'   (`$direction1`, `$direction2`) with columns `Item1`, `Item2`,
#'   `gamma`, `se`, `lower`, `upper` (95% Wald CI), `padj_bh`,
#'   `Significance`. When `cutoff` is provided, columns `gamma_low`,
#'   `gamma_high`, and `flagged` are also included.
#'   With `p_value = TRUE`, `padj_bh` and `Significance` are replaced by
#'   `p_gamma` and `padj_gamma` (identical for a pair in both directions).
#'
#' @details
#' Partial gamma (Christensen, Kreiner & Mesbah, 2013) measures the residual
#' association between pairs of items after controlling for the rest score
#' (total score minus one item). Because it matters which item is subtracted,
#' calculations are done for each pair in both directions, yielding two
#' data.frames.
#'
#' Values near 0 indicate no local dependence. Large positive values suggest
#' positive LD (items share variance beyond the latent trait), while large
#' negative values suggest negative LD.
#'
#' The `iarm` package must be installed (it is in Suggests, not Imports).
#'
#' \strong{Bootstrap p-values.} When `p_value = TRUE`, each pair's observed
#' partial gamma (canonical direction) is compared against its simulated null
#' distribution (from `cutoff$results`, simulated under local independence).
#' The per-pair statistic is the residual studentised by the bootstrap mean
#' and SD; the marginal p-value is the one-sided Monte-Carlo p-value
#' `(1 + #\{t* >= t\}) / (B + 1)` for excess *positive* LD (redundancy, the
#' diagnostic target — matching \code{\link{RMlocdepQ3}}), so it can be no
#' smaller than `1 / (B + 1)`. The band still shows both bounds for
#' reference. `correction = "fwer"` uses the Westfall-Young studentised-max
#' step-down over the family of all pairs, which exploits the bootstrap
#' dependence among them (Ferreira, 2024); it is liberal when the simulation
#' is small, so at least 1000 `iterations` in [RMlocdepGammaCutoff()] are
#' recommended (a warning is issued below that). Unlike the asymptotic
#' p-values from `iarm::partgam_LD()`, these are calibrated against the
#' *simulated Rasch null* rather than the asymptotic SE; they are
#' model-conditional and sample-size-sensitive, and are reported alongside
#' the simulated effect-size band, not in place of it.
#'
#' @inheritSection RMitemInfit Multiple comparisons
#'
#' @references
#' Christensen, K. B., Kreiner, S. & Mesbah, M. (Eds.) (2013).
#' \emph{Rasch Models in Health}, pp. 133--135. ISTE & Wiley.
#' \doi{10.1002/9781118574454}
#'
#' Ferreira, J. A. (2024). Methods of testing a 'small' or 'moderate' number
#' of hypotheses simultaneously. *Journal of Statistical Theory and Practice,
#' 19*(6). \doi{10.1007/s42519-024-00412-4}
#'
#' Westfall, P. H., & Young, S. S. (1993). *Resampling-Based Multiple Testing*.
#' Wiley.
#'
#' @seealso \code{\link{RMlocdepGammaCutoff}}, \code{\link{RMlocdepGammaPlot}}
#'
#' @export
#'
#' @examples
#' \donttest{
#' if (requireNamespace("iarm", quietly = TRUE)) {
#'   set.seed(42)
#'   sim_data <- as.data.frame(
#'     matrix(sample(0:1, 200 * 10, replace = TRUE), nrow = 200, ncol = 10)
#'   )
#'   colnames(sim_data) <- paste0("Item", 1:10)
#'
#'   # Default kable output
#'   RMlocdepGamma(sim_data)
#'
#'   # Return as data.frame list
#'   RMlocdepGamma(sim_data, output = "dataframe")
#'
#'   # Simulation-based cutoffs (slow): 100+ Monte-Carlo iterations
#'   if (requireNamespace("ggdist", quietly = TRUE)) {
#'     cutoff_res <- RMlocdepGammaCutoff(sim_data, iterations = 100,
#'                                       parallel = FALSE, seed = 42)
#'     RMlocdepGamma(sim_data, cutoff = cutoff_res)
#'
#'     # Bootstrap p-values with family-wise (Westfall-Young) correction
#'     # (use iterations >= 1000 in real analyses for stable p-values)
#'     RMlocdepGamma(sim_data, cutoff = cutoff_res, p_value = TRUE,
#'                   output = "dataframe")
#'   }
#' }
#' }
RMlocdepGamma <- function(
  data,
  cutoff = NULL,
  p_value = FALSE,
  correction = c("fwer", "fdr_bh", "fdr_by", "none"),
  alpha = 0.05,
  output = "kable",
  n_pairs = NULL
) {
  if (!requireNamespace("iarm", quietly = TRUE)) {
    stop(
      "Package 'iarm' is required for RMlocdepGamma() but is not installed.\n",
      "Install it with: install.packages(\"iarm\")",
      call. = FALSE
    )
  }

  output <- match.arg(output, c("kable", "dataframe"))
  correction <- match.arg(correction)
  if (!is.numeric(alpha) || length(alpha) != 1L || alpha <= 0 || alpha >= 1) {
    stop("`alpha` must be a single number in (0, 1).", call. = FALSE)
  }

  # --- Validate n_pairs -------------------------------------------------------
  if (!is.null(n_pairs)) {
    if (
      !is.numeric(n_pairs) ||
        length(n_pairs) != 1L ||
        !is.finite(n_pairs) ||
        n_pairs < 1 ||
        n_pairs != as.integer(n_pairs)
    ) {
      stop(
        "`n_pairs` must be a single positive integer or NULL.",
        call. = FALSE
      )
    }
    n_pairs <- as.integer(n_pairs)
  }

  validate_response_data(data)

  # --- Validate and normalise cutoff ------------------------------------------
  cutoff_n_iter <- NULL
  cutoff_method <- NULL
  cutoff_hdci_width <- NULL
  cutoff_full <- NULL # full object (carries simulated $results for p-values)
  if (!is.null(cutoff)) {
    if (
      is.list(cutoff) &&
        !is.data.frame(cutoff) &&
        "pair_cutoffs" %in% names(cutoff)
    ) {
      cutoff_full <- cutoff
      cutoff_n_iter <- cutoff$actual_iterations
      cutoff_method <- cutoff$cutoff_method
      cutoff_hdci_width <- cutoff$hdci_width
      cutoff <- cutoff$pair_cutoffs
    }
    if (!is.data.frame(cutoff)) {
      stop(
        "`cutoff` must be NULL, the return value of RMlocdepGammaCutoff(), or its ",
        "$pair_cutoffs data.frame.",
        call. = FALSE
      )
    }
    required_cols <- c("Item1", "Item2", "gamma_low", "gamma_high")
    missing_cols <- setdiff(required_cols, names(cutoff))
    if (length(missing_cols) > 0L) {
      stop(
        "`cutoff` data.frame is missing required columns: ",
        paste(missing_cols, collapse = ", "),
        ".",
        call. = FALSE
      )
    }
  }

  # --- p-value prerequisites --------------------------------------------------
  if (p_value) {
    if (is.null(cutoff_full) || is.null(cutoff_full$results)) {
      stop(
        "`p_value = TRUE` requires the full RMlocdepGammaCutoff() object (it ",
        "carries the simulated per-pair distributions in $results); a NULL ",
        "cutoff or the bare $pair_cutoffs data.frame is not sufficient.",
        call. = FALSE
      )
    }
    if (!is.null(cutoff_n_iter) && cutoff_n_iter < 1000L) {
      warning(
        "Bootstrap p-values are based on only ",
        cutoff_n_iter,
        " simulation iterations. With few iterations the studentised-max ",
        "(FWER) correction is liberal and small p-values are imprecise; ",
        "use iterations >= 1000 in RMlocdepGammaCutoff() for reliable ",
        "p-values.",
        call. = FALSE
      )
    }
  }

  # --- rgl workaround ---------------------------------------------------------
  old_rgl <- getOption("rgl.useNULL")
  options(rgl.useNULL = TRUE)
  on.exit(options(rgl.useNULL = old_rgl), add = TRUE)

  # --- Compute partial gamma LD via iarm --------------------------------------
  sink(nullfile())
  pgam_raw <- iarm::partgam_LD(as.data.frame(data))
  sink()

  # pgam_raw is a list of two data.frames (one per rest-score direction).
  # Columns from iarm::partgam_LD():
  #   1 Item1, 2 Item2, 3 gamma, 4 se, 5 pvalue, 6 padj.BH, 7 sig,
  #   8 lower, 9 upper. The `sig` column is a star string like " ***" /
  #   " **" / " *" / "  ." / "    "; we trim whitespace for display.
  process_pgam_df <- function(raw_df) {
    df <- data.frame(
      Item1 = as.character(raw_df$Item1),
      Item2 = as.character(raw_df$Item2),
      gamma = as.numeric(raw_df$gamma),
      se = as.numeric(raw_df$se),
      lower = as.numeric(raw_df$lower),
      upper = as.numeric(raw_df$upper),
      padj_bh = as.numeric(raw_df[[6]]),
      Significance = trimws(as.character(raw_df[[7]])),
      stringsAsFactors = FALSE
    )
    df
  }

  result_list <- list(
    direction1 = process_pgam_df(pgam_raw[[1]]),
    direction2 = process_pgam_df(pgam_raw[[2]])
  )

  # --- Apply cutoff if provided -----------------------------------------------
  # Cutoffs are keyed by direction-1 pairs (i < j), so for direction 2 (i > j)

  # we must look up by the canonical (sorted) pair order.
  if (!is.null(cutoff)) {
    # Build a canonical key on the cutoff table
    cutoff$canonical_key <- paste(
      pmin(cutoff$Item1, cutoff$Item2),
      pmax(cutoff$Item1, cutoff$Item2),
      sep = "___"
    )
    cutoff_sub <- cutoff[, c("canonical_key", "gamma_low", "gamma_high")]

    for (idx in seq_along(result_list)) {
      result_df <- result_list[[idx]]
      # Build the same canonical key on the result (sorted pair order)
      result_df$canonical_key <- paste(
        pmin(result_df$Item1, result_df$Item2),
        pmax(result_df$Item1, result_df$Item2),
        sep = "___"
      )

      merged <- merge(
        result_df,
        cutoff_sub,
        by = "canonical_key",
        all.x = TRUE,
        sort = FALSE
      )
      # Restore original row order
      merged <- merged[match(result_df$canonical_key, merged$canonical_key), ]
      rownames(merged) <- NULL
      merged$flagged <- !is.na(merged$gamma_low) &
        (merged$gamma < merged$gamma_low | merged$gamma > merged$gamma_high)

      # Remove helper column
      merged$canonical_key <- NULL

      merged <- merged[, c(
        "Item1",
        "Item2",
        "gamma",
        "se",
        "lower",
        "upper",
        "padj_bh",
        "Significance",
        "gamma_low",
        "gamma_high",
        "flagged"
      )]
      result_list[[idx]] <- merged
    }
    # Clean up cutoff helper column
    cutoff$canonical_key <- NULL
  }

  # --- Bootstrap p-values (one test per pair, canonical direction) ------------
  # Computed BEFORE the n_pairs display filter so the multiplicity correction
  # always runs over the full family of pairs. The simulated null holds the
  # direction-1 gammas only, so the observed statistic is the direction-1
  # (canonical) gamma; the resulting p-value is keyed by the unordered pair
  # and repeated in the direction-2 table.
  if (p_value) {
    canon_key <- function(a, b) {
      paste(pmin(a, b), pmax(a, b), sep = "___")
    }
    sim_res <- cutoff_full$results
    sim_key <- canon_key(sim_res$Item1, sim_res$Item2)
    obs_key <- canon_key(
      as.character(pgam_raw[[1L]]$Item1),
      as.character(pgam_raw[[1L]]$Item2)
    )
    if (!setequal(obs_key, unique(sim_key))) {
      stop(
        "Item pairs in the cutoff simulations ($results) do not match the ",
        "pairs in `data`.",
        call. = FALSE
      )
    }
    sim_mat <- tapply(
      sim_res$gamma,
      list(sim_res$iteration, sim_key),
      function(x) x[1L]
    )
    observed <- stats::setNames(
      as.numeric(pgam_raw[[1L]]$gamma),
      obs_key
    )
    # One-sided: excess positive LD (redundancy), matching RMlocdepQ3.
    pv <- .bootstrap_pvalues(
      observed,
      sim_mat,
      correction = correction,
      tail = "upper"
    )
    p_lookup <- stats::setNames(pv$p, pv$name)
    padj_lookup <- stats::setNames(pv$padj, pv$name)

    for (idx in seq_along(result_list)) {
      df <- result_list[[idx]]
      key <- canon_key(df$Item1, df$Item2)
      df$p_gamma <- as.numeric(p_lookup[key])
      df$padj_gamma <- as.numeric(padj_lookup[key])
      df$flagged <- !is.na(df$padj_gamma) & df$padj_gamma < alpha
      # Drop the asymptotic p-value pair; the bootstrap p-values replace it.
      df <- df[, c(
        "Item1",
        "Item2",
        "gamma",
        "se",
        "lower",
        "upper",
        "gamma_low",
        "gamma_high",
        "p_gamma",
        "padj_gamma",
        "flagged"
      )]
      result_list[[idx]] <- df
    }
  }

  # --- Top-N filter by |gamma| per direction ----------------------------------
  total_pairs <- nrow(result_list[[1L]])
  filter_applied <- FALSE
  if (!is.null(n_pairs)) {
    keep_n <- min(n_pairs, total_pairs)
    if (keep_n < total_pairs) {
      filter_applied <- TRUE
      for (idx in seq_along(result_list)) {
        df <- result_list[[idx]]
        ord <- order(abs(df$gamma), decreasing = TRUE)
        df <- df[ord[seq_len(keep_n)], , drop = FALSE]
        rownames(df) <- NULL
        result_list[[idx]] <- df
      }
    }
  }

  # --- Return -----------------------------------------------------------------
  if (output == "dataframe") {
    return(result_list)
  }

  # Kable display rounding (the dataframe output above stays unrounded).
  # The se / lower / upper columns are dataframe-only (added for
  # programmatic use, e.g. the jamovi module); the kable keeps its
  # previous column set.
  ld_digits <- c(
    gamma = 3, padj_bh = 3, gamma_low = 3, gamma_high = 3,
    p_gamma = 4, padj_gamma = 4
  )
  result_list <- lapply(result_list, function(d) {
    .round_display(d[, setdiff(names(d), c("se", "lower", "upper")),
                     drop = FALSE], digits = ld_digits)
  })

  # Build caption
  n_complete <- sum(stats::complete.cases(as.data.frame(data)))
  n_clause <- .n_caption(
    n_complete,
    nrow(as.data.frame(data)),
    if (anyNA(as.data.frame(data))) "complete cases" else character()
  )
  filter_suffix <- if (filter_applied) {
    paste0(" Showing top ", n_pairs, " of ", total_pairs, " pairs by |gamma|.")
  } else {
    ""
  }
  if (p_value) {
    caption_text <- paste0(
      "Partial gamma LD analysis. ",
      n_clause,
      ". One-sided bootstrap p-values for excess positive LD from ",
      cutoff_n_iter,
      " iterations, computed in the canonical direction (rest score = ",
      "total - Item2) and repeated for both directions (replacing the ",
      "asymptotic BH p-values); multiplicity correction: ",
      .correction_label(correction),
      "; flagged at padj < ",
      alpha,
      ". p-values cannot be smaller than 1/(",
      cutoff_n_iter,
      "+1) = ",
      round(1 / (cutoff_n_iter + 1), 4),
      ".",
      filter_suffix
    )
  } else if (is.null(cutoff)) {
    caption_text <- paste0(
      "Partial gamma LD analysis. ",
      n_clause,
      ". Positive gamma indicates positive local dependence between items.",
      filter_suffix
    )
  } else if (!is.null(cutoff_n_iter)) {
    method_label <- .format_gamma_cutoff_method_label(
      cutoff_method,
      cutoff_hdci_width
    )
    iter_part <- paste0(cutoff_n_iter, " simulation iterations")
    caption_text <- paste0(
      "Partial gamma LD analysis. ",
      n_clause,
      ". Cutoff values based on ",
      if (!is.null(method_label)) {
        paste0(iter_part, " (", method_label, ").")
      } else {
        paste0(iter_part, ".")
      },
      filter_suffix
    )
  } else {
    caption_text <- paste0(
      "Partial gamma LD analysis. ",
      n_clause,
      ". Simulation-based cutoff values applied.",
      filter_suffix
    )
  }

  col_names_no_cutoff <- c(
    "Item 1",
    "Item 2",
    "Partial gamma",
    "Adj. p-value (BH)",
    "p-value sign."
  )
  col_names_cutoff <- c(
    "Item 1",
    "Item 2",
    "Partial gamma",
    "Adj. p-value (BH)",
    "p-value sign.",
    "Gamma low",
    "Gamma high",
    "Flagged"
  )
  col_names_pvalue <- c(
    "Item 1",
    "Item 2",
    "Partial gamma",
    "Gamma low",
    "Gamma high",
    "p",
    "p (adj)",
    "Flagged"
  )
  col_names_used <- if (p_value) {
    col_names_pvalue
  } else if (is.null(cutoff)) {
    col_names_no_cutoff
  } else {
    col_names_cutoff
  }

  kable1 <- knitr::kable(
    result_list$direction1,
    format = "pipe",
    col.names = col_names_used,
    caption = paste0(caption_text, " Direction 1: rest score = total - Item2.")
  )

  kable2 <- knitr::kable(
    result_list$direction2,
    format = "pipe",
    col.names = col_names_used,
    caption = paste0(
      caption_text,
      " Direction 2: rest score = total - Item2 ",
      "(item pairs shown in the reverse order to ",
      "direction 1)."
    )
  )

  # `knitr::kable(format = "pipe")` returns a multi-line *character vector*
  # (one element per line), so `paste(kable1, "\n\n", kable2)` would do
  # element-wise concatenation, interleaving the two tables row-by-row.
  # Collapse each table to a single string first, then join with a
  # blank line between to render as two distinct kable tables.
  combined <- paste(
    paste(kable1, collapse = "\n"),
    paste(kable2, collapse = "\n"),
    sep = "\n\n"
  )

  # Return a custom-class list so the two display contexts (R console and
  # knitr chunk) can be handled separately. See print.RMlocdepGamma() and
  # knit_print.RMlocdepGamma() below.
  out <- list(
    direction1 = kable1,
    direction2 = kable2,
    .combined = combined
  )
  class(out) <- c("RMlocdepGamma", "list")
  out
}

#' Print method for RMlocdepGamma kable output
#'
#' Prints the two rest-score direction tables stacked vertically with a
#' blank line between them. Each table renders via `knitr_kable`'s own
#' print method as a clean pipe-markdown table.
#'
#' @param x An object of class `"RMlocdepGamma"` returned by
#'   \code{\link{RMlocdepGamma}} with `output = "kable"`.
#' @param ... Further arguments (currently unused).
#' @return Invisibly returns `x`.
#' @keywords internal
#' @exportS3Method base::print
print.RMlocdepGamma <- function(x, ...) {
  print(x$direction1)
  cat("\n")
  print(x$direction2)
  invisible(x)
}

#' knitr knit_print method for RMlocdepGamma kable output
#'
#' Inside a knitr / Quarto / R Markdown chunk, returns the pre-combined
#' two-table asis string so pandoc renders them as two distinct pipe
#' tables. Outside knitr, R's normal dispatch falls back to
#' `print.RMlocdepGamma()`.
#'
#' @param x An object of class `"RMlocdepGamma"`.
#' @param ... Further arguments passed to `knitr::asis_output()`.
#' @return A `knit_asis` character object.
#' @keywords internal
#' @exportS3Method knitr::knit_print
knit_print.RMlocdepGamma <- function(x, ...) {
  knitr::asis_output(x$.combined)
}

#' Simulation-Based Partial Gamma LD Cutoff Determination
#'
#' Uses parametric bootstrap simulation to determine appropriate cutoff values
#' for partial gamma Local Dependence analysis via
#' \code{\link[iarm]{partgam_LD}}. Under a correctly fitting Rasch model where
#' items are locally independent, this function generates the expected
#' distribution of partial gamma values per item pair, providing empirical
#' critical values.
#'
#' @param data A data.frame or matrix of item responses. Items must be scored
#'   starting at 0 (non-negative integers). Only complete cases (rows without
#'   any `NA`) are used.
#' @param iterations Integer. Number of simulation iterations (default 250).
#' @param parallel Logical. Use parallel processing via `mirai` if available
#'   (default `TRUE`).
#' @param n_cores Integer or `NULL`. Number of parallel workers. When `NULL`,
#'   `getOption("mc.cores")` is checked first. If neither is set and
#'   `parallel = TRUE`, a warning is issued and execution falls back to
#'   sequential (single core) processing.
#' @param verbose Logical. Show a progress bar (default `FALSE`).
#' @param seed Integer or `NULL`. Random seed for reproducibility.
#' @param cutoff_method Character string specifying how cutoff intervals are
#'   computed. Either `"hdci"` (default) for the Highest Density Interval via
#'   `ggdist::hdci()`, or `"quantile"` for the 2.5th/97.5th percentiles via
#'   `stats::quantile()`.
#' @param hdci_width Numeric. Width of the HDCI when `cutoff_method = "hdci"`.
#'   Default is `0.99` (99\% HDCI). Ignored when
#'   `cutoff_method = "quantile"`.
#'
#' @return A list with components:
#' \describe{
#'   \item{`results`}{data.frame with columns `iteration`, `Item1`, `Item2`,
#'     and `gamma` (one row per item pair per successful iteration). Contains
#'     results from direction 1 only (rest score = total - Item2), which is
#'     the conventional direction.}
#'   \item{`pair_cutoffs`}{data.frame with per-pair cutoff summaries: `Item1`,
#'     `Item2`, `gamma_low`, `gamma_high`. Bounds are computed using the method
#'     specified by `cutoff_method`.}
#'   \item{`actual_iterations`}{Number of successful iterations.}
#'   \item{`sample_n`}{Number of complete cases used.}
#'   \item{`sample_n_total`}{Number of respondents in the raw input data,
#'     before the complete-case filter.}
#'   \item{`sample_has_na`}{Logical. Whether the raw input data contained
#'     any missing values.}
#'   \item{`sample_summary`}{Summary statistics of estimated person
#'     parameters.}
#'   \item{`item_names`}{Character vector of item names from data.}
#'   \item{`cutoff_method`}{The method used to compute cutoffs (`"hdci"` or
#'     `"quantile"`).}
#'   \item{`hdci_width`}{The HDCI width used (only meaningful when
#'     `cutoff_method = "hdci"`).}
#' }
#'
#' @details
#' For each simulation iteration the function:
#' \enumerate{
#'   \item Resamples person parameters (thetas) with replacement from the
#'     WLE person locations.
#'   \item Simulates item response data under a Rasch model (dichotomous via
#'     `psychotools::rrm()` or polytomous via an internal partial credit
#'     simulator).
#'   \item Computes partial gamma LD statistics via
#'     `iarm::partgam_LD()`.
#' }
#'
#' Because the data are simulated under the Rasch model, items are locally
#' independent by construction. The distribution of partial gamma values
#' across iterations provides empirical critical values per item pair. Values
#' from real data that fall outside these bounds suggest local dependence that
#' exceeds what would be expected by chance. Failed iterations (e.g., due to
#' convergence issues or degenerate data) are silently discarded.
#'
#' The generating model uses CML item thresholds via `psychotools::pcmodel()`
#' (a dichotomous item is a 2-category PCM) and WLE person locations,
#' consistent with the rest of the package; responses are simulated with
#' `psychotools::rrm()` (dichotomous) or an internal partial credit score
#' simulator (polytomous).
#'
#' Parallel processing is provided by the `mirai` package (optional). Install
#' it with `install.packages("mirai")` to enable parallelisation.
#'
#' The `iarm` package must be installed (it is in Suggests, not Imports).
#'
#' @references
#' Christensen, K. B., Kreiner, S. & Mesbah, M. (Eds.) (2013).
#' \emph{Rasch Models in Health}, pp. 133--135. ISTE & Wiley.
#' \doi{10.1002/9781118574454}
#'
#' @seealso \code{\link[iarm]{partgam_LD}}, \code{\link{RMlocdepGamma}},
#'   \code{\link{RMlocdepGammaPlot}}
#'
#' @export
#'
#' @examples
#' \donttest{
#' if (requireNamespace("iarm", quietly = TRUE) &&
#'     requireNamespace("ggdist", quietly = TRUE)) {
#'   set.seed(42)
#'   sim_data <- as.data.frame(
#'     matrix(sample(0:1, 200 * 10, replace = TRUE), nrow = 200, ncol = 10)
#'   )
#'   colnames(sim_data) <- paste0("Item", 1:10)
#'
#'   # Run 100 iterations sequentially for a quick demo
#'   cutoff_res <- RMlocdepGammaCutoff(sim_data, iterations = 100,
#'                                     parallel = FALSE, seed = 42)
#'   cutoff_res$pair_cutoffs
#' }
#' }
RMlocdepGammaCutoff <- function(
  data,
  iterations = 250,
  parallel = TRUE,
  n_cores = NULL,
  verbose = FALSE,
  seed = NULL,
  cutoff_method = "hdci",
  hdci_width = 0.99
) {
  cutoff_method <- match.arg(cutoff_method, c("hdci", "quantile"))

  if (cutoff_method == "hdci" && !requireNamespace("ggdist", quietly = TRUE)) {
    stop(
      "Package 'ggdist' is required when cutoff_method = \"hdci\" but is not installed.\n",
      "Install it with: install.packages(\"ggdist\")\n",
      "Alternatively, use cutoff_method = \"quantile\" to avoid this dependency.",
      call. = FALSE
    )
  }

  if (!requireNamespace("iarm", quietly = TRUE)) {
    stop(
      "Package 'iarm' is required for RMlocdepGammaCutoff() but is not installed.\n",
      "Install it with: install.packages(\"iarm\")",
      call. = FALSE
    )
  }

  validate_response_data(data)

  # rgl workaround (iarm depends on vcdExtra -> rgl)
  old_rgl <- getOption("rgl.useNULL")
  options(rgl.useNULL = TRUE)
  on.exit(options(rgl.useNULL = old_rgl), add = TRUE)

  # Only complete cases. Record the raw total and whether anything was
  # dropped so callers (e.g. RMlocdepGammaPlot) can report the sample in the
  # standard `n = X of Y respondents` form.
  n_total <- nrow(data)
  has_na <- anyNA(data)
  complete_idx <- stats::complete.cases(data)
  data <- data[complete_idx, , drop = FALSE]

  if (nrow(data) == 0L) {
    stop(
      "No complete cases in data after removing rows with NA.",
      call. = FALSE
    )
  }

  # --- Parallel setup ---------------------------------------------------------
  use_parallel <- parallel && requireNamespace("mirai", quietly = TRUE)

  if (parallel && !use_parallel) {
    message(
      "Install 'mirai' package for parallel processing: install.packages(\"mirai\")"
    )
    message("Running sequentially...")
  }

  if (use_parallel) {
    if (is.null(n_cores)) {
      n_cores <- getOption("mc.cores")
    }
    if (is.null(n_cores)) {
      warning(
        paste0(
          "For parallel processing, specify n_cores or set options(mc.cores = N).\n",
          "(Use `parallel::detectCores()` to see how many cores are available.)\n",
          "Falling back to sequential (single core) processing."
        ),
        call. = FALSE
      )
      use_parallel <- FALSE
    } else {
      n_cores <- min(n_cores, iterations)
    }
  }

  if (!is.null(seed)) {
    set.seed(seed)
  }

  # Generate per-iteration seeds
  sim_seeds <- sample.int(.Machine$integer.max, iterations)

  data_mat <- as.matrix(data)
  sample_n <- nrow(data_mat)
  is_polytomous <- max(data_mat, na.rm = TRUE) > 1L

  item_names_vec <- colnames(data_mat)

  # Generating model: CML item thresholds (psychotools) + WLE person locations,
  # consistent with the rest of the package, replacing eRm CML +
  # eRm::person.parameter() (MLE). Thetas form the pool resampled with
  # replacement to build each simulated dataset; a dichotomous item is a
  # 2-category PCM, so its centred threshold is the item difficulty for rrm().
  pool <- .wle_theta_pool(data_mat)
  thr_list <- pool$thr_list
  thetas <- pool$thetas

  if (is_polytomous) {
    sim_data_list <- list(
      type = "polytomous",
      thetas = thetas,
      deltaslist = thr_list,
      n_items = ncol(data_mat),
      sample_n = sample_n,
      item_names = item_names_vec
    )
  } else {
    sim_data_list <- list(
      type = "dichotomous",
      thetas = thetas,
      item_params = unlist(thr_list, use.names = FALSE),
      n_items = ncol(data_mat),
      sample_n = sample_n,
      item_names = item_names_vec
    )
  }

  if (use_parallel) {
    results_raw <- run_partgam_LD_sim_parallel(
      iterations,
      sim_seeds,
      sim_data_list,
      n_cores,
      verbose
    )
  } else {
    results_raw <- run_partgam_LD_sim_sequential(
      iterations,
      sim_seeds,
      sim_data_list,
      verbose
    )
  }

  # Filter out failures (character strings indicate errors)
  ok <- vapply(results_raw, is.data.frame, logical(1L))
  successful <- results_raw[ok]

  if (length(successful) == 0L) {
    stop("All simulation iterations failed. Check your data.", call. = FALSE)
  }

  actual_iterations <- length(successful)

  # Combine per-iteration data.frames
  iter_dfs <- lapply(seq_along(successful), function(i) {
    df <- successful[[i]]
    df$iteration <- i
    df
  })
  results_df <- do.call(rbind, iter_dfs)
  rownames(results_df) <- NULL

  # Compute per-pair cutoffs
  pair_keys <- unique(paste(results_df$Item1, results_df$Item2, sep = "___"))
  pair_cutoffs <- do.call(
    rbind,
    lapply(pair_keys, function(pk) {
      parts <- strsplit(pk, "___", fixed = TRUE)[[1]]
      sub <- results_df[
        results_df$Item1 == parts[1] & results_df$Item2 == parts[2],
      ]
      if (cutoff_method == "hdci") {
        gamma_interval <- ggdist::hdci(sub$gamma, .width = hdci_width)
        data.frame(
          Item1 = parts[1],
          Item2 = parts[2],
          gamma_low = gamma_interval[1L, 1L],
          gamma_high = gamma_interval[1L, 2L],
          stringsAsFactors = FALSE,
          row.names = NULL
        )
      } else {
        data.frame(
          Item1 = parts[1],
          Item2 = parts[2],
          gamma_low = stats::quantile(sub$gamma, 0.025, na.rm = TRUE),
          gamma_high = stats::quantile(sub$gamma, 0.975, na.rm = TRUE),
          stringsAsFactors = FALSE,
          row.names = NULL
        )
      }
    })
  )
  rownames(pair_cutoffs) <- NULL

  list(
    results = results_df,
    pair_cutoffs = pair_cutoffs,
    actual_iterations = actual_iterations,
    sample_n = sample_n,
    sample_n_total = n_total,
    sample_has_na = has_na,
    sample_summary = summary(thetas),
    item_names = item_names_vec,
    cutoff_method = cutoff_method,
    hdci_width = hdci_width
  )
}

# ---------------------------------------------------------------------------
# Internal: single simulation iteration
# ---------------------------------------------------------------------------

#' Run a single partial gamma LD simulation iteration
#'
#' @param seed Integer seed for reproducibility.
#' @param data_list List produced inside [RMlocdepGammaCutoff()].
#' @return A data.frame with columns `Item1`, `Item2`, and `gamma`, or a
#'   character string on failure.
#' @keywords internal
run_single_partgam_LD_sim <- function(seed, data_list) {
  set.seed(seed)

  thetas_res <- sample(
    data_list$thetas,
    size = data_list$sample_n,
    replace = TRUE
  )

  tryCatch(
    {
      if (data_list$type == "dichotomous") {
        sim_mat <- psychotools::rrm(
          theta = thetas_res,
          beta = data_list$item_params
        )
        sim_df <- as.data.frame(sim_mat$data)
        colnames(sim_df) <- data_list$item_names

        pos_counts <- colSums(sim_df, na.rm = TRUE)
        if (any(pos_counts < 8L)) {
          return(
            "validation_failed: fewer than 8 positive responses in at least one item"
          )
        }
      } else {
        sim_mat <- sim_partial_score(data_list$deltaslist, thetas_res)
        sim_df <- as.data.frame(sim_mat)
        colnames(sim_df) <- data_list$item_names

        n_cats <- vapply(
          data_list$deltaslist,
          function(d) length(d) + 1L,
          integer(1L)
        )
        for (j in seq_len(ncol(sim_df))) {
          tab <- tabulate(sim_df[[j]] + 1L, nbins = n_cats[j])
          if (any(tab == 0L)) {
            return("validation_failed: not all categories represented")
          }
        }
      }

      # Compute partial gamma LD via iarm.
      # iarm::partgam_LD() prints its result tables to stdout on every call;
      # silence it. `finally` restores the sink even if the call errors (the
      # outer tryCatch then reports the failure as usual).
      sink(nullfile())
      pgam <- tryCatch(
        iarm::partgam_LD(sim_df),
        finally = sink()
      )

      # Use direction 1 (rest score = total - Item2) as the canonical direction
      pgam_df <- as.data.frame(pgam[[1]])

      data.frame(
        Item1 = as.character(pgam_df$Item1),
        Item2 = as.character(pgam_df$Item2),
        gamma = as.numeric(pgam_df$gamma),
        stringsAsFactors = FALSE,
        row.names = NULL
      )
    },
    error = function(e) {
      as.character(conditionMessage(e))
    }
  )
}

# ---------------------------------------------------------------------------
# Internal: parallel runner
# ---------------------------------------------------------------------------

#' Run partial gamma LD simulations in parallel using mirai
#'
#' @param iterations Number of iterations.
#' @param sim_seeds Integer vector of per-iteration seeds.
#' @param sim_data_list List of data passed to each worker.
#' @param n_cores Number of mirai daemons.
#' @param verbose Show progress bar.
#' @return List of raw results (one element per iteration).
#' @keywords internal
run_partgam_LD_sim_parallel <- function(
  iterations,
  sim_seeds,
  sim_data_list,
  n_cores,
  verbose = FALSE
) {
  mirai::daemons(n_cores)
  on.exit(mirai::daemons(0), add = TRUE)

  if (verbose) {
    message(sprintf("Starting %d daemons...", n_cores))
    pb <- utils::txtProgressBar(min = 0, max = iterations, style = 3)
    completed <- 0L
  }

  # Submit all tasks
  tasks <- lapply(seq_len(iterations), function(sim) {
    mirai::mirai(
      {
        run_single_partgam_LD_sim(seed, data_list)
      },
      seed = sim_seeds[sim],
      data_list = sim_data_list,
      run_single_partgam_LD_sim = run_single_partgam_LD_sim,
      sim_partial_score = sim_partial_score,
      sim_poly_item = sim_poly_item
    )
  })

  # Collect results
  results <- vector("list", iterations)
  for (sim in seq_len(iterations)) {
    result <- mirai::call_mirai(tasks[[sim]])$data
    if (!inherits(result, "errorValue")) {
      results[[sim]] <- result
    } else {
      results[[sim]] <- "mirai_error"
    }
    if (verbose) {
      completed <- completed + 1L
      utils::setTxtProgressBar(pb, completed)
    }
  }

  if (verbose) {
    close(pb)
    message("")
  }

  results
}

# ---------------------------------------------------------------------------
# Internal: sequential runner
# ---------------------------------------------------------------------------

#' Run partial gamma LD simulations sequentially
#'
#' @param iterations Number of iterations.
#' @param sim_seeds Integer vector of per-iteration seeds.
#' @param sim_data_list List of data passed to each worker.
#' @param verbose Show progress bar.
#' @return List of raw results (one element per iteration).
#' @keywords internal
run_partgam_LD_sim_sequential <- function(
  iterations,
  sim_seeds,
  sim_data_list,
  verbose = FALSE
) {
  if (verbose) {
    pb <- utils::txtProgressBar(min = 0, max = iterations, style = 3)
  }

  results <- vector("list", iterations)
  for (sim in seq_len(iterations)) {
    results[[sim]] <- run_single_partgam_LD_sim(sim_seeds[sim], sim_data_list)
    if (verbose) {
      utils::setTxtProgressBar(pb, sim)
    }
  }

  if (verbose) {
    close(pb)
    message("")
  }

  results
}

#' Plot Distribution of Simulated Partial Gamma LD Values
#'
#' Visualises the distribution of simulation-based partial gamma LD values
#' from \code{\link{RMlocdepGammaCutoff}}, optionally overlaying observed partial
#' gamma values computed from real data via \code{\link[iarm]{partgam_LD}}.
#'
#' Uses `ggdist::stat_dotsinterval()` (when `data` is not supplied) or
#' `ggdist::stat_dots()` (when `data` is supplied) with
#' `point_interval = "median_hdci"` and `.width = c(0.66, 0.95, 0.99)`.
#'
#' @param simfit The return value of \code{\link{RMlocdepGammaCutoff}} (a list with
#'   components `results`, `pair_cutoffs`, `actual_iterations`, `sample_n`, and
#'   `item_names`).
#' @param data Optional. A data.frame or matrix of item responses for computing
#'   and overlaying observed partial gamma values. Items must be scored starting
#'   at 0 (non-negative integers). When provided, the plot includes orange
#'   diamond markers for the observed partial gamma alongside the simulated
#'   distribution, plus segment summaries from the cutoff intervals.
#' @param items Optional character vector of item names to include in the plot.
#'   Only item pairs where **both** items are in this vector will be shown. When
#'   `NULL` (default), all item pairs are plotted.
#' @param n_pairs Optional positive integer. When supplied, only the
#'   `n_pairs` item pairs with the largest absolute partial gamma values
#'   are plotted, sorted by `|gamma|` descending. When `data` is
#'   supplied, the ranking uses the *observed* partial gammas (the
#'   diamonds you actually want to interpret); otherwise it falls back
#'   to the per-pair median of the simulated distributions. Applied
#'   *after* the `items` filter when both are supplied. Values larger
#'   than the number of available pairs are silently capped.
#'
#' @return A `ggplot` object.
#'
#' @details
#' The plot shows one row per item pair (labelled as "Item1 - Item2"). Only
#' direction 1 (rest score = total - Item2) is plotted, matching the
#' convention used in the simulation.
#'
#' When `data` is **not** supplied, the function plots the simulated partial
#' gamma distributions as dot-interval plots using
#' `ggdist::stat_dotsinterval()` with median and Highest Density Continuous
#' Interval (HDCI) summaries.
#'
#' When `data` **is** supplied, the function:
#' \enumerate{
#'   \item Computes observed partial gamma values via
#'     `iarm::partgam_LD()`.
#'   \item Overlays observed gamma values as orange diamond markers on the
#'     simulated distributions.
#'   \item Shows per-pair cutoff intervals (from `simfit$pair_cutoffs`) as
#'     black line segments, with thicker segments for the 66\% interval and
#'     black dots for the median.
#' }
#'
#' The `ggplot2`, `ggdist`, and optionally `iarm` packages must be installed
#' (they are in Suggests, not Imports).
#'
#' @seealso \code{\link{RMlocdepGammaCutoff}}, \code{\link{RMlocdepGamma}}
#'
#' @importFrom rlang .data
#' @export
#'
#' @examples
#' \donttest{
#' if (requireNamespace("iarm", quietly = TRUE) &&
#'     requireNamespace("ggdist", quietly = TRUE) &&
#'     requireNamespace("ggplot2", quietly = TRUE)) {
#'   set.seed(42)
#'   sim_data <- as.data.frame(
#'     matrix(sample(0:1, 200 * 10, replace = TRUE), nrow = 200, ncol = 10)
#'   )
#'   colnames(sim_data) <- paste0("Item", 1:10)
#'
#'   # Run simulation
#'   cutoff_res <- RMlocdepGammaCutoff(sim_data, iterations = 100,
#'                                     parallel = FALSE, seed = 42)
#'
#'   # Simulated distribution only
#'   RMlocdepGammaPlot(cutoff_res)
#'
#'   # With observed partial gamma overlaid
#'   RMlocdepGammaPlot(cutoff_res, data = sim_data)
#'
#'   # Plot only a subset of items
#'   RMlocdepGammaPlot(cutoff_res, data = sim_data,
#'                     items = c("Item1", "Item2", "Item3"))
#' }
#' }
RMlocdepGammaPlot <- function(simfit, data, items = NULL, n_pairs = NULL) {
  # --- Check required packages ------------------------------------------------
  if (!requireNamespace("ggplot2", quietly = TRUE)) {
    stop(
      "Package 'ggplot2' is required for RMlocdepGammaPlot() but is not installed.\n",
      "Install it with: install.packages(\"ggplot2\")",
      call. = FALSE
    )
  }
  if (!requireNamespace("ggdist", quietly = TRUE)) {
    stop(
      "Package 'ggdist' is required for RMlocdepGammaPlot() but is not installed.\n",
      "Install it with: install.packages(\"ggdist\")",
      call. = FALSE
    )
  }

  # --- Validate simfit --------------------------------------------------------
  required_names <- c(
    "results",
    "pair_cutoffs",
    "actual_iterations",
    "sample_n",
    "item_names"
  )
  missing_names <- setdiff(required_names, names(simfit))
  if (length(missing_names) > 0L) {
    stop(
      "`simfit` is missing required components: ",
      paste(missing_names, collapse = ", "),
      ".\nExpected the return value of RMlocdepGammaCutoff().",
      call. = FALSE
    )
  }

  results_df <- simfit$results
  pair_cutoffs <- simfit$pair_cutoffs
  actual_iterations <- simfit$actual_iterations
  sample_n <- simfit$sample_n
  item_names <- simfit$item_names

  # Standard sample-size clause for the (complete-case) simulation sample.
  # `sample_n_total` / `sample_has_na` are absent in cutoff objects made by
  # older versions, so fall back to the plain count.
  sample_clause <- .n_caption(
    sample_n,
    if (is.null(simfit$sample_n_total)) sample_n else simfit$sample_n_total,
    if (isTRUE(simfit$sample_has_na)) "complete cases" else character()
  )

  # --- Validate items parameter -----------------------------------------------
  if (!is.null(items)) {
    unknown_items <- setdiff(items, item_names)
    if (length(unknown_items) > 0L) {
      stop(
        "Unknown item(s) in `items`: ",
        paste(unknown_items, collapse = ", "),
        ".\nAvailable items: ",
        paste(item_names, collapse = ", "),
        call. = FALSE
      )
    }
    if (length(items) < 2L) {
      stop(
        "`items` must contain at least 2 item names to form a pair.",
        call. = FALSE
      )
    }
  }

  # --- Validate n_pairs parameter ---------------------------------------------
  if (!is.null(n_pairs)) {
    if (
      !is.numeric(n_pairs) ||
        length(n_pairs) != 1L ||
        !is.finite(n_pairs) ||
        n_pairs < 1 ||
        n_pairs != as.integer(n_pairs)
    ) {
      stop(
        "`n_pairs` must be a single positive integer or NULL.",
        call. = FALSE
      )
    }
    n_pairs <- as.integer(n_pairs)
  }

  # Create pair labels
  results_df$Pair <- paste(results_df$Item1, "-", results_df$Item2)
  pair_cutoffs$Pair <- paste(pair_cutoffs$Item1, "-", pair_cutoffs$Item2)

  # --- Filter to selected items -----------------------------------------------
  if (!is.null(items)) {
    keep <- results_df$Item1 %in% items & results_df$Item2 %in% items
    results_df <- results_df[keep, , drop = FALSE]
    keep_cut <- pair_cutoffs$Item1 %in% items & pair_cutoffs$Item2 %in% items
    pair_cutoffs <- pair_cutoffs[keep_cut, , drop = FALSE]

    if (nrow(results_df) == 0L) {
      stop("No item pairs remain after filtering by `items`.", call. = FALSE)
    }
  }

  # --- Compute observed partial gammas up-front (when data supplied) ----------
  # We pre-compute here so the `n_pairs` filter below can rank by observed
  # |gamma| when data are available. The result is reused in Case 2.
  observed_df <- NULL
  if (!missing(data)) {
    if (!requireNamespace("iarm", quietly = TRUE)) {
      stop(
        "Package 'iarm' is required to compute observed partial gamma but is not installed.\n",
        "Install it with: install.packages(\"iarm\")",
        call. = FALSE
      )
    }
    validate_response_data(data)

    old_rgl <- getOption("rgl.useNULL")
    options(rgl.useNULL = TRUE)
    on.exit(options(rgl.useNULL = old_rgl), add = TRUE)

    sink(nullfile())
    pgam_raw <- iarm::partgam_LD(as.data.frame(data))
    sink()

    observed_df <- data.frame(
      Item1 = as.character(pgam_raw[[1L]]$Item1),
      Item2 = as.character(pgam_raw[[1L]]$Item2),
      observed_gamma = as.numeric(pgam_raw[[1L]]$gamma),
      stringsAsFactors = FALSE
    )
    observed_df$Pair <- paste(observed_df$Item1, "-", observed_df$Item2)

    if (!is.null(items)) {
      keep_obs <- observed_df$Item1 %in% items & observed_df$Item2 %in% items
      observed_df <- observed_df[keep_obs, , drop = FALSE]
    }
  }

  # --- Apply n_pairs top-N filter ---------------------------------------------
  if (!is.null(n_pairs)) {
    if (!is.null(observed_df)) {
      # Rank by |observed gamma| — the diamonds the user wants to interpret
      ord <- order(abs(observed_df$observed_gamma), decreasing = TRUE)
      keep_n <- min(n_pairs, nrow(observed_df))
      keep_pairs <- observed_df$Pair[ord[seq_len(keep_n)]]
      observed_df <- observed_df[
        observed_df$Pair %in% keep_pairs,
        ,
        drop = FALSE
      ]
    } else {
      # Rank by |median simulated gamma| per pair
      pair_names_all <- unique(results_df$Pair)
      med_g <- vapply(
        pair_names_all,
        function(pp) {
          stats::median(results_df$gamma[results_df$Pair == pp], na.rm = TRUE)
        },
        numeric(1L)
      )
      ord <- order(abs(med_g), decreasing = TRUE)
      keep_n <- min(n_pairs, length(pair_names_all))
      keep_pairs <- pair_names_all[ord[seq_len(keep_n)]]
    }
    results_df <- results_df[results_df$Pair %in% keep_pairs, , drop = FALSE]
    pair_cutoffs <- pair_cutoffs[
      pair_cutoffs$Pair %in% keep_pairs,
      ,
      drop = FALSE
    ]
    # Use the ranked order for y-axis: largest |gamma| at the top
    pair_levels <- rev(keep_pairs)
  } else {
    pair_levels <- rev(unique(results_df$Pair))
  }

  # --- Compute per-pair summary intervals for segment overlays ----------------
  pair_names <- unique(results_df$Pair)
  lo_hi <- do.call(
    rbind,
    lapply(pair_names, function(pair) {
      sub <- results_df[results_df$Pair == pair, ]
      data.frame(
        Pair = pair,
        min_gamma = stats::quantile(sub$gamma, 0.005, na.rm = TRUE),
        max_gamma = stats::quantile(sub$gamma, 0.995, na.rm = TRUE),
        p66lo_gamma = stats::quantile(sub$gamma, 0.167, na.rm = TRUE),
        p66hi_gamma = stats::quantile(sub$gamma, 0.833, na.rm = TRUE),
        median_gamma = stats::median(sub$gamma, na.rm = TRUE),
        stringsAsFactors = FALSE,
        row.names = NULL
      )
    })
  )
  rownames(lo_hi) <- NULL

  # --- Case 1: no observed data, show simulation distribution only ------------
  if (missing(data)) {
    results_plot <- data.frame(
      Pair = results_df$Pair,
      Value = results_df$gamma,
      stringsAsFactors = FALSE
    )
    results_plot$Pair <- factor(results_plot$Pair, levels = pair_levels)

    p <- ggplot2::ggplot(
      results_plot,
      ggplot2::aes(
        x = .data$Value,
        y = .data$Pair
      )
    ) +
      ggdist::stat_dotsinterval(
        ggplot2::aes(slab_fill = ggplot2::after_stat(.data$level)),
        quantiles = actual_iterations,
        point_interval = "median_hdci",
        layout = "weave",
        slab_color = NA,
        .width = c(0.66, 0.95, 0.99)
      ) +
      ggplot2::geom_vline(
        xintercept = 0,
        linetype = "dashed",
        color = "grey50",
        linewidth = 0.4
      ) +
      ggplot2::labs(
        x = "Partial gamma",
        y = "Item pair",
        caption = er2_caption(paste0(
          "Results from ",
          actual_iterations,
          " simulated datasets (no true local dependence). ",
          sample_clause,
          " per dataset."
        ))
      ) +
      ggplot2::scale_color_manual(
        values = scales::brewer_pal()(3),
        aesthetics = "slab_fill",
        guide = "none"
      ) +
      ggplot2::theme_minimal() +
      ggplot2::theme(panel.spacing = ggplot2::unit(0.7, "cm")) +
      er2_axis_margins() +
      er2_plot_caption()

    return(p)
  }

  # --- Case 2: observed data supplied -----------------------------------------
  # (`observed_df` was pre-computed above so the n_pairs filter could rank
  # by |observed gamma|.)

  # --- Build plot data --------------------------------------------------------
  gamma_sim <- data.frame(
    Pair = results_df$Pair,
    Value = results_df$gamma,
    stringsAsFactors = FALSE
  )
  gamma_sim <- merge(
    gamma_sim,
    observed_df[, c("Pair", "observed_gamma")],
    by = "Pair",
    sort = FALSE
  )
  gamma_sim$Pair <- factor(gamma_sim$Pair, levels = pair_levels)

  lo_hi$Pair_f <- factor(lo_hi$Pair, levels = pair_levels)

  caption_text <- er2_caption(paste0(
    "Results from ",
    actual_iterations,
    " simulated datasets. ",
    sample_clause,
    " per dataset.\n",
    "Orange diamonds indicate observed partial gamma LD. ",
    "Black dots indicate median gamma from simulations."
  ))

  p <- ggplot2::ggplot(
    gamma_sim,
    ggplot2::aes(
      x = .data$Value,
      y = .data$Pair
    )
  ) +
    ggdist::stat_dots(
      ggplot2::aes(slab_fill = ggplot2::after_stat(.data$level)),
      quantiles = actual_iterations,
      layout = "weave",
      slab_color = NA,
      .width = c(0.66, 0.95, 0.99)
    ) +
    ggplot2::geom_segment(
      data = lo_hi,
      ggplot2::aes(
        x = .data$min_gamma,
        xend = .data$max_gamma,
        y = .data$Pair_f,
        yend = .data$Pair_f
      ),
      color = "black",
      linewidth = 0.7
    ) +
    ggplot2::geom_segment(
      data = lo_hi,
      ggplot2::aes(
        x = .data$p66lo_gamma,
        xend = .data$p66hi_gamma,
        y = .data$Pair_f,
        yend = .data$Pair_f
      ),
      color = "black",
      linewidth = 1.2
    ) +
    ggplot2::geom_point(
      data = lo_hi,
      ggplot2::aes(
        x = .data$median_gamma,
        y = .data$Pair_f
      ),
      size = 3.6
    ) +
    ggplot2::geom_point(
      ggplot2::aes(x = .data$observed_gamma),
      color = "sienna2",
      shape = 18,
      position = ggplot2::position_nudge(y = -0.1),
      size = 4
    ) +
    ggplot2::labs(
      x = "Partial gamma",
      y = "Item pair",
      caption = caption_text
    ) +
    ggplot2::scale_color_manual(
      values = scales::brewer_pal()(3),
      aesthetics = "slab_fill",
      guide = "none"
    ) +
    ggplot2::theme_minimal() +
    ggplot2::theme(panel.spacing = ggplot2::unit(0.7, "cm")) +
    er2_axis_margins() +
    er2_plot_caption()

  p
}
