R/S3print.R

In ForceChoice: Forced-Choice Modeling Based on Item Response Theory and Cognitive Diagnostic Models

#' @title S3 Methods: print
#'
#' @description
#' Provides user-friendly, formatted console output for objects generated by
#' the \pkg{ForceChoice} package. This generic function dispatches to
#' class-specific methods that display concise summaries of fitted models,
#' simulation datasets, goodness-of-fit indices, and rotated solutions.
#' Designed for interactive use and quick diagnostic inspection.
#'
#' @param x An object of one of the following classes:
#'   \itemize{
#'     \item Fitted model objects: \code{\link[ForceChoice]{fit.MIRT}}
#'       (\code{"MIRT"}), \code{\link[ForceChoice]{fit.MGPCM}}
#'       (\code{"MGPCM"}), \code{\link[ForceChoice]{fit.MGGUM}}
#'       (\code{"MGGUM"}), \code{\link[ForceChoice]{fit.FCMIRT}}
#'       (\code{"FCMIRT"}), \code{\link[ForceChoice]{fit.FCDCM}}
#'       (\code{"FCDCM"}), \code{\link[ForceChoice]{fit.FCGGUM}}
#'       (\code{"FCGGUM"}), \code{\link[ForceChoice]{fit.TIRT}}
#'       (\code{"TIRT"})
#'     \item Goodness-of-fit objects: \code{\link[ForceChoice]{good.of.fit}}
#'       (\code{"good.of.fit"})
#'     \item Summary objects: \code{summary.MIRT}, \code{summary.MGPCM},
#'       \code{summary.MGGUM}, \code{summary.FCMIRT}, \code{summary.FCDCM},
#'       \code{summary.FCGGUM}, \code{summary.TIRT},
#'       \code{summary.good.of.fit}
#'   }
#' @param ... Additional arguments passed to methods (currently ignored in
#'   most cases).
#' @param digits Number of decimal places for numeric output (default: 4).
#'   Used by \code{print.good.of.fit}.
#'
#' @return Invisibly returns the input object \code{x}. No data is modified.
#'
#' @details
#' Each method produces a structured, human-readable summary optimized for
#' its object type:
#'
#' \describe{
#'   \item{\strong{Fitted Model Objects}}{
#'     Invokes \code{summary()} internally and prints comprehensive output
#'     including:
#'     \itemize{
#'       \item Model call and configuration (family, method, dimensions)
#'       \item Data characteristics (N, I or B, response type)
#'       \item Fit statistics (LogLik, npar, AIC, BIC)
#'       \item Factor correlation matrix
#'       \item Person parameter summary (N x D)
#'       \item Item / statement / block parameter summary
#'       \item For FCDCM: higher-order delta parameters and classification
#'             diagnostics
#'       \item For TIRT: loading (lambda) parameter summary
#'       \item Convergence diagnostics (algorithm, batches, latent grid length L)
#'     }
#'   }
#'
#'   \item{\strong{Goodness-of-Fit Objects (\code{good.of.fit})}}{
#'     Delegates to \code{summary.good.of.fit} and prints:
#'     \itemize{
#'       \item Overview table (sample size, items, parameters, moments)
#'       \item Limited-information absolute fit (M2, RMSEA, SRMSR)
#'       \item Incremental / comparative fit (CFI, TLI, IFI)
#'       \item Likelihood and information criteria (AIC, BIC, SABIC, CAIC)
#'       \item Pseudo-\eqn{R^2} measures
#'     }
#'   }
#' }
#'
#' @section Output Conventions:
#' \itemize{
#'   \item Numeric values are rounded to the precision specified by
#'         \code{digits} (default 4).
#'   \item Parameter summary tables show Min, Q1, Median, Mean, Q3, Max
#'         across items/statements for each parameter type.
#'   \item Convergence diagnostics adapt to the estimation backend
#'         (iStEM batch diagnostics vs. Stan HMC notes).
#' }
#'
#' @name print
NULL

