R/configClasses.R

In RSCAT: Shadow-Test Approach to Computerized Adaptive Testing

#' MIP solver configuration
#' 
#' An S4 Class to represent parameters of the MIP solver configuration.
#' 
#' @slot absGap the absolute gap target to terminate the MIP solving.
#' @slot relGap the relative gap target to terminate the MIP solving.
#' @slot intTol the integer tolerance for the MIP solving. if the solution x 
#'   is between -intTol and intTol, x <= 0 is true if the value of x is at most 
#'   intTol. x > 0 is fulfilled if x > intTol.
#' @export SolverConfig
SolverConfig <- setClass(
  "SolverConfig",
  slots = c(
    absGap = "numeric",
    relGap = "numeric",
    intTol = "numeric"
  ),
  prototype = list(
    absGap = 1e-3,
    relGap = 1e-3, 
    intTol = 1e-3
  ),
  validity = function(object) {
    if (object@absGap <= 0 || object@relGap <= 0 || object@intTol <= 0) {
      return("At least one non-positive number was specified as the solver 
             parameters.")
    }
    return(TRUE)
  }
)

#' CAT configuration
#' 
#' An S4 Class to represent parameters of the CAT configuration.
#' 
#' @slot solverConfig an instance of the S4 class \code{SolverConfig} for the 
#'   MIP solver configuration.
#' @slot initialTheta the initial ability theta value.
#' @slot scalingConstant the constraint to scale a discrimination coefficient.
#'   estimated with the logistic model to the normal metric.
#' @slot itemSelectionMethod  a character string specifying the item selection method.
#' @slot scoreMethodConfig a rJava \code{jobjRef} object for CAT scoring method
#'   configuration. It is generated by the function \code{scoreMethodConfig}.
#' @slot exposureControlType a character string specifying the exposure control
#'   type. "None" to disable exposure control, "Item" for item-level exposure 
#'   control, and "Passage" for passage-level exposure control.
#' @slot exposureControlRate an integer value specifying the exposure goal rate.
#' @slot lValue a non-negative integer specifying the nuumber of items to be
#'   randomlized.
#' @import rJava methods     
#' @export CATConfig
CATConfig <- setClass(
  "CATConfig",
  slots = c(
    solverConfig = "SolverConfig", 
    initialTheta = "numeric", 
    scalingConstant = "numeric",
    itemSelectionMethod = "character",
    scoreMethodConfig = "jobjRef",
    exposureControlType = "character",
    exposureControlRate = "numeric",
    lValue = "integer"
  ),
  prototype = list(
    solverConfig = SolverConfig(), 
    initialTheta = 0.0, 
    scalingConstant = 1.0,
    itemSelectionMethod = "maxInfo",
    scoreMethodConfig = rJava::.jnull(),
    exposureControlType = "None",
    exposureControlRate = 0.5,
    lValue = 0L
  ),
  validity = function(object) {
    if (!object@exposureControlType %in% c("None", "Item")) {
      return("The exposureControlType can only be \"None\", \"Item\", 
             or \"Passage\".")
    }
    if (object@lValue < 0) {
      return("The lValue can only be a non-negative integer.")
    } 
    if (object@exposureControlRate < 0) {
      return("The exposureControlRate is invalid.")
    } 
    return(TRUE)
  }
)

#' Test specification configuration
#' 
#' An S4 class to represent test blueprint and specification.
#' 
#' @slot testConfigID a character string as the identifier of the test 
#'   configuration.
#' @slot testLength a positive integer specifying the test length.
#' @slot itempoolPath a character string specifying the location of the item pool
#'   csv file.
#' @slot passagepoolPath a character string specifying the location of the 
#'   passage pool csv file.
#' @slot constraintPath a character string specifying the location of the
#'   constraint csv file.
#' @slot itemNumericColumn a boolean vector indicating whether item attribute 
#'   columns in the item pool table are numeric or not.
#' @slot passageNumericColumn a boolean vector indicating whether passage
#'   attribute columns in the passage pool table are numeric or not.
#' @slot enableEnemyItem a boolean indicator to specify if enemy item 
#'   constraints defined by in the item pool is enabled or not.
#' @slot numPassageLB an integer specifying the minimum number of passages in 
#'   the test.
#' @slot numPassageUB an integer specifying the maximum number of passages in 
#'   the test.
#' @slot numItemPerPassageLB an integer specifying the minimum number of items
#'  in a passages in the test.
#' @slot numItemPerPassageUB an integer specifying the maximum number of items
#'  in a passages in the test.
#' @import methods
#' @export TestConfig
TestConfig <- setClass(
  "TestConfig",
  slots = c(
    testConfigID = "character", 
    testLength = "integer", 
    itempoolPath = "character",
    passagepoolPath = "character",
    constraintPath = "character",
    itemNumericColumn ="logical",
    passageNumericColumn ="logical",
    enableEnemyItem = "logical",
    numPassageLB = "integer",
    numPassageUB = "integer",
    numItemPerPassageLB = "integer",
    numItemPerPassageUB = "integer"
  ),
  prototype = list(
    testConfigID = "test_default",
    testLength = 10L,
    itempoolPath = "",
    passagepoolPath = "",
    constraintPath = "",
    enableEnemyItem = FALSE,
    numPassageLB = 0L,
    numPassageUB = 0L,
    numItemPerPassageLB = 0L,
    numItemPerPassageUB = 0L
  ),
  validity = function(object) {
    if (object@testLength <= 0) {
      return("The test length should be a positive integer.")
    } else if (object@numPassageLB < 0 || object@numPassageUB < 0) {
      return("The numPassageLB and numPassageUB should be non-negative integers
             .")
    } else if (object@numPassageLB > object@numPassageUB) {
      return("The numPassageLB should less than or equal to numPassageUB.")
    }
    return(TRUE)
  }
)

#' CAT simulation configuration
#' 
#' An S4 class to represent CAT simulation configuraiton.
#' 
#' @slot simID a character string as the identifier of the CAT simulation.
#' @slot numExaminees a positive integer specifying the number of simulated 
#'   examinees.
#' @slot trueThetaDistType a character string specifying the distribution of 
#'   true ability of simulated examinees. "Normal" for the Normal distribution 
#'   and "Uniform" for the uniform distribution.
#' @slot trueThetaDistParams a numeric vector spcifying parameters of the prior
#'   distribuution. (mean, sd) for the Normal distribution, (a, b) for the 
#'   uniform distribution.
#' @import methods
#' @export SimConfig
SimConfig <- setClass(
  "SimConfig",
  slots = c(
    simID = "character", 
    numExaminees = "integer", 
    trueThetaDistType = "character",
    trueThetaDistParams = "numeric"),
  prototype = list(
    simID = "", 
    numExaminees = 10L, 
    trueThetaDistType = "Normal",
    trueThetaDistParams = c(0.0, 1.0)),
  validity = function(object) {
    if (object@numExaminees <= 0) {
      return("The numExaminees should be a positive integer.")
    } else if (!object@trueThetaDistType %in% c("Normal", "Uniform")) {
      return("The trueThetaDistType should be either \"Normal\" or \"Uniform\".
             ")
    }
    if (object@trueThetaDistType == "Normal" && 
          object@trueThetaDistParams[2] <= 0) {
      return("Invalid standard deviation is specified in the distParams.")
    } else if (object@trueThetaDistType == "Uniform" && 
               object@trueThetaDistParams[2]
               <= object@trueThetaDistParams[1]) {
      return("Invalid distribution parameters are specificed.")
    }
    return(TRUE)
  }
)