R/RcppExports.R

In irt: Item Response Theory and Computerized Adaptive Testing Functions

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' @title Find the intersection of ICCs
#'
#' @description This function finds the points on theta scale where two item
#'   item characteristic curves intersects between two theta points (theta
#'   range). If they overlap or do not intersect, the function will return an
#'   empty vector, \code{integer(0)}.
#'   Only available for 'Rasch', '1PL', '2PL', '3PL' or '4PL' models.
#'
#' @noRd
#'
NULL

#' @title Find the exact area between two ICCs
#'
#' @description This function uses Raju (1988) formulas and finds the exact
#'   area between two ICCs
#'
#' @noRd
#'
NULL

#' @title Find the area under an ICC enclosed by boundaries
#'
#' @description This method implements Kim and Cohen (1991). Only works for
#'   Rasch, 1PL, 2PL and 3PL models.
#' @noRd
NULL

#' @title Find the area between two ICC within a closed interval
#'
#' @description This method implements Kim and Cohen (1991).
#'   Only available for 'Rasch', '1PL', '2PL', '3PL' or '4PL' models.
#' @noRd
NULL

find_icc_intersect_cpp <- function(item_1, item_2, theta_range = as.numeric( c(-5, 5))) {
    .Call(`_irt_find_icc_intersect_cpp`, item_1, item_2, theta_range)
}

area_between_icc_exact_cpp <- function(item_1, item_2, signed_area = TRUE) {
    .Call(`_irt_area_between_icc_exact_cpp`, item_1, item_2, signed_area)
}

area_between_icc_closed_cpp <- function(item_1, item_2, signed_area = TRUE, theta_range = as.numeric( c(-5, 5))) {
    .Call(`_irt_area_between_icc_closed_cpp`, item_1, item_2, signed_area, theta_range)
}

#' When user do not provide an item pool, administer a perfect item to an
#' examinee at each step of the adaptive test.
#'
#' @noRd
#'
NULL

#' Select an item from a predetermined list of items.
#'
#' !!!! FIX THIS for testlets  !!!!
#'      Currently it automatically selects the
#'      first item of the testlet with the assumption that testlet items
#'      has previously been administered.
#'
#'
#'
#'
#' @noRd
#'
NULL

#' Extract the remaining items in the item pool.
#'
#' @description This function returns an Itempool object of the remaining items
#' in the item pool after removing all of the items that has been administered.
#' It receives, as an input, CatDesign object which involves an Itempool
#' object (ip) and the estimate history (est_history) and returns an
#' Itempool object of the remaining objects. "est_history" is a list of
#' estimation history and the last element assumed to not have an $item,
#' i.e. the last element's 'item' field is null.
#'
#' If an item from a testlet has been administered, this function will not
#' return that testlet. Consequently, even the non-administered items within
#' the testlet are not included in the output.
#' 
#' @param cd  A \code{cat_design} object that holds the test specifications
#'   of the CAT.
#' @param est_history is a \code{List} that holds each step of the adaptive
#'   test. The first element is "1" which represents the beginning of the test.
#'   The elements are:
#'   \describe{
#'     \item{\code{"est_before"}}{The estimated ability before the item's
#'       administration.}
#'     \item{\code{"se_before"}}{The estimated standard error before the
#'       item's administration.}
#'     \item{\code{"item"}}{The item object that will be administered.}
#'     \item{\code{"testlet"}}{The testlet object that the administered item
#'       belongs to.}
#'     \item{\code{"resp"}}{The response value of the item that is
#'       administered}
#'     \item{\code{"est_after"}}{The estimated ability after the item's
#'       administration.}
#'     \item{\code{"se_after"}}{The estimated standard error after the
#'       item's administration}
#'   }
#' @param additional_args Additional arguments that are passed to functions.
#'   For example, it has a list called "set_aside_item_list". This list will
#'   contain items or testlets that has not been administered during the test
#'   but set aside and cannot be administered in this  particular
#'   administration of the CAT test.
#'
#' @noRd
#'
get_remaining_items_cpp <- function(cd, est_history, additional_args) {
    .Call(`_irt_get_remaining_items_cpp`, cd, est_history, additional_args)
}

#' Get administered items from a CAT output
#'
#' @description This function returns an item pool object of the
#'   administered items using the items in estimate history.
#'
#'   NOTE: This function either returns a regular Itempool object and if there
#'         are no administered items, it returns an empty Itempool object.
#'         Consequently, it may not be a valid Itempool object. Use this
#'         function internally because it may cause errors in R.
#'
#' @param est_history is a \code{List} that holds each step of the adaptive
#'   test. The first element is "1" which represents the beginning of the test.
#'   The elements are:
#'   \describe{
#'     \item{\code{"est_before"}}{The estimated ability before the item's
#'       administration.}
#'     \item{\code{"se_before"}}{The estimated standard error before the
#'       item's administration.}
#'     \item{\code{"item"}}{The item object that will be administered.}
#'     \item{\code{"testlet"}}{The testlet object that the administered item
#'       belongs to.}
#'     \item{\code{"resp"}}{The response value of the item that is
#'       administered}
#'     \item{\code{"est_after"}}{The estimated ability after the item's
#'       administration.}
#'     \item{\code{"se_after"}}{The estimated standard error after the
#'       item's administration}
#'   }
#'
#' @noRd
#'
get_administered_items_cpp <- function(est_history) {
    .Call(`_irt_get_administered_items_cpp`, est_history)
}