# ===========================================================================
# Internal display helpers
# ===========================================================================

.fc_print_header <- function(title) {
  cat("\n==============================================\n")
  cat(title, "\n", sep = "")
  cat("==============================================\n\n")
}

.fc_print_matrix <- function(mat, digits, indent = "  ") {
  if (is.null(mat) || length(mat) == 0L) return(invisible(NULL))
  m <- as.matrix(mat)
  if (nrow(m) == 0L || ncol(m) == 0L) return(invisible(NULL))
  fm <- format(round(m, digits), nsmall = digits, justify = "right")
  rn <- rownames(m)
  cn <- colnames(m)

  # ---- compute column widths for proper alignment ----
  row_label_width <- if (!is.null(rn)) max(nchar(rn), na.rm = TRUE) else 0L
  if (row_label_width < 5L) row_label_width <- 5L

  col_widths <- integer(ncol(m))
  if (!is.null(cn)) {
    col_widths <- pmax(col_widths, nchar(cn))
  }
  for (j in seq_len(ncol(m))) {
    col_widths[j] <- max(col_widths[j], max(nchar(fm[, j]), na.rm = TRUE))
  }
  # ensure minimum width of 5 per column
  col_widths <- pmax(col_widths, 5L)

  # ---- print column header ----
  if (!is.null(cn)) {
    header <- sprintf("%-*s", row_label_width, "")
    for (j in seq_len(ncol(m))) {
      header <- paste0(header, "  ", sprintf("%*s", col_widths[j], cn[j]))
    }
    cat(indent, header, "\n", sep = "")
  }

  # ---- print separator line ----
  sep_line <- paste0(indent, paste(rep(" ", row_label_width), collapse = ""))
  for (j in seq_len(ncol(m))) {
    sep_line <- paste0(sep_line, "  ", paste(rep("-", col_widths[j]), collapse = ""))
  }
  cat(sep_line, "\n", sep = "")

  # ---- print data rows ----
  for (i in seq_len(nrow(m))) {
    row_label <- if (!is.null(rn)) rn[i] else ""
    line <- sprintf("%s%-*s", indent, row_label_width, row_label)
    for (j in seq_len(ncol(m))) {
      line <- paste0(line, "  ", sprintf("%*s", col_widths[j], fm[i, j]))
    }
    cat(line, "\n", sep = "")
  }
}

.fc_print_convergence <- function(conv) {
  if (is.null(conv) || length(conv) == 0L) return(invisible(NULL))
  cat("\nConvergence:\n")
  cat(sprintf("  Algorithm: %s\n", conv$algorithm))
  if (!is.null(conv$note)) {
    cat(sprintf("  Note: %s\n", conv$note))
  }
  if (!is.null(conv$burn_in_batches)) {
    cat(sprintf("  Burn-in Batches: %s\n", conv$burn_in_batches))
  }
  if (!is.null(conv$total_batches)) {
    cat(sprintf("  Total Batches: %s\n", conv$total_batches))
  }
  if (!is.null(conv$iterations)) {
    cat(sprintf("  Iterations: %s\n", conv$iterations))
  }
  if (!is.null(conv$burnin_converged)) {
    cat(sprintf("  Burn-in Converged: %s\n", as.character(conv$burnin_converged)))
  }
  if (!is.null(conv$final_converged)) {
    cat(sprintf("  Final Converged: %s\n", as.character(conv$final_converged)))
  }
  if (!is.null(conv$final_logLik) && is.finite(conv$final_logLik)) {
    cat(sprintf("  Final LogLik: %.4f\n", conv$final_logLik))
  }
  if (!is.null(conv$final_ll_change) && is.finite(conv$final_ll_change)) {
    cat(sprintf("  Final LogLik Change: %.6f\n", conv$final_ll_change))
  }
  if (!is.null(conv$final_max_delta_change) &&
      is.finite(conv$final_max_delta_change)) {
    cat(sprintf("  Final Max Delta Change: %.6f\n",
                conv$final_max_delta_change))
  }
  if (!is.null(conv$bootstrap_R) && conv$bootstrap_R > 0L) {
    cat(sprintf("  Bootstrap SE: %s / %s successful\n",
                conv$bootstrap_successful, conv$bootstrap_R))
  }
  if (!is.null(conv$L) && is.finite(conv$L)) {
    cat(sprintf("  Theta Grid L: %d\n", as.integer(conv$L)))
  }
}

