## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----cmdstan-check------------------------------------------------------------ cmdstan_available <- identical(Sys.getenv("PAIRWISELLM_RUN_CMDSTAN_VIGNETTES"), "true") && requireNamespace("cmdstanr", quietly = TRUE) && tryCatch({ cmdstanr::cmdstan_version() TRUE }, error = function(e) FALSE) cmdstan_available ## ----cmdstan-install, eval=FALSE---------------------------------------------- # install.packages( # "cmdstanr", # repos = c("https://stan-dev.r-universe.dev", getOption("repos")) # ) # cmdstanr::check_cmdstan_toolchain(fix = TRUE) # cmdstanr::install_cmdstan() ## ----linking-data------------------------------------------------------------- library(pairwiseLLM) make_set <- function(set_id, prefix, scores) { local_id <- sprintf("%02d", seq_along(scores)) data.frame( ID = paste0(prefix, "_", local_id), text = paste("Writing sample", prefix, local_id), quality_score = as.double(scores), set_id = as.integer(set_id), global_item_id = paste0("study_2026_", prefix, "_", local_id), stringsAsFactors = FALSE ) } hub_samples <- make_set(1L, "hub", c(6.0, 5.0, 4.0, 3.0, 2.0, 1.0)) spoke_2_samples <- make_set(2L, "school_b", c(5.5, 4.5, 3.5, 2.5, 1.5, 0.5)) spoke_3_samples <- make_set(3L, "school_c", c(5.2, 4.2, 3.2, 2.2, 1.2, 0.2)) linking_samples <- rbind(hub_samples, spoke_2_samples, spoke_3_samples) stopifnot(!anyDuplicated(linking_samples$ID)) stopifnot(!anyDuplicated(linking_samples$global_item_id)) deterministic_judge <- function(A, B, state, ...) { list( is_valid = TRUE, Y = as.integer(A$quality_score[[1L]] >= B$quality_score[[1L]]), invalid_reason = NA_character_ ) } ## ----tutorial-settings-------------------------------------------------------- tutorial_btl <- list( refit_pairs_target = 3L, ess_bulk_min = 1, ess_bulk_min_near_stop = 1, max_rhat = 5, divergences_max = 100L ) tutorial_link_controls <- list( phase_a_required_reliability_min = 0, probe_panel_edges = 8L, probe_pairs_per_refit_per_spoke = 1L, probe_edges_min_for_stop = 2L, min_refits_in_phase_b = 1L, stability_window_refits = 1L, stability_passes_required = 1L ) ## ----phase-a-runs, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # phase_a_root <- tempfile("pairwisellm-phase-a-") # # hub_run <- adaptive_rank( # data = hub_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 6L, # btl_config = tutorial_btl, # session_dir = file.path(phase_a_root, "hub"), # persist_item_log = TRUE, # resume = FALSE, # seed = 101L, # progress = "none" # ) # # spoke_2_run <- adaptive_rank( # data = spoke_2_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 6L, # btl_config = tutorial_btl, # session_dir = file.path(phase_a_root, "spoke-2"), # persist_item_log = TRUE, # resume = FALSE, # seed = 102L, # progress = "none" # ) # # hub_run$phase_a$set_status # spoke_2_run$phase_a$set_status # hub_run$phase_a$artifact_paths ## ----phase-a-inspection, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # hub_artifact <- hub_run$phase_a$manifest[["1"]] # # names(hub_artifact) # hub_artifact[c("set_id", "n_items", "n_pairs_committed", "fit_model_id")] # hub_artifact$diagnostics # head(hub_artifact$items) # head(hub_artifact$phase_a_within_set_evidence) ## ----trusted-simulation-artifacts, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # phase_a_artifacts <- list( # `1` = hub_run$phase_a$manifest[["1"]], # `2` = spoke_2_run$phase_a$manifest[["2"]] # ) # # phase_a_artifacts <- lapply(phase_a_artifacts, function(artifact) { # artifact$quality_gate_accepted <- TRUE # artifact # }) ## ----one-spoke-link, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # one_spoke_samples <- linking_samples[linking_samples$set_id %in% c(1L, 2L), ] # one_spoke_session <- tempfile("pairwisellm-one-spoke-") # # one_spoke <- adaptive_rank( # data = one_spoke_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 10L, # adaptive_config = c( # list( # run_mode = "link_one_spoke", # hub_id = 1L, # phase_a_mode = "import", # phase_a_artifacts = phase_a_artifacts # ), # tutorial_link_controls # ), # btl_config = tutorial_btl, # session_dir = one_spoke_session, # persist_item_log = TRUE, # resume = FALSE, # seed = 201L, # progress = "none" # ) ## ----one-spoke-results, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # one_spoke$summary # # one_spoke$items[, c( # "item_id", "set_id", # "theta_raw_eap", "rank_raw", "theta_link_eap", "theta_link_sd", "rank_link" # )] ## ----one-spoke-logs, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # names(one_spoke$logs) # # cross_set_steps <- one_spoke$logs$step_log[ # one_spoke$logs$step_log$is_cross_set %in% TRUE, # c( # "step_id", "pair_id", "A_id", "B_id", "Y", "status", # "link_spoke_id", "link_stage", "is_probe_step", "judge_invalid_reason" # ) # ] # head(cross_set_steps) # # link_status <- one_spoke$logs$link_stage_log[, c( # "refit_id", "spoke_id", "link_estimation_mode", "hub_anchored", # "reliability_link_global", "linking_identified", "link_stop_eligible", # "link_stop_pass", "link_state_frozen", "stop_blocker_codes" # )] # tail(link_status) # # probe_status <- one_spoke$logs$link_stage_log[, c( # "refit_id", "spoke_id", "probe_edges_planned", "probe_edges_realized", # "probe_panel_shortfall", "probe_shortfall_reason", "probe_quality_pass", # "probe_quality_blocker_codes" # )] # tail(probe_status) # # budget_status <- one_spoke$logs$link_stage_log[, c( # "refit_id", "spoke_id", "B_spoke_refit_budget", # "n_cross_edges_active_since_last_refit", "n_cross_edges_probe_since_last_refit", # "stage_budget_unfilled" # )] # tail(budget_status) ## ----mixed-mode, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))----- # mixed_samples <- linking_samples[linking_samples$set_id %in% c(1L, 3L), ] # # mixed <- adaptive_rank( # data = mixed_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 6L, # adaptive_config = c( # list( # run_mode = "link_one_spoke", # hub_id = 1L, # phase_a_mode = "mixed", # phase_a_artifacts = list(`1` = phase_a_artifacts[["1"]]) # ), # tutorial_link_controls # ), # btl_config = tutorial_btl, # session_dir = tempfile("pairwisellm-mixed-"), # resume = FALSE, # seed = 301L, # progress = "none" # ) # # mixed$phase_a$set_status ## ----third-artifact, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # spoke_3_run <- adaptive_rank( # data = spoke_3_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 6L, # btl_config = tutorial_btl, # session_dir = file.path(phase_a_root, "spoke-3"), # persist_item_log = TRUE, # resume = FALSE, # seed = 103L, # progress = "none" # ) # # spoke_3_artifact <- spoke_3_run$phase_a$manifest[["3"]] # spoke_3_artifact$quality_gate_accepted <- TRUE # multi_artifacts <- c(phase_a_artifacts, list(`3` = spoke_3_artifact)) ## ----multi-spoke, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # multi_spoke <- adaptive_rank( # data = linking_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 16L, # adaptive_config = c( # list( # run_mode = "link_multi_spoke", # hub_id = 1L, # phase_a_mode = "import", # phase_a_artifacts = multi_artifacts, # min_cross_set_pairs_per_spoke_per_refit = 1L # ), # tutorial_link_controls # ), # btl_config = tutorial_btl, # session_dir = tempfile("pairwisellm-multi-spoke-"), # resume = FALSE, # seed = 401L, # progress = "none" # ) # # multi_cross <- multi_spoke$logs$step_log[ # multi_spoke$logs$step_log$is_cross_set %in% TRUE & # !is.na(multi_spoke$logs$step_log$pair_id), # c("step_id", "set_i", "set_j", "link_spoke_id", "link_stage") # ] # head(multi_cross) # # latest_by_spoke <- multi_spoke$logs$link_stage_log[ # !duplicated(multi_spoke$logs$link_stage_log$spoke_id, fromLast = TRUE), # c( # "spoke_id", "B_spoke_refit_budget", "linking_identified", # "link_stop_pass", "link_state_frozen", "stop_blocker_codes" # ) # ] # latest_by_spoke ## ----linking-persistence, eval=isTRUE(get0("cmdstan_available", ifnotfound=FALSE))---- # validate_session_dir(one_spoke_session)[c( # "schema_version", "package_version", "n_items" # )] # # saved_state <- load_adaptive_session(one_spoke_session) # summarize_adaptive(saved_state) # # before_steps <- nrow(one_spoke$logs$step_log) # resumed_one_spoke <- adaptive_rank( # data = one_spoke_samples, # id_col = "ID", # text_col = "text", # judge = deterministic_judge, # n_steps = 2L, # adaptive_config = c( # list( # run_mode = "link_one_spoke", # hub_id = 1L, # phase_a_mode = "import", # phase_a_artifacts = phase_a_artifacts # ), # tutorial_link_controls # ), # btl_config = tutorial_btl, # session_dir = one_spoke_session, # persist_item_log = TRUE, # resume = TRUE, # progress = "none" # ) # # c( # before = before_steps, # after = nrow(resumed_one_spoke$logs$step_log) # ) ## ----live-llm-one-spoke, eval=FALSE------------------------------------------- # library(pairwiseLLM) # # stopifnot(nzchar(Sys.getenv("OPENAI_API_KEY"))) # # real_linking_samples <- utils::read.csv( # "writing-samples-to-link.csv", # stringsAsFactors = FALSE # ) # stopifnot(!anyDuplicated(real_linking_samples$ID)) # stopifnot(!anyDuplicated(real_linking_samples$global_item_id)) # stopifnot(length(unique(real_linking_samples$set_id)) == 2L) # # live_link <- adaptive_rank( # data = real_linking_samples, # id_col = "ID", # text_col = "text", # backend = "openai", # model = "gpt-5.6-luna", # endpoint = "responses", # trait_name = "Overall writing quality", # trait_description = paste( # "Prefer the response that is clearer, better organized, better supported,", # "and more effective for its intended audience." # ), # judge_args = list( # reasoning = "none" # ), # n_steps = 200L, # adaptive_config = list( # run_mode = "link_one_spoke", # hub_id = 1L, # phase_a_mode = "run", # max_pairs_after_stop = 0L # ), # session_dir = "adaptive-link-live", # persist_item_log = TRUE, # checkpoint_every_steps = 10L, # resume = TRUE, # seed = 20260904L, # progress = "refits", # save_outputs = TRUE # ) ## ----live-llm-inspection, eval=FALSE------------------------------------------ # live_link$phase_a$set_status # live_link$summary # # live_link$items[, c( # "item_id", "set_id", "theta_link_eap", "theta_link_sd", "rank_link" # )] # # live_link$logs$step_log[, c( # "step_id", "status", "judge_backend", "judge_model", "judge_endpoint", # "judge_invalid_reason", "llm_status_code", "llm_error_message", # "prompt_tokens", "completion_tokens", "total_tokens" # )] |> # tail() # # live_link$logs$link_stage_log[, c( # "refit_id", "spoke_id", "linking_identified", "link_stop_pass", # "link_state_frozen", "probe_edges_realized", "probe_quality_pass", # "stop_blocker_codes" # )] |> # tail() ## ----live-llm-resume, eval=FALSE---------------------------------------------- # live_link <- adaptive_rank( # data = real_linking_samples, # id_col = "ID", # text_col = "text", # backend = "openai", # model = "gpt-5.6-luna", # endpoint = "responses", # trait_name = "Overall writing quality", # trait_description = paste( # "Prefer the response that is clearer, better organized, better supported,", # "and more effective for its intended audience." # ), # judge_args = list(reasoning = "none"), # n_steps = 100L, # adaptive_config = list( # run_mode = "link_one_spoke", # hub_id = 1L, # phase_a_mode = "run", # max_pairs_after_stop = 0L # ), # session_dir = "adaptive-link-live", # persist_item_log = TRUE, # checkpoint_every_steps = 10L, # resume = TRUE, # progress = "refits" # )