#' Calculate the likelihood or log-likelihood of the estimate history.
#'
#' @description This function calculates the likelihood or log-likelihood of
#'   the estimate history
#'   for CAT. est_history can be complete, i.e. the "resp" value and the "item"
#'   value of the last element might be valid or not. If any of them is not
#'   valid, the last element of est_history will be ignored and likelihood
#'   will be calculated using the remaining elements.
#' @param est_history is a \code{List} that holds each step of the adaptive
#'   test. The first element is "1" which represents the beginning of the test.
#'   The elements are:
#'   \describe{
#'     \item{\code{"est_before"}}{The estimated ability before the item's
#'       administration.}
#'     \item{\code{"se_before"}}{The estimated standard error before the
#'       item's administration.}
#'     \item{\code{"item"}}{The item object that will be administered.}
#'     \item{\code{"testlet"}}{The testlet object that the administered item
#'       belongs to.}
#'     \item{\code{"resp"}}{The response value of the item that is
#'       administered}
#'     \item{\code{"est_after"}}{The estimated ability after the item's
#'       administration.}
#'     \item{\code{"se_after"}}{The estimated standard error after the
#'       item's administration}
#'   }
#' @param theta The theta estimate where the likelihood or log-likelihood
#'   needs to be calculated.
#' @param calculate_loglik If true, the log-likelihood of the estimate
#'   history will be calculated. If false, likelihood will be calculated.
#'
#' @noRd
#'
loglik_est_history_cpp <- function(est_history, theta, calculate_loglik = TRUE) {
    .Call(`_irt_loglik_est_history_cpp`, est_history, theta, calculate_loglik)
}

select_next_item_fisher_max_info_cpp <- function(cd, est_history, additional_args) {
    .Call(`_irt_select_next_item_fisher_max_info_cpp`, cd, est_history, additional_args)
}

#' Get list of unadministered items within a testlet
#'
#' This function returns the list of unadministered items from a Testlet using
#' the estimate history of CAT so far. The names of each list element is the
#' same as the item's ids. Consequently, can be easily used to build an
#' itempool object.
#' The function assumes that the testlet items were administered consecutively.
#'
#' @return The function will return a list of remaining items in the testlet.
#'   If there is no remaining item in the testlet, the function will return
#'   an empty list.
#'
#'
#'
#' @noRd
#'
get_unadministered_testlet_items_cpp <- function(testlet, est_history) {
    .Call(`_irt_get_unadministered_testlet_items_cpp`, testlet, est_history)
}

#' Select remaining testlet items if a testlet has been chosen.
#' 
#' @description This item selection method chooses testlet items in the 
#'   same order they appear in the testlet. 
#' 
#' @noRd
#'
#'
select_next_testlet_item_none_cpp <- function(cd, est_history, additional_args) {
    .Call(`_irt_select_next_testlet_item_none_cpp`, cd, est_history, additional_args)
}

#' Select remaining testlet items using Maximum Fisher Information if a
#' testlet has been chosen
#'
#' @return This function returns either an empty list which means there
#'   no items in the item pool to be selected. Or, it will return the most
#'   informative item from the testlet that has not been administered. The
#'   function will return an updated estimate history with the updated item
#'   and testlet fields.
#'
#'
#' @noRd
#'
#'
select_next_testlet_item_mfi_cpp <- function(cd, est_history, additional_args) {
    .Call(`_irt_select_next_testlet_item_mfi_cpp`, cd, est_history, additional_args)
}

#' Check whether to terminate the testlet
#'
#' @description This function checks whether the termination criteria has
#' been satisfied for a given testlet. It will check the est_history for
#' whether testlet's termination met.
#'
#' @return A boolean value. If testlet termination criteria has not been met
#' and more items can be administered from this testlet, it will return
#' `false`. If termination criteria has been met and no more items can be
#' administered from the testlet, it will return `true`.
#'
#'
#' @noRd
#'
#'
terminate_testlet_cat_cpp <- function(testlet, cd, est_history, additional_args) {
    .Call(`_irt_terminate_testlet_cat_cpp`, testlet, cd, est_history, additional_args)
}

#' Process testlet items in CAT step
#'
#' This function runs before some of the item selection functions to process
#' testlets. Usually if the first item from a testlet is administered, the
#' next item that will be administered will be from the same testlet if
#' there are available items in the testlet.
#'
#' @return The function can return an updated estimate_history element which
#' can be returned as is or it can return an empty list which means the item
#' function can find a new item/testlet.
#'
#' @noRd
#'
#'
process_testlet_cat_cpp <- function(cd, est_history, additional_args) {
    .Call(`_irt_process_testlet_cat_cpp`, cd, est_history, additional_args)
}