# ===========================================================================
# Model print methods
#
# Convention: print.<Class>(x, ...) delegates to
# print.summary.<Class>(summary(x, ...)). The actual formatting is in the
# print.summary.<Class> methods below.
# ===========================================================================

# ---- good.of.fit ----

#' @describeIn print Print method for \code{good.of.fit} objects.
#'   Delegates to \code{summary.good.of.fit} and prints formatted tables.
#' @export
print.good.of.fit <- function(x, digits = 4, ...) {
  summ <- summary(x, digits = digits, ...)
  print(summ, ...)
  invisible(x)
}

#' @describeIn print Print method for \code{summary.good.of.fit} objects.
#'   Displays overview, absolute-fit, comparative-fit, likelihood/IC,
#'   and pseudo-\eqn{R^2} tables.
#' @export
print.summary.good.of.fit <- function(x, ...) {
  cat("\n")
  cat("Goodness-of-Fit Summary\n")
  cat("=======================\n")

  if (is.null(x$tables)) {
    return(.gof_print_legacy_summary(x))
  }

  if (!is.null(x$tables$Overview)) {
    .gof_print_overview(x$tables$Overview)
  }

  section.labels <- c(
    Absolute_Fit_M2        = "1. Limited-information Absolute Fit",
    Comparative_Fit        = "2. Incremental / Comparative Fit",
    Likelihood_and_IC      = "3. Likelihood & Information Criteria",
    Pseudo_R2              = "4. Pseudo-R2"
  )

  for (nm in names(section.labels)) {
    tab <- x$tables[[nm]]
    if (!is.null(tab) && nrow(tab) > 0L) {
      .gof_print_metric_table(section.labels[[nm]], tab)
    }
  }

  cat("Note: guide values are descriptive heuristics, not decision rules.\n")
  invisible(x)
}

# ---- MIRT ----

