R/S3.R

In Qval: The Q-Matrix Validation Methods Framework

#' Print Method for CDM Objects
#'
#' This function prints the details of a \code{\link[Qval]{CDM}} object.
#' It outputs the call used to create the object, the version and the date of the \code{Qval} package.
#'
#' @param x A \code{\link[Qval]{CDM}} object to be printed.
#' @param ... Additional arguments.
#' 
#' @export
#' 
print.CDM <- function(x, ...){
  # Print the call used to create the CDM object
  cat("Call:\n", paste(deparse(extract.CDM(x,"call")), sep = "\n", collapse = "\n"), "\n\n", sep = "")
  
  # Get package description for "Qval" and print version and date
  packageinfo <- utils::packageDescription("Qval")
  cat( paste( "Qval version " , packageinfo$Version , " (" , packageinfo$Date , ")" , sep="") , "\n" )
}


#' Print Method for Validation Objects
#' 
#' This function prints the details of a \code{\link[Qval]{validation}} object.
#' It outputs the call used to create the object, the version and the date of the \code{Qval} package.
#' 
#' @param x A \code{\link[Qval]{validation}} object to be printed.
#' @param ... Additional arguments.
#' 
#' @export
#' 
print.validation <- function(x, ...){
  # Print the call used to create the validation object
  cat("Call:\n", paste(deparse(extract.validation(x,"call")), sep = "\n", collapse = "\n"), "\n\n", sep = "")
  
  # Get package description for "Qval" and print version and date
  packageinfo <- utils::packageDescription("Qval")
  cat( paste( "Qval version " , packageinfo$Version , " (" , packageinfo$Date , ")" , sep="") , "\n" )
  
  cat("==============================================\n")
  
  Q.sug <- data.frame(extract.validation(x, "Q.sug"))
  Q.orig <- data.frame(extract.validation(x, "Q.orig"))
  
  if(any(Q.sug!=Q.orig)){
    cat("\nSuggested Q-matrix: \n\n")
    Q.sug[Q.sug != Q.orig] <- paste0(Q.sug[Q.sug!=Q.orig],"*")
    print(Q.sug,right = FALSE)
    cat("Note: * denotes a modified element.\n")
  }else{
    cat("\nNo Q-matrix modifications are suggested.\n")
  }
}


#' Print Method for sim.data Objects
#'
#' This function prints the details of a \code{\link[Qval]{sim.data}} object.
#' It outputs the call used to create the object, the version and the date of the \code{Qval} package.
#'
#' @param x A \code{\link[Qval]{sim.data}} object to be printed.
#' @param ... Additional arguments.
#' 
#' @export
#' 
print.sim.data <- function(x, ...){
  # Print the call used to create the sim.data object
  cat("Call:\n", paste(deparse(extract.sim.data(x,"call")), sep = "\n", collapse = "\n"), "\n\n", sep = "")
  
  # Get package description for "Qval" and print version and date
  packageinfo <- utils::packageDescription("Qval")
  cat( paste( "Qval version " , packageinfo$Version , " (" , packageinfo$Date , ")" , sep="") , "\n" )
  
  cat("==============================================\n")
  cat(" Number of items       =", nrow(x$Q), "\n", 
      "Number of attributes  =", ncol(x$Q), "\n", 
      "Number of individuals =", nrow(x$dat), "\n", 
      "To extract components, use the method extract.\n")
  
}