#' This function selects an item given an cat design (cd) and estimate
#' history (est_history). It returns a named list with "item" and it's
#' "testlet".
#'
#' @description
#' Assumptions of this function:
#' * This function assumes that the first item is administered and
#'   item number (item_no) is larger than 1.
#' * The est_history already have an current estimate, i.e. a valid
#'   'est' field in the latest element of est_history.
#' *
#'  /// Select Next Item Function Rules /////
#' The rule for next item selection functions such as 
#'     "select_next_item_fisher_max_info_cpp":
#'   * Any prescreening or constraints should be applied within the function.
#'   * Each function will need to get following three arguments:
#'     - 'cd': CAT Design object
#'     - 'est_history': Estimate History so far
#'     - 'additional_args': Additional arguments
#'   * Each function will return a list with the following named elements:
#'     - 'est_history': Estimate history where the 'item' and 'testlet'
#'          elements of the last step is updated with the selected item's ID's
#'     - 'additional_args': Additional arguments that will be passed to the
#'          next step.
#'   * If exposure control can be applied to item selection algorighm, then,
#'     it should be applied within the item selection sub-function. Exposure
#'     control is not applied item selection within testlets. I
#'     within testlet selection function, exposure control is not applied
#'     to item selection.
#'   * Currently, for testlets, CAT next item selection functions such as
#'     `select_next_item_mepv_cpp`, `select_next_item_random_cpp`,
#'     `select_next_item_fisher_max_info_cpp` first selects a Testlet and 
#'     run "process_testlet_cat_cpp" which selects a testlet item based on 
#'     "testlet_rules". 
#'     After this, each item from the testlet is selected using
#'     `process_testlet_cat_cpp` fuction. This function will be run at the
#'     beginning of each item selection method (except infinite one) and
#'     selects the testlet item separately based on testlet item selection
#'     rules. If testlet termination criteria is satisfied (checked in
#'     `process_testlet_cat_cpp` fuction), the item selection function will
#'     select the next item/testlet using `next_item_selecton` rules.
#'
#'
#'
#' @noRd
#'
#'
#'
#'
select_next_item_cpp <- function(cd, est_history, additional_args) {
    .Call(`_irt_select_next_item_cpp`, cd, est_history, additional_args)
}

cat_sim_single_cpp <- function(true_ability, cd, examinee_id = NA_character_) {
    .Call(`_irt_cat_sim_single_cpp`, true_ability, cd, examinee_id)
}

cat_sim_cpp <- function(true_ability, cd, verbose = 0L) {
    .Call(`_irt_cat_sim_cpp`, true_ability, cd, verbose)
}

generate_cat_resp_cpp <- function(true_ability, cd, est_history, additional_args) {
    .Call(`_irt_generate_cat_resp_cpp`, true_ability, cd, est_history, additional_args)
}

est_ability_cat_cpp <- function(true_ability, cd, est_history, additional_args, last_estimate = FALSE) {
    .Call(`_irt_est_ability_cat_cpp`, true_ability, cd, est_history, additional_args, last_estimate)
}

#' Function determines whether to terminate CAT.
#'
#' @description This function returns either \code{true} or \code{false} where
#'   \code{true} indicates to terminate the test and \code{false} indicates to
#'   terminate the test.
#'
#'   If there is only one condition, test will end when the condition
#'   satisfied. If there are multiple conditions, all of them should be
#'   satisfied in order for test to terminate.
#'
#'
#' @param true_ability True ability of the examinee.
#' @param cd A \code{cat_design} object that holds the test specifications
#'   of the CAT.
#' @param est_history is a \code{List} that holds each step of the adaptive
#'   test. The first element is "1" which represents the beginning of the test.
#'   The elements are:
#'   \describe{
#'     \item{\code{"est_before"}}{The estimated ability before the item's
#'       administration.}
#'     \item{\code{"se_before"}}{The estimated standard error before the
#'       item's administration.}
#'     \item{\code{"item"}}{The item object that will be administered.}
#'     \item{\code{"testlet"}}{The testlet object that the administered item
#'       belongs to.}
#'     \item{\code{"resp"}}{The response value of the item that is
#'       administered}
#'     \item{\code{"est_after"}}{The estimated ability after the item's
#'       administration.}
#'     \item{\code{"se_after"}}{The estimated standard error after the
#'       item's administration}
#'   }
#'
#' @param additional_args Additional arguments
#' 
#' @noRd
#' 
terminate_cat_cpp <- function(true_ability, cd, est_history, additional_args) {
    .Call(`_irt_terminate_cat_cpp`, true_ability, cd, est_history, additional_args)
}

calculate_exposure_rates_cpp <- function(item_ids, cat_output_list) {
    .Call(`_irt_calculate_exposure_rates_cpp`, item_ids, cat_output_list)
}

calculate_overlap_rates_cpp <- function(item_ids, cat_output_list) {
    .Call(`_irt_calculate_overlap_rates_cpp`, item_ids, cat_output_list)
}

#' This function will be used in CAT simulations
#' @noRd
NULL

#' @param resp A Response object.
#' @param ip An Itempool object.
#' @noRd
NULL

#' This function calculates the EAP ability estimate.
#'
#' 2022-06-05: This function has been deprecated. The new function uses
#' Gausss-Hermite instead for the rectangle method of integration.
#'
#' @param resp A Response object.
#' @param ip An Itempool object.
#' @noRd
NULL

#' @param resp_set A Response_set object.
#' @param ip An Itempool object.
#' @noRd
NULL

est_ability_eap_single_examinee_cpp <- function(resp, ip, theta_range = as.numeric( c(-5, 5)), no_of_quadrature = 61L, prior_dist = "norm", prior_par = as.numeric( c(0, 1))) {
    .Call(`_irt_est_ability_eap_single_examinee_cpp`, resp, ip, theta_range, no_of_quadrature, prior_dist, prior_par)
}

est_ability_eap_cpp <- function(resp, ip, theta_range = as.numeric( c(-5, 5)), no_of_quadrature = 41L, prior_dist = "norm", prior_par = as.numeric( c(0, 1))) {
    .Call(`_irt_est_ability_eap_cpp`, resp, ip, theta_range, no_of_quadrature, prior_dist, prior_par)
}

est_ability_eap_response_cpp <- function(resp, ip, theta_range = as.numeric( c(-5, 5)), no_of_quadrature = 61L, prior_dist = "norm", prior_par = as.numeric( c(0, 1))) {
    .Call(`_irt_est_ability_eap_response_cpp`, resp, ip, theta_range, no_of_quadrature, prior_dist, prior_par)
}

est_ability_eap_response_set_cpp <- function(resp_set, ip, theta_range = as.numeric( c(-5, 5)), no_of_quadrature = 61L, prior_dist = "norm", prior_par = as.numeric( c(0, 1))) {
    .Call(`_irt_est_ability_eap_response_set_cpp`, resp_set, ip, theta_range, no_of_quadrature, prior_dist, prior_par)
}

#' This function will be used in CAT simulations
#'
#' Note that this function needs to be tested for psychometric models other
#' than unidimensional dichotomous models (Rasch, 1PL, 2PL, 3PL)
#'
#' @noRd
NULL

#' Estimate Ability using MAP (Bayes Modal Estimation)
#'
#' @description Estimate the ability using Bayes Modal (or MAP) estimation
#'   via Newton-Raphson algorighm.
#' @param resp A Response object.
#' @param ip An Itempool object
#' @param prior_dist A string for the name of the prior distribution.
#'   Currently, only normal distribution is available ("norm")
#' @param prior_par A vector specifying the prior parameters
#' @param initial_theta The starting point of theta estimate for the
#'   Newton-Raphson algorighm.
#' @param tol The tolerance level. The difference between the two subsequent
#'   first derivatives of response log-likelihoods should be smaller than
#'   this number.
#' @noRd
NULL

#' @param resp_set A Response_set object.
#' @param ip An Itempool object.
#' @noRd
NULL

est_ability_map_single_examinee_cpp <- function(resp, ip, prior_dist = "norm", prior_par = as.numeric( c(0, 1)), theta_range = as.numeric( c(-5, 5)), initial_theta = 0, tol = 0.00001) {
    .Call(`_irt_est_ability_map_single_examinee_cpp`, resp, ip, prior_dist, prior_par, theta_range, initial_theta, tol)
}

est_ability_map_response_cpp <- function(resp, ip, prior_dist = "norm", prior_par = as.numeric( c(0, 1)), theta_range = as.numeric( c(-5, 5)), initial_theta = 0, tol = 0.00001) {
    .Call(`_irt_est_ability_map_response_cpp`, resp, ip, prior_dist, prior_par, theta_range, initial_theta, tol)
}

est_ability_map_response_set_cpp <- function(resp_set, ip, prior_dist = "norm", prior_par = as.numeric( c(0, 1)), theta_range = as.numeric( c(-5, 5)), initial_theta = 0, tol = 0.00001) {
    .Call(`_irt_est_ability_map_response_set_cpp`, resp_set, ip, prior_dist, prior_par, theta_range, initial_theta, tol)
}

#' This function estimates ability using Newton-Raphson method for a Response
#' object.
#' @noRd
#'
NULL

#' @param resp A Response object.
#' @param ip_list A list of Item/Testlet objects.
#' @noRd
NULL

est_ability_4pm_nr_itempool_cpp <- function(resp, ip, theta_range = as.numeric( c(-5, 5)), criterion = 0.001, initial_estimates = NULL) {
    .Call(`_irt_est_ability_4pm_nr_itempool_cpp`, resp, ip, theta_range, criterion, initial_estimates)
}

est_ability_4pm_nr_response_cpp <- function(resp, ip, theta_range = as.numeric( c(-5, 5)), criterion = 0.001, initial_estimates = NULL) {
    .Call(`_irt_est_ability_4pm_nr_response_cpp`, resp, ip, theta_range, criterion, initial_estimates)
}

