R/S3Extract.R

In Qval: The Q-Matrix Validation Methods Framework

#' @title Extract Components from Qval Package Objects
#'
#' @description 
#' A unified extractor function for retrieving internal components from objects produced by the \pkg{Qval} package. 
#' This method allows users to access key elements such as model results, validation logs, and simulation settings 
#' in a structured and object-oriented manner.
#'
#' @details 
#' This generic extractor supports three core object classes: \code{\link[Qval]{CDM}}, \code{\link[Qval]{validation}}, 
#' \code{\link[Qval]{sim.data}} and \code{\link[Qval]{fit}}. 
#' It is intended to streamline access to commonly used internal components without manually referencing object slots.
#' The available components for each class are listed below:
#'
#' \describe{
#'   \item{\strong{\code{CDM}}}{Cognitive Diagnosis Model fitting results. Available components:
#'     \describe{
#'       \item{analysis.obj}{The internal model fitting object (e.g., GDINA or Baseline Model).}
#'       \item{alpha}{Estimated attribute profiles (EAP estimates) for each respondent.}
#'       \item{P.alpha.Xi}{Posterior distribution of latent attribute patterns.}
#'       \item{alpha.P}{Marginal attribute mastery probabilities (estimated).}
#'       \item{P.alpha}{Prior attribute probabilities at convergence.}
#'       \item{Deviance}{Negative twice the marginal log-likelihood (model deviance).}
#'       \item{npar}{Number of free parameters estimated in the model.}
#'       \item{AIC}{Akaike Information Criterion.}
#'       \item{BIC}{Bayesian Information Criterion.}
#'       \item{call}{The original model-fitting function call.}
#'       \item{...}{Can \code{\link[GDINA]{extract}} corresponding value from the \code{\link[GDINA]{GDINA}} object.}
#'     }}
#'
#'   \item{\strong{\code{validation}}}{Q-matrix validation results. Available components:
#'     \describe{
#'       \item{Q.orig}{The original Q-matrix submitted for validation.}
#'       \item{Q.sug}{The suggested (revised) Q-matrix after validation.}
#'       \item{time.cost}{Total computation time for the validation procedure.}
#'       \item{process}{Log of Q-matrix modifications across iterations.}
#'       \item{iter}{Number of iterations performed during validation.}
#'       \item{priority}{Attribute priority matrix (available for PAA-based methods only).}
#'       \item{Hull.fit}{Data required to plot the Hull method results (for Hull-based validation only).}
#'       \item{call}{The original function call used for validation.}
#'     }}
#'
#'   \item{\strong{\code{sim.data}}}{Simulated data and parameters used in cognitive diagnosis simulation studies:
#'     \describe{
#'       \item{dat}{Simulated dichotomous response matrix (\eqn{N \times I}).}
#'       \item{Q}{Q-matrix used to generate the data.}
#'       \item{attribute}{True latent attribute profiles (\eqn{N \times K}).}
#'       \item{catprob.parm}{Item-category conditional success probabilities (list format).}
#'       \item{delta.parm}{Item-level delta parameters (list format).}
#'       \item{higher.order.parm}{Higher-order model parameters (if used).}
#'       \item{mvnorm.parm}{Parameters for the multivariate normal attribute distribution (if used).}
#'       \item{LCprob.parm}{Latent class-based success probability matrix.}
#'       \item{call}{The original function call that generated the simulated data.}
#'     }}
#'     \item{\strong{\code{fit}}}{Relative fit indices (-2LL, AIC, BIC, CAIC, SABIC) and absolute fit indices (\eqn{M_2} test, \eqn{RMSEA_2}, SRMSR):
#'     \describe{
#'       \item{npar}{The number of parameters.}
#'       \item{-2LL}{The Deviance.}
#'       \item{AIC}{The Akaike information criterion.}
#'       \item{BIC}{The Bayesian information criterion.}
#'       \item{CAIC}{The consistent Akaike information criterion.}
#'       \item{SABIC}{The Sample-size Adjusted BIC.}
#'       \item{M2}{A vector consisting of \eqn{M_2} statistic, degrees of freedom, significance level, and \eqn{RMSEA_2} (Liu, Tian, & Xin, 2016).}
#'       \item{SRMSR}{The standardized root mean squared residual (SRMSR; Ravand & Robitzsch, 2018).}
#'     }}
#' }
#'
#' @param object An object of class \code{\link[Qval]{CDM}}, \code{\link[Qval]{validation}}, \code{\link[Qval]{sim.data}}, or \code{\link[Qval]{fit}}.
#' @param what A character string specifying the name of the component to extract.
#' @param ... Additional arguments (currently ignored).
#'
#' @return The requested component. The return type depends on the specified \code{what} and the class of the \code{object}.
#' 
#' @references
#' Khaldi, R., Chiheb, R., & Afa, A.E. (2018). Feed-forward and Recurrent Neural Networks for Time Series Forecasting: Comparative Study. In: Proceedings of the International Conference on Learning and Optimization Algorithms: Theory and Applications (LOPAL 18). Association for Computing Machinery, New York, NY, USA, Article 18, 1–6. DOI: 10.1145/3230905.3230946.
#'
#' Liu, Y., Tian, W., & Xin, T. (2016). An application of M2 statistic to evaluate the fit of cognitive diagnostic models. Journal of Educational and Behavioral Statistics, 41, 3–26. DOI: 10.3102/1076998615621293.
#'
#' Ravand, H., & Robitzsch, A. (2018). Cognitive diagnostic model of best choice: a study of reading comprehension. Educational Psychology, 38, 1255–1277. DOI: 10.1080/01443410.2018.1489524.

