Nothing
# 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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.