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