inst/doc/maths-garden-update.R

In meow: Unified Framework for Computer Adaptive Testing Simulations

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(meow)

## ----eval = FALSE-------------------------------------------------------------
# update_maths_garden <- function(pers, item, R, admin, K_theta = 0.1, K_b = 0.1) {
#   idx    <- which(admin != 0, arr.ind = TRUE)
#   person <- idx[, 1]
#   itm    <- idx[, 2]
#   resp   <- R[idx]
# 
#   E_Sij <- stats::plogis(pers$theta[person] - item$b[itm])
# 
#   dtheta <- tapply(resp - E_Sij, person, sum)
#   pers$theta[as.integer(names(dtheta))] <-
#     pers$theta[as.integer(names(dtheta))] + K_theta * dtheta
# 
#   db <- tapply(E_Sij - resp, itm, sum)
#   item$b[as.integer(names(db))] <-
#     item$b[as.integer(names(db))] + K_b * db
# 
#   list(pers = pers, item = item)
# }

## -----------------------------------------------------------------------------
sim <- meow(
  select_fun  = select_max_info,
  update_fun  = update_maths_garden,
  data_loader = data_simple_1pl,
  data_args   = list(N_persons = 100, N_items = 50),
  update_args = list(K_theta = 0.05, K_b = 0.05)
)
head(sim$results[, 1:3])

## ----eval = FALSE-------------------------------------------------------------
# update_maths_garden_adaptive <- function(pers, item, R, admin,
#                                          base_K = 0.1, decay = 0.05,
#                                          bounds = c(-4, 4)) {
#   idx    <- which(admin != 0, arr.ind = TRUE)
#   person <- idx[, 1]
#   itm    <- idx[, 2]
#   resp   <- R[idx]
#   E_Sij  <- stats::plogis(pers$theta[person] - item$b[itm])
# 
#   n_person <- tapply(resp, person, length)
#   err_p    <- tapply(resp - E_Sij, person, sum)
#   who_p    <- as.integer(names(err_p))
#   K_p      <- base_K / (1 + n_person * decay)
#   pers$theta[who_p] <- pers$theta[who_p] + K_p * err_p
#   pers$theta <- pmin(pmax(pers$theta, bounds[1]), bounds[2])
# 
#   n_item <- tapply(resp, itm, length)
#   err_i  <- tapply(E_Sij - resp, itm, sum)
#   who_i  <- as.integer(names(err_i))
#   K_i    <- base_K / (1 + n_item * decay)
#   item$b[who_i] <- item$b[who_i] + K_i * err_i
#   item$b <- pmin(pmax(item$b, bounds[1]), bounds[2])
# 
#   list(pers = pers, item = item)
# }