est_ability_optim_response_cpp <- function(resp, ip_list, theta_range = as.numeric( c(-5, 5)), tol = 0.0000001) {
    .Call(`_irt_est_ability_optim_response_cpp`, resp, ip_list, theta_range, tol)
}

est_ability_owen_item_cpp <- function(item, resp, m0, v0) {
    .Call(`_irt_est_ability_owen_item_cpp`, item, resp, m0, v0)
}

est_ability_owen_cpp <- function(ip, resp, m0, v0) {
    .Call(`_irt_est_ability_owen_cpp`, ip, resp, m0, v0)
}

gauss_hermite <- function(n) {
    .Call(`_irt_gauss_hermite`, n)
}

#' This function calculates the information of multiple items for a single
#' theta. It returns the information value of each item as a vector.
#' 
#' @noRd
NULL

#' This function returns the total information of an itempool for a single
#' theta.
#' @noRd
NULL

#' This function calculates the information of multiple items for multiple
#' thetas.
#' @noRd
NULL

#' This function calculates the total test information of multiple items for 
#' multiple thetas.
#' @noRd
NULL

#' This function is only used when resp is not NULL and resp is a Response
#' object.
#' @noRd
NULL

#' This function is only used when resp is not NULL and resp is a Response
#' object to calculate Total test information.
#' @noRd
NULL

info_4pm_bare_cpp <- function(theta, item) {
    .Call(`_irt_info_4pm_bare_cpp`, theta, item)
}

info_grm_bare_cpp <- function(theta, item) {
    .Call(`_irt_info_grm_bare_cpp`, theta, item)
}

info_gpcm_bare_cpp <- function(theta, item) {
    .Call(`_irt_info_gpcm_bare_cpp`, theta, item)
}

info_item_bare_cpp <- function(theta, item, observed, resp) {
    .Call(`_irt_info_item_bare_cpp`, theta, item, observed, resp)
}

#' This function calculates the information of a single testlet for single
#' theta. It returns the total information of all items in the testlet. 
#'  
#' @param theta A numeric value at which the information will be calculated. 
#' @param testlet A Testlet object.  
#' @param observed Boolean. If "TRUE", observed information will be calculated  
#' @param resp If 'resp' is not NULL, then it will remove the items' with NA 
#'   from the information calculation.
#'  
#' @return A numeric value for the information of the testlet at the "theta"
#'   value.
#' 
#' @noRd
info_testlet_bare_cpp <- function(theta, testlet, observed, resp = NULL) {
    .Call(`_irt_info_testlet_bare_cpp`, theta, testlet, observed, resp)
}

info_item_cpp <- function(theta, item, observed, resp = NULL) {
    .Call(`_irt_info_item_cpp`, theta, item, observed, resp)
}

info_itempool_bare_cpp <- function(theta, ip, observed = FALSE, resp = NULL) {
    .Call(`_irt_info_itempool_bare_cpp`, theta, ip, observed, resp)
}

info_itempool_bare_tif_cpp <- function(theta, ip, observed = FALSE, resp = NULL) {
    .Call(`_irt_info_itempool_bare_tif_cpp`, theta, ip, observed, resp)
}

info_itempool_cpp <- function(theta, ip, observed = FALSE, resp = NULL) {
    .Call(`_irt_info_itempool_cpp`, theta, ip, observed, resp)
}

info_itempool_tif_cpp <- function(theta, ip, observed = FALSE, resp = NULL) {
    .Call(`_irt_info_itempool_tif_cpp`, theta, ip, observed, resp)
}

info_response_cpp <- function(theta, ip, resp, observed = FALSE) {
    .Call(`_irt_info_response_cpp`, theta, ip, resp, observed)
}

info_response_tif_cpp <- function(theta, ip, resp, observed = FALSE) {
    .Call(`_irt_info_response_tif_cpp`, theta, ip, resp, observed)
}

info_response_set_cpp <- function(theta, ip, resp_set, tif = FALSE, observed = FALSE) {
    .Call(`_irt_info_response_set_cpp`, theta, ip, resp_set, tif, observed)
}

info_kl_item_bare_cpp <- function(true_theta, theta_hat, item) {
    .Call(`_irt_info_kl_item_bare_cpp`, true_theta, theta_hat, item)
}

avg_rank <- function(x) {
    .Call(`_irt_avg_rank`, x)
}

biserial_cpp <- function(score, criterion, type = "default") {
    .Call(`_irt_biserial_cpp`, score, criterion, type)
}

#' Get the length of an item pool
#'
#' @description This function gets length of an item pool from three different
#'   aspects.
#' @param ip An \code{\link{Itempool-class}} object.
#' @return This vector will return three numbers:
#' "elements": The number of items (excluding the ones in testlets) and
#'   testlets.
#' "testlets": The number of testlets
#' "items": The number of items including the ones in testlets. But this
#'   number excludes the testlets. It is basically the possible number of
#'   responses from an item pool.
#'
#' @noRd
#'
get_itempool_size <- function(ip) {
    .Call(`_irt_get_itempool_size`, ip)
}