#' 
#' @examples
#' library(Qval)
#' set.seed(123)
#' 
#' \donttest{
#' ################################################################
#' # Example 1: sim.data extraction                               #
#' ################################################################
#' Q <- sim.Q(3, 10)
#' data.obj <- sim.data(Q, N = 200)
#' extract(data.obj, "dat")
#' 
#' 
#' ################################################################
#' # Example 2: CDM extraction                                    #
#' ################################################################
#' CDM.obj <- CDM(data.obj$dat, Q)
#' extract(CDM.obj, "alpha")
#' extract(CDM.obj, "AIC")
#' 
#' 
#' ################################################################
#' # Example 3: validation extraction                             #
#' ################################################################
#' validation.obj <- validation(data.obj$dat, Q, CDM.obj)
#' Q.sug <- extract(validation.obj, "Q.sug")
#' print(Q.sug)
#' 
#' ################################################################
#' # Example 4: fit extraction                                    #
#' ################################################################
#' fit.obj <- fit(data.obj$dat, Q.sug, model="GDINA")
#' extract(fit.obj, "M2")
#' }
#' 
#' @name extract
#' @export
extract <- function(object, what, ...) {
  UseMethod("extract")
}

#' @describeIn extract Extract fields from a CDM object
#' @importFrom GDINA extract
#' @export
extract.CDM <- function(object, what, ...) {
  qval_choices <- c("analysis.obj", "alpha", "P.alpha.Xi", "alpha.P", "P.alpha",
                    "Deviance", "npar", "AIC", "BIC", "call")
  if (what %in% qval_choices) {
    return(switch(what,
                  analysis.obj = object$analysis.obj,
                  alpha        = object$alpha,
                  P.alpha.Xi   = object$P.alpha.Xi,
                  alpha.P      = object$alpha.P,
                  P.alpha      = object$P.alpha,
                  Deviance     = object$model.fit["Deviance"],
                  npar         = object$model.fit["npar"],
                  AIC          = object$model.fit["AIC"],
                  BIC          = object$model.fit["BIC"],
                  call         = object$call))
  }
  
  # 否则尝试从 GDINA::extract 提取（前提是 analysis.obj 为 GDINA 对象）
  if (!is.null(object$analysis.obj)) {
    return(GDINA::extract(object$analysis.obj, what = what, ...))
  }
  
  stop(sprintf("'%s' is not a valid field for CDM objects. Choose from: %s or GDINA fields.",
               what, paste(qval_choices, collapse = ", ")), call. = FALSE)
}

#' @describeIn extract Extract fields from a validation object
#' @export
extract.validation <- function(object, what, ...) {
  choices <- c("Q.orig", "Q.sug", "time.cost", "process", "iter",
               "priority", "Hull.fit", "call")
  if (!what %in% choices) {
    stop(sprintf("'%s' is not a valid field for validation objects. Choose from: %s",
                 what, paste(choices, collapse = ", ")), call. = FALSE)
  }
  switch(what,
         Q.orig   = object$Q.orig,
         Q.sug    = object$Q.sug,
         time.cost = object$time.cost,
         process  = object$process,
         iter     = object$iter,
         priority = object$priority,
         Hull.fit = object$Hull.fit,
         call     = object$call)
}

#' @describeIn extract Extract fields from a sim.data object
#' @export
extract.sim.data <- function(object, what, ...) {
  choices <- c("dat", "Q", "attribute", "catprob.parm", "delta.parm",
               "higher.order.parm", "mvnorm.parm", "LCprob.parm", "call")
  if (!what %in% choices) {
    stop(sprintf("'%s' is not a valid field for sim.data objects. Choose from: %s",
                 what, paste(choices, collapse = ", ")), call. = FALSE)
  }
  switch(what,
         dat                = object$dat,
         Q                  = object$Q,
         attribute          = object$attribute,
         catprob.parm       = object$catprob.parm,
         delta.parm         = object$delta.parm,
         higher.order.parm  = object$higher.order.parm,
         mvnorm.parm        = object$mvnorm.parm,
         LCprob.parm        = object$LCprob.parm,
         call               = object$call)
}

#' @describeIn extract Extract fields from a fit object
#' @importFrom GDINA extract
#' @export
extract.fit <- function(object, what, ...) {
  choices <- c("npar", "-2LL", "AIC", "BIC", "CAIC", "SABIC",
               "M2", "SRMSR", "call")
  if (!what %in% choices) {
    stop(sprintf("'%s' is not a valid field for sim.data objects. Choose from: %s",
                 what, paste(choices, collapse = ", ")), call. = FALSE)
  }
  switch(what,
         npar               = object$npar,
         `-2LL`             = object$`-2LL`,
         AIC                = object$AIC,
         BIC                = object$BIC,
         CAIC               = object$CAIC,
         SABIC              = object$SABIC,
         M2                 = object$M2,
         SRMSR              = object$SRMSR,
         call               = object$call)
}