irt_mirt <- function(data,
rownames = NULL,
item_type = "Rasch",
irt_pars = TRUE,
tol = 1e-5){
if (is.null(rownames)) rownames = seq_len(nrow(data))
out <- list(data = NULL,
model = list(engine = list(pkg = NULL,
ver = NULL,
func = NULL,
call = NULL),
n_factors = NULL,
item_type = NULL),
estimation = list(convergence = NULL,
method = NULL,
criteria = NULL,
iterations = NULL,
log_lik = NULL),
parameters = list(
coefficients = NULL,
persons = NULL
),
original_object = NULL)
# Running mirt
mirt_model <- mirt::mirt(data, model = 1, itemtype = item_type, verbose = F, TOL = tol, SE = T)
# Standardizing mirt
out$data = tibble::as_tibble(mirt_model@Data$data)
out$model$engine$pkg = 'mirt'
out$model$engine$ver = packageVersion('mirt')
out$model$engine$func = 'mirt'
out$model$engine$call = mirt_model@Call
out$model$n_factors = 1
out$model$item_type = item_type
out$estimation$convergence = mirt_model@OptimInfo$converged
out$estimation$method = mirt_model@Options$method
out$estimation$log_lik = mirt_model@Fit$logLik
out$estimation$iterations = mirt::extract.mirt(mirt_model, 'iterations')
out$estimation$criteria = mirt_model@Options$TOL
out$original_object = mirt_model
out$parameters$coefficients = tibble::tibble(tibble::rownames_to_column(`colnames<-`(data.frame(mirt::coef(mirt_model, simplify = T, IRTpars = irt_pars)$items)[,c(2,1,3)], c("difficulty", "discrimination", 'guessing')), "item"))
out$parameters$persons = dplyr::rename(tibble::as_tibble(mirt::fscores(mirt_model, full.scores.SE = T)), ability = "F1", std_err = "SE_F1" ) %>% dplyr::mutate(ids = rownames)
out
}
irt_ltm <- function(data, rownames = NULL, item_type = "Rasch", irt_pars = TRUE){
if (is.null(rownames)) rownames = seq_len(nrow(data))
out <- list(data = NULL,
model = list(engine = list(pkg = NULL,
ver = NULL,
func = NULL,
call = NULL),
n_factors = NULL,
item_type = NULL),
estimation = list(convergence = NULL,
method = NULL,
criteria = NULL,
iterations = NULL,
log_lik = NULL,
vcov = NULL),
parameters = list(
coefficients = NULL,
persons = NULL
),
original_object = NULL)
if (item_type == "Rasch") {
ltm_model <- ltm::rasch(data, constraint = cbind(ncol(data) + 1, 1), IRT.param = irt_pars)
} else if (item_type == "1PL") {
ltm_model <- ltm::rasch(data, IRT.param = irt_pars)
} else {
rlang::abort(glue::glue("item_type '{item_type}' is unknown."))
}
out$data = tibble::as_tibble(ltm_model$X)
out$model$engine$pkg = 'ltm'
out$model$engine$ver = packageVersion('ltm')
out$model$engine$func = 'rasch'
out$model$engine$call = ltm_model$call
out$model$n_factors = 1
out$model$item_type = item_type
out$estimation$convergence = ltm_model$convergence == 0
out$estimation$method = ltm_model$control$method # This is the method for optimization, not estimation. It seems optimization is Maximum likelihood.
out$estimation$log_lik = ltm_model$log.Lik
out$estimation$iterations = NA # xxxx
out$estimation$criteria = NA # xxxx
out$estimation$vcov = vcov(ltm_model)
out$original_object = ltm_model
out$parameters$coefficients = tibble::tibble(tibble::rownames_to_column(data.frame(`colnames<-`(ltm_model$coefficients, c("difficulty", "discrimination"))), "item"))
if (item_type %in% c('Rasch', '1PL', '2PL')){
out$parameters$coefficients$guessing <- 0
}
out$parameters$persons = `colnames<-`(dplyr::left_join(tidyr::unite(data, "response_pattern"),
tidyr::unite(factor.scores(ltm_model)$score.dat,
"response_pattern" ,
1:(ncol(factor.scores(ltm_model)$score.dat)-4)),
by = "response_pattern")[,-1:-3], c("ability", "std_err")) %>%
dplyr::mutate(ids = rownames)
out
}
# to tam in process, lux
irt_tam <- function(data, item_type = "Rasch", irt_pars = TRUE){
library(TAM) # ok, so this should be fixed by making wizirt depend on ltm...
out <- list(data = NULL,
model = list(engine = list(pkg = NULL,
ver = NULL,
func = NULL,
call = NULL),
n_factors = NULL,
item_type = NULL),
estimation = list(convergence = NULL,
#warnings = NULL, # I want to add this, but I don't know how right now.
method = NULL,
criteria = NULL,
iterations = NULL,
log_lik = NULL),
parameters = list(
coefficients = NULL,
persons = NULL
),
original_object = NULL)
if (item_type == "Rasch") {
tam_model <- TAM::tam.mml(resp=data)
} else if (item_type == "1PL") {
ltm_model <- ltm::rasch(data, IRT.param = irt_pars)
} else {
rlang::abort(glue::glue("item_type '{item_type}' is unknown."))
}
out$data = tibble::as_tibble(ltm_model$X)
out$model$engine$pkg = 'ltm'
out$model$engine$ver = packageVersion('ltm')
out$model$engine$func = 'rasch'
out$model$engine$call = ltm_model$call
out$model$n_factors = 1
out$model$item_type = item_type
out$estimation$convergence = ltm_model$convergence == 0
out$estimation$method = ltm_model$control$method # This is the method for optimization, not estimation. It seems optimization is Maximum likelihood.
out$estimation$log_lik = ltm_model$log.Lik
out$estimation$iterations = NA # xxxx
out$estimation$criteria = NA # xxxx
out$original_object = ltm_model
out$parameters$coefficients = tibble::tibble(tibble::rownames_to_column(data.frame(`colnames<-`(ltm_model$coefficients, c("difficulty", "discrimination"))), "item"))
out$parameters$persons = `colnames<-`(dplyr::left_join(tidyr::unite(data, "response_pattern"),
tidyr::unite(factor.scores(ltm_model)$score.dat,
"response_pattern" ,
1:(ncol(factor.scores(ltm_model)$score.dat)-4)),
by = "response_pattern")[,-1:-3], c("ability", "std_err"))
out
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.