#' Extract a string slot of an \code{\link{Itempool-class}} object.
#'
#' @description This function extracts the slot all \code{\link{Item-class}}
#'   objects within an \code{\link{Itempool-class}} object. Note that slot
#'   should hold a character class value.
#' @param ip An \code{\link{Itempool-class}} object.
#' @return A string vector that holds the values of extracted slot.
#'
#' @noRd
#'
get_ids_itempool_cpp <- function(ip) {
    .Call(`_irt_get_ids_itempool_cpp`, ip)
}

#' Extract item ids of \code{\link{Itempool-class}} object.
#'
#' @description This function extracts item id's of item pool. If the item pool
#'   has testlets, it extracts the items within the testlet object. 
#' @param ip An \code{\link{Itempool-class}} object.
#' @return A string vector that holds the values of item IDs.
#'
#' @noRd
#'
get_item_ids_itempool_cpp <- function(ip) {
    .Call(`_irt_get_item_ids_itempool_cpp`, ip)
}

#' Extract testlet ID's that correspond to item ids.
#'
#' @description This function extracts testlet id's of item pool. It has the
#'   same size as item_ids and if an item is not belong to a testlet, a 
#'   NA value will be returned for that item. If all of the items are 
#'   standalone items, than a vector of NA's will be returned . 
#' @param ip An \code{\link{Itempool-class}} object.
#' @return A string vector that holds the values of testlet IDs.
#'
#' @noRd
#'
get_testlet_ids_itempool_cpp <- function(ip) {
    .Call(`_irt_get_testlet_ids_itempool_cpp`, ip)
}

#' Extract a string slot of an \code{\link{Itempool-class}} object.
#'
#' @description This function extracts the slot all \code{\link{Item-class}}
#'   objects within an \code{\link{Itempool-class}} object. Note that slot
#'   should hold a character class value.
#' @param ip An \code{\link{Itempool-class}} object.
#' @param slotName A string value of the name of the slot.
#' @return A string vector that holds the values of extracted slot.
#'
#' @noRd
#'
get_slot_itempool_cpp <- function(ip, slotName) {
    .Call(`_irt_get_slot_itempool_cpp`, ip, slotName)
}

get_parameters_itempool_cpp <- function(ip) {
    .Call(`_irt_get_parameters_itempool_cpp`, ip)
}

subset_itempool_cpp <- function(ip, args) {
    .Call(`_irt_subset_itempool_cpp`, ip, args)
}

#'
#' This function returns a list of items within item pool. If there is are
#' testlets, the items within each testlet will be extracted and added to
#' the list.
#'
#' @param ip an "Itempool" class object
#' @noRd
flatten_itempool_cpp <- function(ip) {
    .Call(`_irt_flatten_itempool_cpp`, ip)
}

#' This function returns the maximum possible score of an item. It returns an
#' integer.
#' @param item an "Item" class object
#' @noRd
get_max_possible_score_item_cpp <- function(item) {
    .Call(`_irt_get_max_possible_score_item_cpp`, item)
}

#' This function returns the maximum possible score of each item in an item
#' pool. It returns a vector of integer values. If there are testlets,
#' the maximum scores of items within testlets will be returned.
#'
#'
#' @param ip an "Itempool" class object
#' @noRd
get_max_possible_score_itempool_cpp <- function(ip) {
    .Call(`_irt_get_max_possible_score_itempool_cpp`, ip)
}

#' @title This function checks whether an Item objects model is dichotomous or
#' polytomous; or unidimensional/multidimensional.
#'
#' @description
#' This function effectively divides models into four categories:
#' model is_dichotomous is_unidimensional                                 Call
#'   2PL           true              true   check_item_model(item, true, true)
#'  M2PL           true             false  check_item_model(item, true, false)
#'  GPCM          false              true  check_item_model(item, false, true)
#'
#' @noRd
#'
NULL

integrate <- function(x, fx) {
    .Call(`_irt_integrate`, x, fx)
}

check_item_model <- function(item, is_dichotomous = TRUE, is_unidimensional = TRUE) {
    .Call(`_irt_check_item_model`, item, is_dichotomous, is_unidimensional)
}

lz_response_cpp <- function(resp, theta, ip_list) {
    .Call(`_irt_lz_response_cpp`, resp, theta, ip_list)
}

lz_response_set_cpp <- function(resp_set, theta, ip) {
    .Call(`_irt_lz_response_set_cpp`, resp_set, theta, ip)
}

prob_4pm_bare_cpp <- function(theta, item, derivative = 0L, resp = -9) {
    .Call(`_irt_prob_4pm_bare_cpp`, theta, item, derivative, resp)
}

prob_4pm_item_cpp <- function(theta, item, derivative = 0L) {
    .Call(`_irt_prob_4pm_item_cpp`, theta, item, derivative)
}

