Simulate an adaption of 2/1 rule

simulate_adaption.R

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