#' @describeIn print Print method for \code{MIRT} objects.
#'   Multidimensional IRT (1PL--4PL) model summary.
#' @export
print.MIRT <- function(x, ...) {
  print.summary.MIRT(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.MIRT} objects.
#'   Shows model config, data info, fit stats, factor correlations,
#'   person/item parameter summaries, and convergence.
#' @export
print.summary.MIRT <- function(x, ...) {
  d <- x$digits
  .fc_print_header("MULTIDIMENSIONAL IRT (MIRT) MODEL SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Model: %s\n", x$model.info$model))
  cat(sprintf("  Dimensions (D): %d\n", x$model.info$D))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Items (I): %d\n", x$data.info$I))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$Corr)) {
    cat("\nFactor Correlation Matrix:\n")
    .fc_print_matrix(x$Corr, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nPerson Parameter Summary (N x D):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$par.summary)) {
    cat("\nItem Parameter Summary:\n")
    .fc_print_matrix(x$par.summary, d)
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- MGPCM ----

#' @describeIn print Print method for \code{MGPCM} objects.
#'   Multidimensional Generalized Partial Credit Model summary.
#' @export
print.MGPCM <- function(x, ...) {
  print.summary.MGPCM(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.MGPCM} objects.
#'   Shows polytomous model config, fit stats, factor correlations,
#'   person/item parameter summaries, and convergence.
#' @export
print.summary.MGPCM <- function(x, ...) {
  d <- x$digits
  .fc_print_header("MULTIDIMENSIONAL GENERALIZED PARTIAL CREDIT MODEL (MGPCM) SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Dimensions (D): %d\n", x$model.info$D))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Items (I): %d\n", x$data.info$I))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$Corr)) {
    cat("\nFactor Correlation Matrix:\n")
    .fc_print_matrix(x$Corr, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nPerson Parameter Summary (N x D):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$par.summary)) {
    cat("\nItem Parameter Summary:\n")
    .fc_print_matrix(x$par.summary, d)
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- MGGUM ----

#' @describeIn print Print method for \code{MGGUM} objects.
#'   Multidimensional Generalized Graded Unfolding Model summary.
#' @export
print.MGGUM <- function(x, ...) {
  print.summary.MGGUM(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.MGGUM} objects.
#'   Shows unfolding model config, fit stats, factor correlations,
#'   person/item parameter summaries, and convergence.
#' @export
print.summary.MGGUM <- function(x, ...) {
  d <- x$digits
  .fc_print_header("MULTIDIMENSIONAL GENERALIZED GRADED UNFOLDING MODEL (MGGUM) SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Dimensions (D): %d\n", x$model.info$D))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Items (I): %d\n", x$data.info$I))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$Corr)) {
    cat("\nFactor Correlation Matrix:\n")
    .fc_print_matrix(x$Corr, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nPerson Parameter Summary (N x D):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$par.summary)) {
    cat("\nItem Parameter Summary:\n")
    .fc_print_matrix(x$par.summary, d)
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- FCMIRT ----

#' @describeIn print Print method for \code{FCMIRT} objects.
#'   Forced-Choice Multidimensional IRT model summary.
#' @export
print.FCMIRT <- function(x, ...) {
  print.summary.FCMIRT(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.FCMIRT} objects.
#'   Shows forced-choice model config with block info, fit stats,
#'   factor correlations, person/statement parameter summaries.
#' @export
print.summary.FCMIRT <- function(x, ...) {
  d <- x$digits
  .fc_print_header("FORCED-CHOICE MULTIDIMENSIONAL IRT (FCMIRT) MODEL SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Model: %s\n", x$model.info$model))
  cat(sprintf("  Dimensions (D): %d\n", x$model.info$D))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))
  cat(sprintf("  FC Type: %s\n", x$model.info$fc.type))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Blocks (B): %d\n", x$data.info$B))
  cat(sprintf("  Total Statements (I): %d\n", x$data.info$I))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$Corr)) {
    cat("\nFactor Correlation Matrix:\n")
    .fc_print_matrix(x$Corr, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nPerson Parameter Summary (N x D):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$par.summary)) {
    cat("\nStatement Parameter Summary:\n")
    .fc_print_matrix(x$par.summary, d)
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- FCDCM ----

#' @describeIn print Print method for \code{FCDCM} objects.
#'   Forced-Choice Diagnostic Classification Model summary with
#'   higher-order trait, attribute profiles, and classification diagnostics.
#' @export
print.FCDCM <- function(x, ...) {
  print.summary.FCDCM(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.FCDCM} objects.
#'   Shows higher-order delta parameters, block eta parameters,
#'   attribute classification summary, and convergence.
#' @export
print.summary.FCDCM <- function(x, ...) {
  d <- x$digits
  .fc_print_header("FORCED-CHOICE DIAGNOSTIC CLASSIFICATION MODEL (FCDCM) SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Attributes (D): %d\n", x$model.info$D))
  cat(sprintf("  DCM Type: %s\n", x$model.info$model))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Blocks (B): %d\n", x$data.info$B))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$delta.summary)) {
    cat("\nHigher-Order Parameters (delta):\n")
    .fc_print_matrix(x$delta.summary, d)
  }

  if (!is.null(x$par.summary)) {
    cat("\nBlock Parameters (eta):\n")
    .fc_print_matrix(x$par.summary, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nHigher-Order Trait Summary (N x 1):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$classification)) {
    cat("\nClassification:\n")
    cat(sprintf("  Observed Attribute Patterns: %s / %d possible\n",
                x$classification$n_patterns_observed,
                x$classification$n_patterns_possible))
    if (is.finite(x$classification$mean_max_posterior)) {
      cat(sprintf("  Mean Max Posterior: %.*f\n", d, x$classification$mean_max_posterior))
    }
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- FCGDINA ----

#' @describeIn print Print method for \code{FCGDINA} objects.
#'   Forced-Choice GDINA model summary.
#' @export
print.FCGDINA <- function(x, ...) {
  print.summary.FCGDINA(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.FCGDINA} objects.
#'   Shows CDM type, forced-choice block info, fit stats, delta summaries,
#'   posterior attribute probabilities, and convergence.
#' @export
print.summary.FCGDINA <- function(x, ...) {
  d <- x$digits
  .fc_print_header("FORCED-CHOICE GDINA (FCGDINA) MODEL SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  CDM Model: %s\n", x$model.info$model))
  cat(sprintf("  Attributes (D): %d\n", x$model.info$D))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))
  cat(sprintf("  FC Type: %s\n", x$model.info$fc.type))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Blocks (B): %d\n", x$data.info$B))
  cat(sprintf("  Total Statements (I): %d\n", x$data.info$I))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$delta.summary)) {
    cat("\nCDM Delta Parameter Summary:\n")
    .fc_print_matrix(x$delta.summary, d)
  }

  if (!is.null(x$alpha.summary)) {
    cat("\nPosterior Attribute Probability Summary (N x D):\n")
    .fc_print_matrix(x$alpha.summary, d)
  }

  if (!is.null(x$classification)) {
    cat("\nClassification:\n")
    cat(sprintf("  Observed Attribute Patterns: %s / %d possible\n",
                x$classification$n_patterns_observed,
                x$classification$n_patterns_possible))
    if (is.finite(x$classification$mean_max_posterior)) {
      cat(sprintf("  Mean Max Posterior Probability: %.*f\n",
                  d, x$classification$mean_max_posterior))
    }
  }

  if (!is.null(x$pi.stats)) {
    cat(sprintf("\nStructural Parameters (class proportions):\n"))
    cat(sprintf("  Non-zero classes: %d / %d\n",
                x$pi.stats$n_nonzero,
                x$classification$n_patterns_possible))
    cat(sprintf("  Range: [%.*f, %.*f]\n",
                d, x$pi.stats$min, d, x$pi.stats$max))
    cat(sprintf("  Entropy: %.*f\n", d, x$pi.stats$entropy))
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- FCGGUM ----

#' @describeIn print Print method for \code{FCGGUM} objects.
#'   Forced-Choice Generalized Graded Unfolding Model summary.
#' @export
print.FCGGUM <- function(x, ...) {
  print.summary.FCGGUM(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.FCGGUM} objects.
#'   Shows forced-choice unfolding model config, fit stats,
#'   factor correlations, person/statement parameter summaries.
#' @export
print.summary.FCGGUM <- function(x, ...) {
  d <- x$digits
  .fc_print_header("FORCED-CHOICE GENERALIZED GRADED UNFOLDING MODEL (FCGGUM) SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Dimensions (D): %d\n", x$model.info$D))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))
  cat(sprintf("  FC Type: %s\n", x$model.info$fc.type))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Blocks (B): %d\n", x$data.info$B))
  cat(sprintf("  Total Statements (I): %d\n", x$data.info$I))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$Corr)) {
    cat("\nFactor Correlation Matrix:\n")
    .fc_print_matrix(x$Corr, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nPerson Parameter Summary (N x D):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$par.summary)) {
    cat("\nStatement Parameter Summary:\n")
    .fc_print_matrix(x$par.summary, d)
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}

