Skip to content

Instantly share code, notes, and snippets.

@psychelzh
Last active October 21, 2022 06:59
Show Gist options
  • Save psychelzh/60468831bbd4d98076b50d13ef7a8e79 to your computer and use it in GitHub Desktop.
Save psychelzh/60468831bbd4d98076b50d13ef7a8e79 to your computer and use it in GitHub Desktop.
Simulate an adaption of 2/1 rule
library(tidyverse)
#' Simulate Trials for Adaptive Rules
#'
#' @param num_runs The total runs.
#' @param streak_rule The win-streak required to increase level.
#' @param fast_mode Should the first run ignore `streak_rule`?
#' @param level_init The initial level.
#' @param level_limits A 1-by-2 vector specifying lower and higher limits for
#' levels.
#' @return A [tibble] contains all the information of the trials.
simulate <- function(num_runs = 12, streak_rule = 2, fast_mode = TRUE,
level_init = 2, level_limits = NULL) {
level_limits <- level_limits %||% c(1, 21)
acc_order <- NULL
level_order <- NULL
level_cur <- NULL
level_next <- NULL
run_order <- NULL
run_type_cur <- NULL
run_type_next <- NULL
run_type_order <- NULL
for (run in seq_len(num_runs)) {
run_end <- FALSE
win_streak <- 0
run_type_cur <- run_type_next
streak_rule_real <- if (run == 1 && fast_mode) 1 else streak_rule
while (!run_end) {
level_cur <- level_next %||% level_init
chance <- max(0.5, 1 - 0.05 * (level_cur - 1))
acc <- sample(c(0, 1), 1, prob = c(1 - chance, chance))
if (acc == 1) {
win_streak <- win_streak + 1
if (win_streak == streak_rule_real) {
win_streak <- 0
level_next <- min(level_cur + 1, level_limits[2])
trial_type <- "inc"
} else {
level_next <- level_cur
trial_type <- "neu"
}
} else {
win_streak <- 0
level_next <- max(level_cur - 1, level_limits[1])
trial_type <- "dec"
}
if (trial_type != "neu") {
if (!is.null(run_type_cur) && run_type_cur != trial_type) {
run_type_next <- trial_type
run_end <- TRUE
}
# the first run type is determined by the first non-neutral type
if (is.null(run_type_cur)) {
run_type_cur <- trial_type
}
}
run_order <- c(run_order, run)
run_type_order <- c(run_type_order, run_type_cur %||% "neu")
acc_order <- c(acc_order, acc)
level_order <- c(level_order, level_cur)
}
}
tibble(
run = run_order,
run_type = run_type_order,
trial = seq_len(length(run_order)),
acc = acc_order,
level = level_order
)
}
n_sim <- 1000
num_runs <- 12
n_trials <- integer(n_sim)
for (i in seq_len(n_sim)) {
n_trials[i] <- nrow(simulate(num_runs))
}
simulate(num_runs) |>
ggplot(aes(trial, level, shape = factor(acc))) +
geom_point(size = 2.5) +
scale_shape(solid = FALSE, labels = c("错误", "正确")) +
scale_x_continuous(
breaks = scales::breaks_width(1),
expand = expansion(c(0.01, 0.01))
) +
scale_y_continuous(breaks = scales::breaks_width(1)) +
ggthemes::theme_hc() +
labs(x = "试次", y = "条形个数", shape = "")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment