## ----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])