# ---- TIRT ----

#' @describeIn print Print method for \code{TIRT} objects.
#'   Thurstonian IRT for Forced-Choice model summary.
#' @export
print.TIRT <- function(x, ...) {
  print.summary.TIRT(summary(x, ...))
  invisible(x)
}

#' @describeIn print Print method for \code{summary.TIRT} objects.
#'   Shows pairwise-comparison model config, fit stats,
#'   factor correlations, loading/person parameter summaries.
#' @export
print.summary.TIRT <- function(x, ...) {
  d <- x$digits
  .fc_print_header("THURSTONIAN IRT FOR FORCED-CHOICE (TIRT) MODEL SUMMARY")

  cat("Call:\n  ", paste(deparse(x$call), collapse = "\n   "), "\n", sep = "")

  cat("\nModel Configuration:\n")
  cat(sprintf("  Family: %s\n", x$model.info$family))
  cat(sprintf("  Dimensions (D): %d\n", x$model.info$D))
  cat(sprintf("  Statements (I): %d\n", x$model.info$I.states))
  cat(sprintf("  Blocks: %d\n", x$model.info$N.block))
  cat(sprintf("  Estimation Method: %s\n", x$model.info$method))
  cat(sprintf("  FC Type: %s\n", x$model.info$fc.type))

  cat("\nData Characteristics:\n")
  cat(sprintf("  Sample Size (N): %d\n", x$data.info$N))
  cat(sprintf("  Pairwise Responses: %d\n", x$data.info$I.pairs))
  cat(sprintf("  Statements: %d\n", x$data.info$I.states))
  cat(sprintf("  Response Type: %s\n", x$data.info$response.type))

  cat("\nFit Statistics:\n")
  cat(sprintf("  Log-likelihood: %.*f\n", d, x$fit.stats$LogLik))
  cat(sprintf("  Free Parameters: %d\n", x$fit.stats$npar))
  cat(sprintf("  AIC: %.*f\n", d, x$fit.stats$AIC))
  cat(sprintf("  BIC: %.*f\n", d, x$fit.stats$BIC))

  if (!is.null(x$Corr)) {
    cat("\nFactor Correlation Matrix:\n")
    .fc_print_matrix(x$Corr, d)
  }

  if (!is.null(x$lambda.summary)) {
    cat("\nLoading (Lambda) Summary:\n")
    .fc_print_matrix(x$lambda.summary, d)
  }

  if (!is.null(x$theta.summary)) {
    cat("\nPerson Parameter Summary (N x D):\n")
    .fc_print_matrix(x$theta.summary, d)
  }

  if (!is.null(x$convergence)) {
    .fc_print_convergence(x$convergence)
  }

  cat("\nUse get.fit.index() to compute goodness-of-fit indices.\n\n")
  invisible(x)
}


# ===========================================================================
# Internal gof table printers (used by print.summary.good.of.fit)
# ===========================================================================

.gof_print_overview <- function(tab) {
  cat("\nOverview:\n")
  width <- max(nchar(tab$Field), na.rm = TRUE)
  for (i in seq_len(nrow(tab))) {
    cat(sprintf("  %-*s  %s\n", width, tab$Field[i], tab$Value[i]))
  }
}

.gof_print_metric_table <- function(title, tab) {
  cat("\n")
  cat(title, ":\n", sep = "")

  cols <- c("Metric", "Estimate", "Recommended")
  is_sub <- grepl("^SUB:", tab$Metric, perl = TRUE)
  tab$Metric <- sub("^SUB:\\s*", "", tab$Metric, perl = TRUE)

  metric_rows <- tab[!is_sub, , drop = FALSE]
  if (nrow(metric_rows) == 0L) return(invisible(NULL))

  widths <- vapply(cols, function(col) {
    header <- if (col == "Recommended") "Guide" else col
    max(nchar(c(header, metric_rows[[col]])), na.rm = TRUE)
  }, numeric(1L))
  widths <- pmax(widths, nchar(c("Metric", "Estimate", "Guide")))

  header <- sprintf("  %-*s  %*s  %-*s",
                    widths["Metric"], "Metric",
                    widths["Estimate"], "Estimate",
                    widths["Recommended"], "Guide")
  cat(header, "\n", sep = "")
  cat("  ", paste(
    vapply(widths, function(w) paste(rep("-", w), collapse = ""), character(1L)),
    collapse = "  "
  ), "\n", sep = "")

  mi <- 1L
  for (i in seq_len(nrow(tab))) {
    if (is_sub[i]) {
      cat("\n  ", tab$Metric[i], ":\n", sep = "")
    } else {
      r <- metric_rows[mi, , drop = FALSE]
      est <- if (nchar(r$Estimate) == 0L || r$Estimate == "NA") "NA" else r$Estimate
      rec <- if (nchar(r$Recommended) == 0L) "" else r$Recommended
      cat(sprintf("  %-*s  %*s  %-*s\n",
                  widths["Metric"], r$Metric,
                  widths["Estimate"], est,
                  widths["Recommended"], rec))
      mi <- mi + 1L
    }
  }
}

