R/cat.R

In LearningRaph/felix: A Computer Adative Testing Wrapping Package

#' Computes next item to present while updating test parameters
#'
#' This function is a wrapping of different CAT functions. It updates the theta estimate,
#' the theta error estimate, the score and the reliability test parameters, then computes next
#' item to present.
#'
#' @param assessment dataframe of assessment parameters (JSON : Object)
#' @param items character: vector of items Ids (JSON : Array)
#' @param itemsResponses numeric or NULL: matrix of items responses (JSON : Array of objects with items Ids)
#' @param itemsParameters numeric: matrix of all available items parameters (JSON : Array of objects)
#'
#' @details The itemsResponsescan be NULL if we are looking for the first item to present.
#'
#' @return list of updated inputs (JSON: Object)
#' @importFrom jsonlite fromJSON
#' @importFrom jsonlite toJSON
#' @export
#'
nextItem = function(assessment, items, itemsResponses, itemsParameters) {

## First item to present
  if (length(itemsResponses) == 0) {
    assessment$nextItem = getNextItem(assessment$theta, items, itemsParameters, NULL,
                                      NULL, assessment$D, assessment$model,
                                      assessment$criterion)
  } else {

  ## Transform data


    # Extract parameters for items that have responses
    ids = colnames(jsonlite::fromJSON(toJSON(itemsResponses), simplifyVector = T))
    position = match(ids, items)
    parameters = as.matrix(itemsParameters[position,])

    # Transform responses as a numeric vector
    responses = as.numeric(as.data.frame(jsonlite::fromJSON(toJSON(itemsResponses), simplifyVector = F)))




  ## Update test parameters if responses exist

      # Compute theta
      assessment$theta = getTheta(responses, parameters, assessment$D, assessment$model)

      # Compute theta Error
      assessment$thetaError = getThetaError(assessment$theta, responses, parameters,
                                            assessment$D, assessment$model, assessment$method)

      # Compute reliability
      assessment$reliability = getReliability(assessment$thetaError)

      # Compute score
      assessment$score = getScore(assessment$theta, assessment$scoreMean, assessment$scoreSD)




  ## Check for assessment stop rules. If continue, call next item function

    # Continue if there are still items in the bank, else stop
    if (nrow(itemsResponses) == nrow(itemsParameters)) {
      assessment$nextItem = NA

      # Continue if thetaError is still superior to minError required and if we don't have the minimum number of items, else stop
    } else if (assessment$thetaError <= assessment$minError & nrow(itemsResponses) >= assessment$minItems) {
      assessment$nextItem = NA

      # Continue until we reach maxItems to display, else stop
    } else if (nrow(itemsResponses) == assessment$maxItems) {
      assessment$nextItem = NA

      # Compute next item from item bank
    } else {
      assessment$nextItem = getNextItem(assessment$theta, items, itemsParameters, position,
                                        responses, assessment$D, assessment$model,
                                        assessment$criterion)
    }
  }




## rebuild and send data

  data = list(
    assessment = assessment,
    items = items,
    itemsResponses = itemsResponses,
    itemsParameters = itemsParameters)

  return(data)
}


#' Computes next item to present
#'
#' This function selects the next item to be administered, given the list of
#'  previously administered items and the current ability estimate.
#'
#' @param theta numeric: the ability estimate
#' @param items character: vector of items Ids
#' @param itemsParameters numeric: matrix of the parameters of all available items
#' @param itemsAnswered numeric: vector of the position of answered items in the "items" vector
#' @param responses numeric: vector of responses to previous items
#' @param D numeric: metric constant (1 for logistic models, 1.7 for normal models)
#' @param model Either NULL for dichotomous models, or one of the following
#' for polytomous models : "GRM", "MGRM", "PCM", "GPCM", "RSM" and "NRM"
#' @param criterion character: method for next item selection. Possible values are :
#' "MFI", "bOpt", "thOpt", "MLWI", "MPWI", "MEI", "MEPV", "progressive", "proportional",
#' "KL", "KLP", "GDI", "GDIP" and "random".
#'
#' @return character: Id of the next item to present
#' @importFrom catR nextItem
#' @export
#'
getNextItem = function(theta, items, itemsParameters, itemsAnswered, responses, D = 1.7, model = NULL, criterion = "MFI") {
  nextItem = catR::nextItem(theta = theta,
                         itemBank = itemsParameters,
                         out = itemsAnswered,
                         x = responses,
                         D = D,
                         model = model,
                         criterion = criterion)

  return(items[nextItem$item])
}


#' Computes the ability estimation
#'
#' This function returns the expected a posteriori (EAP) ability estimate
#' for a given response pattern and a given matrix of item parameters.
#'
#' @param responses numeric: vector of responses to previous items
#' @param parameters numeric: matrix of the parameters of items with a response
#' @param D numeric: metric constant (1 for logistic models, 1.7 for normal models)
#' @param model Either NULL for dichotomous models, or one of the following
#' for polytomous models : "GRM", "MGRM", "PCM", "GPCM", "RSM" and "NRM"
#'
#' @return numeric: A value between 0 and 1
#' @importFrom catR eapEst
#' @export
#'
getTheta = function(responses, parameters, D = 1.7, model = NULL) {

  theta = catR::eapEst(x = responses, it = parameters, D = D, model = model)

  return(theta)
}


#' Computes the standard error of ability estimation
#'
#' This functions returns the estimated standard error
#' of theta for a given response pattern and a given matrix of item parameters.
#'
#' @param theta numeric: the ability estimate
#' @param responses numeric: vector of responses to previous items
#' @param parameters numeric: matrix of the parameters of items with a response
#' @param D numeric: metric constant (1 for logistic models, 1.7 for normal models)
#' @param model Either NULL for dichotomous models, or one of the following
#' for polytomous models : "GRM", "MGRM", "PCM", "GPCM", "RSM" and "NRM"
#' @param method character: ability estimator to choose in the following : "BM", "ML",
#' "WL", "EAP" and "ROB"
#'
#' @return numeric: A value between 0 and 1
#' @importFrom catR semTheta
#' @export
#'
getThetaError = function(theta, responses, parameters, D = 1.7, model = NULL, method = "BM") {

  thetaError = catR::semTheta(thEst = theta, x = responses, it = parameters, D = D, model = model, method = method)

  if(thetaError < 0) {
    thetaError = 0
  }

  if(thetaError > 1) {
    thetaError = 1
  }

  return(thetaError)

}


#' Computes score from theta
#'
#' This function does not normalise between a min and a max. You must
#' verify the output yourself.
#'
#' @param theta numeric: the ability estimate
#' @param mean numeric: mean of the calibration
#' @param sd numeric: standart deviation of the calibration
#'
#' @return numeric
#' @export
#'
#'
#' @examples
#' getScore(1.34, 50, 10)
#' getScore(-2.64, 50, 16)
getScore = function(theta, mean = 50, sd = 10) {
  return((theta * sd) + mean)
}


#' Computes the assessment's reliability
#'
#' This function returns the equivalent of Cronbach's alpha for a specific assessment pattern.
#'
#' @param thetaError numeric: standard error of ability estimation between 0 and 1
#'
#' @return numeric: A value between 0 and 1 (Cronbach's alpha)
#' @export
#'
#' @examples
#' getReliability(0.45)
getReliability = function(thetaError) {
  r = 1 - (thetaError^2)

  if(r < 0) {
    r = 0
  }

  if(r > 1) {
    r = 1
  }

  return(r)
}