inst/doc/extending-meow.R

In meow: Unified Framework for Computer Adaptive Testing Simulations

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

## -----------------------------------------------------------------------------
R <- matrix(c(1, 0, 1, 1), nrow = 2)
admin <- matrix(c(1L, 0L, 2L, 1L), nrow = 2)
meow_long(R, admin)

## -----------------------------------------------------------------------------
data_two_groups <- function(N_per_group = 50, N_items = 40, data_seed = 1) {
  set.seed(data_seed)
  N <- 2 * N_per_group
  theta <- c(stats::rnorm(N_per_group, -0.5), stats::rnorm(N_per_group, 0.5))
  b <- stats::rnorm(N_items)
  pers_tru <- data.frame(id = seq_len(N), theta = theta)
  item_tru <- data.frame(item = seq_len(N_items), b = b, a = 1)

  p <- stats::plogis(outer(theta, b, "-"))
  resp_mat <- matrix(stats::rbinom(length(p), 1, p), nrow = N)
  resp <- data.frame(
    id = rep(seq_len(N), each = N_items),
    item = rep(seq_len(N_items), times = N),
    resp = as.vector(t(resp_mat))
  )
  set.seed(NULL)
  list(resp = resp, pers_tru = pers_tru, item_tru = item_tru)
}

str(data_two_groups(N_per_group = 3, N_items = 4), max.level = 1)

## -----------------------------------------------------------------------------
select_easiest <- function(pers, item, R, admin, adj_mat = NULL) {
  if (!any(admin != 0)) {       # first iteration: seed five items
    admin[, seq_len(min(5, ncol(admin)))] <- 1L
    return(admin)
  }
  difficulty <- item$b
  for (i in which(rowSums(admin == 0) > 0)) {
    remaining <- which(admin[i, ] == 0)
    pick <- remaining[which.min(difficulty[remaining])]
    admin[i, pick] <- 1L
  }
  admin
}

## -----------------------------------------------------------------------------
update_pct_correct <- function(pers, item, R, admin, rate = 0.5) {
  idx <- which(admin != 0, arr.ind = TRUE)
  person <- idx[, 1]
  resp <- R[idx]
  pct <- tapply(resp, person, mean)
  target <- stats::qlogis(pmin(pmax(pct, 0.02), 0.98)) # logit of proportion
  pers$theta[as.integer(names(target))] <-
    (1 - rate) * pers$theta[as.integer(names(target))] + rate * target
  list(pers = pers, item = item)
}

## -----------------------------------------------------------------------------
sim <- meow(
  select_fun  = select_easiest,
  update_fun  = update_pct_correct,
  data_loader = data_two_groups,
  data_args   = list(N_per_group = 25, N_items = 20),
  update_args = list(rate = 0.3),
  fix         = "item"
)

head(sim$results[, 1:4])