.gof_print_legacy_summary <- function(x) {
  digits <- attr(x, "digits")
  if (is.null(digits)) digits <- 4

  fmt <- function(val, d = digits, int = FALSE) {
    if (is.null(val) || length(val) == 0) return(character(0))
    res <- sapply(val, function(v) {
      if (is.na(v)) return("NA")
      if (int || abs(v - round(v)) < .Machine$double.eps^0.5) {
        formatC(round(v), format = "d", big.mark = ",")
      } else {
        formatC(v, format = "f", digits = d)
      }
    })
    names(res) <- names(val)
    return(res)
  }

  print_table <- function(labels, values) {
    if (length(labels) == 0) return(invisible(NULL))
    keep <- !(is.na(values) | values == "NA")
    labels <- labels[keep]
    values <- values[keep]
    if (length(labels) == 0) return(invisible(NULL))
    width <- max(nchar(labels), na.rm = TRUE)
    for (i in seq_along(labels)) {
      cat(sprintf("  %-*s %s\n", width, labels[i], values[i]))
    }
  }

  cat(sprintf("\nSample Size (N):       %s\n", fmt(x$Sample_Size, int = TRUE)))
  cat(sprintf("Items/Indicators:      %s\n", fmt(x$Items, int = TRUE)))
  cat(sprintf("Response Type:         %s\n", x$Response_Type))
  cat(sprintf("Parameters:            %s\n", fmt(x$Parameters, int = TRUE)))
  cat(sprintf("Moments:               %s total, %s bivariate\n",
              fmt(x$Moments, int = TRUE), fmt(x$Bivariate_Moments, int = TRUE)))
  cat(sprintf("Log-Likelihood:        %s\n", fmt(x$LogLik)))
  cat(sprintf("Deviance (-2LL):       %s\n\n", fmt(x$Deviance)))

  if (length(x$IC) > 0 && !all(is.na(x$IC))) {
    cat("Information Criteria:\n")
    print_table(names(x$IC), fmt(x$IC))
    cat("\n")
  }
  invisible(x)
}


# ===========================================================================
# Simulated data print methods
# ===========================================================================

.fc_print_data_header <- function(title) {
  cat(sprintf("\n%s\n", title))
  cat(paste(rep("=", nchar(title)), collapse = ""), "\n")
}

.print_data_common <- function(x, label) {
  .fc_print_data_header(paste0("SIMULATED ", label, " DATA"))
  cat(sprintf("Sample Size (N)     : %d\n", x$N))
  cat(sprintf("Items/Indicators (I): %d\n", x$I))
  cat(sprintf("Dimensions (D)      : %d\n", x$D))
  if (!is.null(x$model)) cat(sprintf("Model               : %s\n", x$model))
  cat(sprintf("Call: %s\n", paste(deparse(x$call), collapse = " ")))
  invisible(x)
}

#' @describeIn print Print method for \code{data.MIRT} objects.
#' @export
print.data.MIRT <- function(x, ...) {
  .print_data_common(x, "MIRT")
}

#' @describeIn print Print method for \code{data.MGPCM} objects.
#' @export
print.data.MGPCM <- function(x, ...) {
  .print_data_common(x, "MGPCM")
}

