## ----setup, include = FALSE---------------------------------------------------
fixture_dir <- "annotation-workflow"
recording <- nzchar(Sys.getenv("FOUNDRY_RECORD_DOCS"))
have_fixtures <- dir.exists(fixture_dir) && length(list.files(fixture_dir)) > 0
run_api <- requireNamespace("httptest2", quietly = TRUE) &&
  (recording || have_fixtures)
library(foundryR)
if (run_api) {
  httptest2::start_vignette(fixture_dir)
}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = run_api,
  fig.width = 7, fig.height = 4.5, out.width = "100%")

## ----libraries, message = FALSE, eval = TRUE----------------------------------
library(foundryR)
library(dplyr)

## ----comments, eval = TRUE----------------------------------------------------
comments <- tibble::tibble(
  comment_id = sprintf("c%02d", 1:10),
  comment = c(
    "The lectures were clear and the examples made regression feel concrete.",
    "The weekly quizzes felt rushed and did not match the homework.",
    "Office hours helped me catch up after I missed the first lab.",
    "The slides were hard to follow because notation changed between weeks.",
    "The final project connected the material to real policy questions.",
    "I needed more feedback before the midterm.",
    "The instructor explained difficult topics patiently.",
    "The reading packet was useful, but several links were broken.",
    "Group work helped, although the grading rubric came too late.",
    "More examples before the final exam would have helped."
  )
)

## ----codebook, eval = TRUE----------------------------------------------------
course_schema <- foundry_schema(
  theme = schema_enum(
    c("instruction", "assessment", "support", "materials"),
    description = paste(
      "Primary theme: instruction, assessment, support, or materials."
    )
  ),
  sentiment = schema_enum(
    c("positive", "negative", "mixed"),
    description = "Overall sentiment toward the course element."
  )
)

course_instructions <- paste(
  "Code one course evaluation comment.",
  "Choose exactly one primary theme.",
  "Use instruction for teaching clarity or examples.",
  "Use assessment for quizzes, exams, projects, grading or feedback.",
  "Use support for office hours or help outside class.",
  "Use materials for slides, readings, links or course files.",
  "Choose positive, negative or mixed sentiment from the student's wording."
)

course_codebook <- foundry_codebook(
  name = "course-evaluation-codes",
  version = "1.0.0",
  instructions = course_instructions,
  schema = course_schema,
  examples = list(
    list(
      text = "The lectures were clear.",
      theme = "instruction",
      sentiment = "positive"
    ),
    list(
      text = "The rubric came too late.",
      theme = "assessment",
      sentiment = "negative"
    )
  )
)

course_codebook

## ----codebook-diff, eval = TRUE-----------------------------------------------
course_schema_v2 <- foundry_schema(
  theme = schema_enum(
    c("instruction", "assessment", "support", "materials", "workload"),
    description = paste(
      "Primary theme: instruction, assessment, support, materials, or workload."
    )
  ),
  sentiment = schema_enum(
    c("positive", "negative", "mixed"),
    description = "Overall sentiment toward the course element."
  )
)

course_codebook_v2 <- foundry_codebook(
  name = "course-evaluation-codes",
  version = "1.1.0",
  instructions = paste(
    course_instructions,
    "Use workload for comments about pacing or volume that are not mainly assessment."
  ),
  schema = course_schema_v2,
  examples = course_codebook$examples
)

codebook_diff(course_codebook, course_codebook_v2)

## ----extract------------------------------------------------------------------
coding_model <- "gpt-5-nano" # your deployment name

model_labels <- foundry_extract(
  comments,
  text_col = "comment",
  schema = course_codebook$schema,
  instructions = course_codebook$instructions,
  model = coding_model
)

model_labels |>
  select(comment_id, theme, sentiment)

## ----hand-codes, eval = TRUE--------------------------------------------------
hand_codes <- tibble::tibble(
  comment_id = c("c01", "c02", "c03", "c04", "c05", "c06"),
  human_theme = c(
    "instruction",
    "assessment",
    "support",
    "materials",
    "assessment",
    "assessment"
  ),
  human_sentiment = c(
    "positive",
    "negative",
    "positive",
    "negative",
    "positive",
    "negative"
  )
)

hand_codes

## ----agreement----------------------------------------------------------------
validation_sample <- model_labels |>
  select(comment_id, theme, sentiment) |>
  inner_join(hand_codes, by = "comment_id")

theme_agreement <- foundry_agreement(
  validation_sample,
  estimate = "theme",
  truth = "human_theme"
) |>
  mutate(variable = "theme")

sentiment_agreement <- foundry_agreement(
  validation_sample,
  estimate = "sentiment",
  truth = "human_sentiment"
) |>
  mutate(variable = "sentiment")

bind_rows(theme_agreement, sentiment_agreement) |>
  select(variable, metric, value, n)

## ----agreement-summary, echo = FALSE, results = "asis"------------------------
theme_accuracy <- theme_agreement$value[theme_agreement$metric == "accuracy"]
pairs <- theme_agreement$n[[1]]
if (isTRUE(all.equal(theme_accuracy, 1))) {
  cat(sprintf(
    "All %d theme pairs agree in this recording. That says little on its own, because %d comments written to be unambiguous are an easy test. A real validation sample is drawn at random from the data being coded and is large enough for an interval on accuracy to be informative.\n",
    pairs, pairs
  ))
} else {
  cat(sprintf(
    "The model agrees with the hand codes on %.0f%% of %d theme pairs. Read the disagreeing rows before deciding whether the codebook or the model needs work.\n",
    100 * theme_accuracy, pairs
  ))
}

## ----consistency--------------------------------------------------------------
stability <- foundry_consistency(
  comments$comment[1:4],
  schema = course_codebook$schema,
  n = 3,
  instructions = course_codebook$instructions,
  model = coding_model
)

stability |>
  select(.input_idx, successful_runs, failed_runs, modal_share, entropy)

## ----stability-summary, echo = FALSE, results = "asis"------------------------
stable <- sum(stability$modal_share == 1, na.rm = TRUE)
cat(sprintf(
  "In this recording %d of %d comments received the same record in all %d runs. Short, clear comments are the easy case; run the same check on the ambiguous comments your hand coders disagreed about.\n",
  stable, nrow(stability), stability$n[[1]]
))

## ----theme-intervals----------------------------------------------------------
theme_levels <- course_codebook$schema$properties$theme$enum |> as.character()

theme_estimates <- lapply(theme_levels, function(level) {
  x <- sum(model_labels$theme == level, na.rm = TRUE)
  n <- sum(!is.na(model_labels$theme))
  interval <- binom.test(x, n)$conf.int
  tibble::tibble(
    theme = level,
    labels = x,
    total = n,
    share = x / n,
    conf_low = interval[[1]],
    conf_high = interval[[2]]
  )
}) |>
  bind_rows()

theme_estimates

## ----provenance---------------------------------------------------------------
run_provenance <- foundry_provenance(
  model = coding_model,
  schema = course_codebook$schema,
  metadata = list(
    codebook = course_codebook$name,
    codebook_version = course_codebook$version,
    codebook_hash = course_codebook$hash
  )
)

run_provenance |>
  select(model, schema_hash, package_version, captured_at)

## ----cleanup, include = FALSE-------------------------------------------------
if (run_api) {
  httptest2::end_vignette()
}