R/terminationRule.R

In yuehmeir2/CATSimulator: Library for Simulation of Adaptive Item Selection

#' Returns whether the given simulee has completed the simulation.
#'
#' @param simuleeOut A tibble containing the in-progress simulee test output.
#' @param simulation An object defining the test that is being run.
#' @return A logical true/false depending on whether the simulee has reached the end of the simulation.
#' @examples
#'   simulation = readRDS(system.file("example/passage-adaptive-wpm.rds", package = "CATSimulator"))
#'   simuleeOut = initSimulee(generateSimuleesByTrueTheta(-2, 10001), simulation)
#'   terminated = tr.isTerminated(simuleeOut, simulation)
#' @export
tr.isTerminated <- function (simuleeOut, simulation) {
  switch(simulation$control$terminationRule,
         asap = return(tr.asap.isTerminated(simuleeOut, simulation)),
         csem = return(tr.csem.isTerminated(simuleeOut, simulation))
  )

  # Algorithm unknown???
  stop("terminationRule not found: ", simulation$control$terminationRule)
  return(NULL)
}

#' Returns whether the given simulee has completed the simulation.
#'
#' The `asap` algorithm will try to end the test as soon as possible after the
#' minimum test length has been reached.
#'
#' @param simuleeOut A tibble containing the in-progress simulee test output.
#' @param simulation An object defining the test that is being run.
#' @return A logical true/false depending on whether the simulee has reached the end of the simulation.
#' @examples
#'   simulation = readRDS(system.file("example/passage-adaptive-wpm.rds", package = "CATSimulator"))
#'   simuleeOut = initSimulee(generateSimuleesByTrueTheta(-2, 10001), simulation)
#'   terminated = tr.asap.isTerminated(simuleeOut, simulation)
#' @export
tr.asap.isTerminated <- function (simuleeOut, simulation) {
  # Stop as soon as possible once the simulee has reached the minimum test length
  assignedItemCount = sum(!is.na(simuleeOut$ITEM_INDEX))
  return(assignedItemCount >= simulation$control$minItems)
}

#' Returns whether the given simulee has completed the simulation.
#'
#' The `csem` algorithm will try to end the test as soon as possible after the
#' minimum test length has been reached and the csem of the latest item is below
#' a target value.
#'
#' @param simuleeOut A tibble containing the in-progress simulee test output.
#' @param simulation An object defining the test that is being run.
#' @return A logical true/false depending on whether the simulee has reached the end of the simulation.
#' @examples
#'   simulation = readRDS(system.file("example/passage-adaptive-wpm.rds", package = "CATSimulator"))
#'   simuleeOut = initSimulee(generateSimuleesByTrueTheta(-2, 10001), simulation)
#'   terminated = tr.csem.isTerminated(simuleeOut, simulation)
#' @export
tr.csem.isTerminated <- function (simuleeOut, simulation) {
  # Stop if csem reaches termination value between min/max test length
  assignedItemCount = sum(!is.na(simuleeOut$ITEM_INDEX))
  if (assignedItemCount < simulation$control$minItems) {
    return(FALSE)
  } else if (assignedItemCount >= simulation$control$maxItems) {
    return(TRUE)
  } else {
    return(simuleeOut$CSEM[assignedItemCount] <= simulation$control$terminationValue)
  }
}