R/irt_wrapper_functions.R

In Pflegermeister/wizirt2: A United API for IRT in R

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
}