prob_4pm_itempool_cpp <- function(theta, ip, derivative = 0L) {
    .Call(`_irt_prob_4pm_itempool_cpp`, theta, ip, derivative)
}

prob_grm_bare_cpp <- function(theta, item, derivative = 0L) {
    .Call(`_irt_prob_grm_bare_cpp`, theta, item, derivative)
}

prob_gpcm_bare_cpp <- function(theta, item, derivative = 0L, resp = -9) {
    .Call(`_irt_prob_gpcm_bare_cpp`, theta, item, derivative, resp)
}

prob_poly_bare_cpp <- function(theta, item, derivative = 0L, resp = -9, expected_value = FALSE) {
    .Call(`_irt_prob_poly_bare_cpp`, theta, item, derivative, resp, expected_value)
}

prob_mirt_bare_cpp <- function(theta, item, derivative = 0L) {
    .Call(`_irt_prob_mirt_bare_cpp`, theta, item, derivative)
}

prob_mirt_item_cpp <- function(theta, item, derivative = 0L) {
    .Call(`_irt_prob_mirt_item_cpp`, theta, item, derivative)
}

prob_mirt_itempool_cpp <- function(theta, ip, derivative = 0L) {
    .Call(`_irt_prob_mirt_itempool_cpp`, theta, ip, derivative)
}

prob_bare_item_cpp <- function(theta, item, derivative = 0L, resp = -9, expected_value = FALSE) {
    .Call(`_irt_prob_bare_item_cpp`, theta, item, derivative, resp, expected_value)
}

#' This function calculates the probability of each response option for one
#' theta value. It returns a matrix, each column represents a response
#' option and each row represents an item.
#'
#' @noRd
prob_bare_itempool_cpp <- function(theta, ip, derivative = 0L, expected_value = FALSE) {
    .Call(`_irt_prob_bare_itempool_cpp`, theta, ip, derivative, expected_value)
}

#' Get full response vector from potentially partial testlet responses.
#' 
#' If the testlet involves five items: i1, i2, i3, i4, i5 and examinee
#' only responsed three of them: i2, i3 and i5 with responses c(0, 1, 0). 
#' The input will be "resp = c(0, 1, 1)"; "item_ids = c("i2". "i3". "i5")". 
#' This function will plug NA for the places of missing items and return 
#' the following response vector: c(NA, 0, 1, NA, 1)
#' 
#' 
#' @noRd
#' 
NULL

resp_lik_bare_item_cpp <- function(resp, theta, item) {
    .Call(`_irt_resp_lik_bare_item_cpp`, resp, theta, item)
}

resp_lik_item_cpp <- function(resp, theta, item) {
    .Call(`_irt_resp_lik_item_cpp`, resp, theta, item)
}

#' Find the response likelihood of a testlet
#' 
#' @param resp A numeric vector of responses. The length of this vector 
#'   should have the same length as the number of standalone items in the 
#'   Testlet object.
#' @param theta A single numeric value representing the ability of the examinee
#' @param testlet A Testlet object.
#' 
#' 
#' 
#' @noRd
#' 
#' 
resp_lik_bare_testlet_cpp <- function(resp, theta, testlet) {
    .Call(`_irt_resp_lik_bare_testlet_cpp`, resp, theta, testlet)
}

resp_lik_testlet_cpp <- function(resp, theta, testlet) {
    .Call(`_irt_resp_lik_testlet_cpp`, resp, theta, testlet)
}

resp_lik_bare_itempool_cpp <- function(resp, theta, ip) {
    .Call(`_irt_resp_lik_bare_itempool_cpp`, resp, theta, ip)
}

resp_lik_itempool_cpp <- function(resp, theta, ip) {
    .Call(`_irt_resp_lik_itempool_cpp`, resp, theta, ip)
}

#' Calculate the likelihood of a Response object
#' 
#' @description It is assumed that the testlet items are administered together.
#'   In other words, it is assumed that there are no items administered 
#'   between any two items within the same testlet that does not belong to
#'   that testlet.
#' 
#' 
#' @param theta A single numeric value representing the ability of the examinee
#' @param resp A Response object.
#' @param ip An Itempool object.
#' 
#' @noRd
#' 
resp_lik_response_cpp <- function(theta, resp, ip) {
    .Call(`_irt_resp_lik_response_cpp`, theta, resp, ip)
}

resp_lik_response_set_cpp <- function(resp_set, theta, ip) {
    .Call(`_irt_resp_lik_response_set_cpp`, resp_set, theta, ip)
}

resp_loglik_bare_item_cpp <- function(resp, theta, item, derivative = 0L) {
    .Call(`_irt_resp_loglik_bare_item_cpp`, resp, theta, item, derivative)
}

#' Calculate the response log-likelihood of a response string.
#' @param resp Response vector.
#' @param theta Theta value.
#' @param item An \code{Item-class} object.
#' @param derivative An integer indicating which derivative to calculate:
#'    0 = No derivative
#'    1 = First derivative
#'    2 = Second derivative
#'
#' @noRd
#'
resp_loglik_item_cpp <- function(resp, theta, item, derivative = 0L) {
    .Call(`_irt_resp_loglik_item_cpp`, resp, theta, item, derivative)
}