#'@title Extract elements from objects of various classes
#'
#' @description A generic function to extract elements from objects of class \code{CDM}, \code{validation} or \code{sim.data}.
#'
#' Objects which can be extracted from \code{\link[Qval]{CDM}} object include:
#'
#' \describe{
#'  \item{analysis.obj}{An \code{GDINA} object (@seealso \code{\link[GDINA]{GDINA}}) gained from \code{GDINA} package or an 
#'                      \code{list} after BM algorithm, depending on which estimation is used.}
#'  \item{alpha}{Individuals' attribute parameters calculated by EAP method}
#'  \item{P.alpha.Xi}{Individual's posterior probability}
#'  \item{alpha.P}{Individuals' marginal mastery probabilities matrix}
#'  \item{P.alpha}{Attribute prior weights for calculating marginalized likelihood in the last iteration}
#'  \item{Deviance}{deviance, or negative two times observed marginal log likelihood}
#'  \item{npar}{The number of parameters}
#'  \item{AIC}{AIC}
#'  \item{BIC}{BIC}
#' }
#' 
#' Objects which can be extracted from \code{\link[Qval]{validation}} object include:
#'
#' \describe{
#'  \item{Q.orig}{The original Q-matrix that maybe contain some mis-specifications and need to be validated.}
#'  \item{Q.sug}{The Q-matrix that suggested by certain validation method.}
#'  \item{time.cost}{The time that CPU cost to finish the validation.}
#'  \item{process}{A matrix that contains the modification process of each item during each iteration. 
#'        Each row represents an iteration, and each column corresponds to the q-vector index of respective 
#'        item. The order of the indices is consistent with the row number in the matrix generated by 
#'        the \code{\link[GDINA]{attributepattern}} function in the \code{GDINA} package. Only when 
#'        \code{maxitr} > 1, the value is available.}
#'  \item{iter}{The number of iteration. Only when \code{maxitr} > 1, the value is available.}
#'  \item{priority}{An \code{I} × \code{K} matrix that contains the priority of every attribute for
#'                 each item. Only when the \code{search.method} is \code{"PAA"}, the value is available.}
#'  \item{Hull.fit}{A \code{list} containing all the information needed to plot the Hull plot, which is 
#'                 available only when \code{method} = \code{"Hull"}.}
#' }
#' 
#' Objects which can be extracted from \code{\link[Qval]{sim.data}} object include:
#'
#' \describe{
#'  \item{dat}{An \code{N} × \code{I} simulated item response matrix.}
#'  \item{Q}{The Q-matrix.}
#'  \item{attribute}{An \code{N} × \code{K} matrix for inviduals' attribute patterns.}
#'  \item{catprob.parm}{A list of non-zero category success probabilities for each attribute mastery pattern.}
#'  \item{delta.parm}{A list of delta parameters.}
#'  \item{higher.order.parm}{Higher-order parameters.}
#'  \item{mvnorm.parm}{Multivariate normal distribution parameters.}
#'  \item{LCprob.parm}{A matrix of item/category success probabilities for each attribute mastery pattern.}
#' }
#' 
#' @param object objects from class \code{CDM}, \code{validation}, \code{sim.data}
#' @param what what to extract
#' @param ... Additional arguments.
#' 
#' @examples
#' set.seed(123)
#'
#' library(Qval)
#'
#' ## generate Q-matrix and data to fit
#' K <- 3
#' I <- 30
#' example.Q <- sim.Q(K, I)
#' IQ <- list(
#'   P0 = runif(I, 0.0, 0.2),
#'   P1 = runif(I, 0.8, 1.0)
#' )
#' example.data <- sim.data(Q = example.Q, N = 1000, IQ = IQ,
#'                          model = "GDINA", distribute = "horder")
#' extract(example.data,"dat")
#'
#'
#' ## using MMLE/EM to fit GDINA model
#' example.CDM.obj <- CDM(example.data$dat, example.Q, model = "GDINA",
#'                        method = "EM", maxitr = 2000, verbose = 1)
#' extract(example.CDM.obj,"alpha")
#' extract(example.CDM.obj,"npar")
#' 
#' example.MQ <- sim.MQ(example.Q, 0.1)
#' example.CDM.obj <- CDM(example.data$dat, example.MQ, model = "GDINA",
#'                        method = "EM", maxitr = 2000, verbose = 1)
#'                        
#' validation.obj <- validation(example.data$dat, example.MQ, 
#'                              example.CDM.obj, method = "MLR-B", eps = 0.90)
#' extract(validation.obj,"Q.sug")
#' 
#' @export
extract <- function (object, what, ...) {
  UseMethod("extract")
}


#' @title extract elements of CDM object
#' @description
#' NULL
#' @details
#' NULL
#' @describeIn extract various elements of \code{CDM} object
#' @aliases extract.CDM
#' @export
extract.CDM <- function(object, what, ...){
  out <- 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, 
                stop(sprintf("Can not extract element \'%s\'", what), call.=FALSE))
  return(out)
}


#' @title extract elements of validation object
#' @description
#' NULL
#' @details
#' NULL
#' @describeIn extract various elements of \code{validation} object
#' @aliases extract.validation
#' @export
extract.validation <- function(object, what, ...){
  out <- switch(what, 
                Q.orig = object$Q.orig, 
                Q.sug = object$Q.sug,
                time.cost = object$time.cost[1], 
                process = object$process, 
                priority = object$priority, 
                Hull.fit = object$Hull.fit, 
                iter = object$iter, 
                call = object$call, 
                stop(sprintf("Can not extract element \'%s\'", what), call.=FALSE))
  return(out)
}

#' @title extract elements of sim.data
#' @description
#' NULL
#' @details
#' NULL
#' @describeIn extract various elements of \code{sim.data} object
#' @aliases extract.sim.data
#' @export
extract.sim.data <- function(object, what, ...){
  out <- 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, 
                stop(sprintf("Can not extract element \'%s\'", what), call.=FALSE))
  return(out)
}