inst/doc/network-item-selection.R

In meow: Unified Framework for Computer Adaptive Testing Simulations

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

## ----eval = FALSE-------------------------------------------------------------
# edge_weight_inverse(adj_mat, alpha = 1)              # 1 / (adj_mat + alpha)
# edge_weight_negative_log(adj_mat, alpha = 1)         # -log(adj_mat + alpha)
# edge_weight_linear(adj_mat, max_co_responses = NULL) # adj_mat / max(adj_mat)
# edge_weight_power(adj_mat, beta = 0.5, alpha = 1)    # (adj_mat + alpha)^beta
# edge_weight_exponential(adj_mat, lambda = 0.1)       # exp(-lambda*(adj_mat+alpha))

## ----eval = FALSE-------------------------------------------------------------
# select_max_dist <- function(pers, item, R, admin, adj_mat = NULL, n_candidates = 1) {
#   if (!any(admin != 0)) {
#     admin[, seq_len(min(5, ncol(admin)))] <- 1L     # seed five items
#     return(admin)
#   }
#   dist_mat <- Rfast::floyd(1 / adj_mat)              # all-pairs shortest paths
#   info <- {                                          # 2PL information matrix
#     lin <- sweep(outer(pers$theta, item$b, "-"), 2, item$a, "*")
#     P <- stats::plogis(lin); sweep(P * (1 - P), 2, item$a^2, "*")
#   }
#   for (i in which(rowSums(admin == 0) > 0)) {
#     administered <- which(admin[i, ] != 0)
#     candidates   <- which(admin[i, ] == 0)
#     sub <- dist_mat[administered, candidates, drop = FALSE]
#     cand_dist <- if (length(administered) == 1L) sub[1, ] else Rfast::colMins(sub, value = TRUE)
#     pool <- candidates[cand_dist >= max(cand_dist)]  # farthest items
#     admin[i, pool[which.max(info[i, pool])]] <- 1L   # tie-break by information
#   }
#   admin
# }

## -----------------------------------------------------------------------------
sim <- meow(
  select_fun  = select_max_dist,
  update_fun  = update_theta_mle,
  data_loader = data_simple_1pl,
  data_args   = list(N_persons = 50, N_items = 30),
  select_args = list(n_candidates = 3),
  fix         = "item"
)
nrow(sim$results)

## ----eval = FALSE-------------------------------------------------------------
# # Power transformation with beta = 0.3
# meow(
#   select_fun  = select_max_dist_enhanced,
#   update_fun  = update_theta_mle,
#   data_loader = data_simple_1pl,
#   data_args   = list(N_persons = 100, N_items = 50),
#   select_args = list(
#     n_candidates = 3,
#     edge_weight_fun = edge_weight_power,
#     edge_weight_args = list(beta = 0.3, alpha = 1)
#   ),
#   fix = "item"
# )