resp_loglik_btm_integral_cpp <- function(u, mu, sigma, resp, theta, item_list) {
    .Call(`_irt_resp_loglik_btm_integral_cpp`, u, mu, sigma, resp, theta, item_list)
}

#' Calculate response log-likelihood for a testlet and a single theta (and a
#' response string)
#' @param resp Response vector.
#' @param theta Theta value.
#' @param testlet A \code{Testlet-class} object.
#' @param derivative An integer indicating which derivative to calculate:
#'    0 = No derivative
#'    1 = First derivative
#'    2 = Second derivative
#'
#' @noRd
#'
resp_loglik_bare_testlet_cpp <- function(resp, theta, testlet, derivative = 0L) {
    .Call(`_irt_resp_loglik_bare_testlet_cpp`, resp, theta, testlet, derivative)
}

resp_loglik_testlet_cpp <- function(resp, theta, testlet, derivative = 0L) {
    .Call(`_irt_resp_loglik_testlet_cpp`, resp, theta, testlet, derivative)
}

resp_loglik_bare_itempool_cpp <- function(resp, theta, ip, derivative = 0L) {
    .Call(`_irt_resp_loglik_bare_itempool_cpp`, resp, theta, ip, derivative)
}

resp_loglik_itempool_cpp <- function(resp, theta, ip, derivative = 0L) {
    .Call(`_irt_resp_loglik_itempool_cpp`, resp, theta, ip, derivative)
}

resp_loglik_response_cpp <- function(theta, resp, ip, derivative = 0L) {
    .Call(`_irt_resp_loglik_response_cpp`, theta, resp, ip, derivative)
}

resp_loglik_response_set_cpp <- function(resp_set, theta, ip, derivative = 0L) {
    .Call(`_irt_resp_loglik_response_set_cpp`, resp_set, theta, ip, derivative)
}

check_validity_response_set_cpp <- function(resp_set, ip) {
    .Call(`_irt_check_validity_response_set_cpp`, resp_set, ip)
}

get_examinee_id_response_set_cpp <- function(resp_set) {
    .Call(`_irt_get_examinee_id_response_set_cpp`, resp_set)
}

max_score_response_set_cpp <- function(resp_set, ip) {
    .Call(`_irt_max_score_response_set_cpp`, resp_set, ip)
}

#' @title Create a Response class object for a single examinee for an item pool
#'
#' @param theta A value representing theta
#' @param ip An item pool objec.
#' @param examinee_id A string representing examinee ID.
#' @param ip_size the size of the item pool.
#' @param prop_missing proportion of missing
#'
#' NOTE: if the prop_missing value is close to 1, unexpected behavior can be
#' observed.
#'
#' @noRd
#'
#' @examples
#' ip <- c(generate_testlet(item_id_preamble = "t1"),
#'         generate_ip(n = 5, model = c("2PL", "3PL", "GPCM", "PCM", "GRM")),
#'         generate_testlet(item_id_preamble = "t2"))
#' irt:::sim_resp_response_cpp(theta = 1, ip = ip, examinee_id = "abc",
#'                             prop_missing = 0.5)
NULL

#' @title Create a Response_set class object for multiple examinees for an item
#'   pool
#'
#' @param theta A vector representing thetas
#' @param ip An item pool objec.
#' @param examinee_id A vector representing examinee_id's
#' @param prop_missing proportion of missing
#'
#' NOTE: if the prop_missing value is close to 1, unexpected behavior can be
#' observed.
#'
#' @noRd
#'
#' @examples
#' ip <- c(generate_testlet(item_id_preamble = "t1"),
#'         generate_ip(n = 5, model = c("2PL", "3PL", "GPCM", "PCM", "GRM")),
#'         generate_testlet(item_id_preamble = "t2"))
#' irt:::sim_resp_response_set_cpp(theta = rnorm(3), ip = ip,
#'                                 prop_missing = 0.5)
NULL

sim_resp_4pm_bare_cpp <- function(theta, item) {
    .Call(`_irt_sim_resp_4pm_bare_cpp`, theta, item)
}

sim_resp_poly_bare_cpp <- function(theta, item) {
    .Call(`_irt_sim_resp_poly_bare_cpp`, theta, item)
}

sim_resp_bare_cpp <- function(theta, item) {
    .Call(`_irt_sim_resp_bare_cpp`, theta, item)
}

sim_resp_response_cpp <- function(theta, ip, examinee_id = "", ip_size = NA_integer_, prop_missing = 0) {
    .Call(`_irt_sim_resp_response_cpp`, theta, ip, examinee_id, ip_size, prop_missing)
}

sim_resp_response_set_cpp <- function(theta, ip, examinee_id = "", prop_missing = 0) {
    .Call(`_irt_sim_resp_response_set_cpp`, theta, ip, examinee_id, prop_missing)
}