#' @describeIn print Print method for \code{data.MGGUM} objects.
#' @export
print.data.MGGUM <- function(x, ...) {
  .print_data_common(x, "MGGUM")
}

#' @describeIn print Print method for \code{data.FCMIRT} objects.
#' @export
print.data.FCMIRT <- function(x, ...) {
  .fc_print_data_header("SIMULATED FCMIRT DATA")
  cat(sprintf("Sample Size (N)      : %d\n", x$N.person))
  cat(sprintf("Blocks (B)           : %d\n", x$N.block))
  cat(sprintf("Statements (I)       : %d\n", x$I.states))
  cat(sprintf("Dimensions (D)       : %d\n", x$D))
  cat(sprintf("Model                : %s\n", x$model))
  cat(sprintf("FC Type              : %s\n",
              paste(x$fc.type, collapse = ", ")))
  cat(sprintf("Call: %s\n", paste(deparse(x$call), collapse = " ")))
  invisible(x)
}

#' @describeIn print Print method for \code{data.FCDCM} objects.
#' @export
print.data.FCDCM <- function(x, ...) {
  .fc_print_data_header("SIMULATED FCDCM DATA")
  cat(sprintf("Sample Size (N)      : %d\n", x$N.person))
  cat(sprintf("Blocks (B)           : %d\n", x$N.block))
  cat(sprintf("Attributes (D)       : %d\n", x$D))
  cat(sprintf("DCM Type             : %s\n",
              paste(unique(x$dcm.type), collapse = ", ")))
  cat(sprintf("Call: %s\n", paste(deparse(x$call), collapse = " ")))
  invisible(x)
}

#' @describeIn print Print method for \code{data.FCGDINA} objects.
#' @export
print.data.FCGDINA <- function(x, ...) {
  .fc_print_data_header("SIMULATED FCGDINA DATA")
  cat(sprintf("Sample Size (N)      : %d\n", x$N.person))
  cat(sprintf("Blocks (B)           : %d\n", x$N.block))
  cat(sprintf("Statements (I)       : %d\n", x$I.states))
  cat(sprintf("Attributes (D)       : %d\n", x$D))
  cat(sprintf("CDM Model            : %s\n", x$model))
  if (length(unique(x$fc.type)) == 1L) {
    cat(sprintf("FC Type              : %s\n", x$fc.type[1L]))
  } else {
    cat(sprintf("FC Type              : %s\n", paste(x$fc.type, collapse = ", ")))
  }
  cat(sprintf("Call: %s\n", paste(deparse(x$call), collapse = " ")))
  invisible(x)
}

#' @describeIn print Print method for \code{data.FCGGUM} objects.
#' @export
print.data.FCGGUM <- function(x, ...) {
  .fc_print_data_header("SIMULATED FCGGUM DATA")
  cat(sprintf("Sample Size (N)      : %d\n", x$N.person))
  cat(sprintf("Blocks (B)           : %d\n", x$N.block))
  cat(sprintf("Statements (I)       : %d\n", x$I.states))
  cat(sprintf("Dimensions (D)       : %d\n", x$D))
  cat(sprintf("FC Type              : %s\n",
              paste(x$fc.type, collapse = ", ")))
  cat(sprintf("Call: %s\n", paste(deparse(x$call), collapse = " ")))
  invisible(x)
}

#' @describeIn print Print method for \code{data.TIRT} objects.
#' @export
print.data.TIRT <- function(x, ...) {
  .fc_print_data_header("SIMULATED TIRT DATA")
  cat(sprintf("Sample Size (N)      : %d\n", x$N.person))
  cat(sprintf("Items (I)            : %d\n", x$I.states))
  cat(sprintf("Dimensions (D)       : %d\n", x$D))
  cat(sprintf("FC Type              : %s\n",
              paste(x$fc.type, collapse = ", ")))
  cat(sprintf("Call: %s\n", paste(deparse(x$call), collapse = " ")))
  invisible(x)
}