inst/doc/prowise-learn-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_prowise_learn <- function(pers, item, R, admin, K_theta = 0.1, K_b = 0.1) {
#   long  <- meow_long(R, admin)
#   E_Sij <- stats::plogis(pers$theta[long$id] - item$b[long$item])
# 
#   # ability update (as in Maths Garden)
#   dtheta <- tapply(long$resp - E_Sij, long$id, sum)
#   pers$theta[as.integer(names(dtheta))] <-
#     pers$theta[as.integer(names(dtheta))] + K_theta * dtheta
# 
#   # paired item updates over consecutive administrations
#   n <- nrow(long)
#   if (n >= 2) {
#     nxt <- 2:n; prv <- 1:(n - 1)
#     pair <- which(long$id[nxt] == long$id[prv])
#     if (length(pair) > 0) {
#       now <- nxt[pair]; pre <- prv[pair]
#       kappa <- 0.5 * (K_b * (long$resp[now] - E_Sij[now]) -
#                       K_b * (long$resp[pre] - E_Sij[pre]))
#       add_now <- tapply(kappa,  long$item[now], sum)
#       add_pre <- tapply(-kappa, long$item[pre], sum)
#       item$b[as.integer(names(add_now))] <- item$b[as.integer(names(add_now))] + add_now
#       item$b[as.integer(names(add_pre))] <- item$b[as.integer(names(add_pre))] + add_pre
#     }
#   }
#   list(pers = pers, item = item)
# }

## -----------------------------------------------------------------------------
sim <- meow(
  select_fun  = select_max_info,
  update_fun  = update_prowise_learn,
  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])