inst/doc/annotation-workflow.R

In foundryR: Data Frame Workflows for 'Microsoft Foundry'

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

# Attach foundryR before start_vignette(): httptest2 only sources the package's
# inst/httptest2/start-vignette.R (which sets replay placeholders) from attached
# packages.
library(foundryR)

if (run_api) {
  httptest2::start_vignette(fixture_dir)
}

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = run_api
)

## ----data, eval = TRUE--------------------------------------------------------
library(foundryR)
library(dplyr)

responses <- tibble::tibble(
  respondent_id = 1:6,
  response = c(
    "The lectures were clear, but the weekly quizzes felt rushed.",
    "I liked the examples in R. More office hours would help.",
    "The project made the material practical.",
    "I struggled because the instructions changed late.",
    "The instructor explained regression well.",
    "The course needed more examples before the final exam."
  )
)

## ----schema, eval = TRUE------------------------------------------------------
annotation_schema <- list(
  type = "object",
  properties = list(
    sentiment = list(type = "string", enum = c("positive", "negative", "mixed")),
    primary_theme = list(
      type = "string",
      enum = c("instruction", "assessment", "support", "materials")
    ),
    needs_followup = list(type = "boolean"),
    short_summary = list(type = "string")
  ),
  required = c(
    "sentiment",
    "primary_theme",
    "needs_followup",
    "short_summary"
  ),
  additionalProperties = FALSE
)

## ----extract------------------------------------------------------------------
annotations <- foundry_extract(
  responses$response,
  schema = annotation_schema,
  instructions = paste(
    "Code each survey response for a course evaluation.",
    "Use the respondent's words. Do not infer facts that are not stated."
  )
)

coded <- bind_cols(responses, annotations)
coded

## ----batch, eval = FALSE------------------------------------------------------
# jsonl <- tempfile(fileext = ".jsonl")
# 
# foundry_batch_requests(
#   responses,
#   input = "response",
#   path = jsonl,
#   model = "gpt-5-nano",
#   endpoint = "/v1/responses",
#   body = list(
#     instructions = paste(
#       "Code each survey response using the supplied schema.",
#       "Return only JSON that conforms to the schema."
#     ),
#     text = list(
#       format = list(
#         type = "json_schema",
#         name = "CourseEvaluationAnnotation",
#         schema = annotation_schema,
#         strict = TRUE
#       )
#     )
#   )
# )
# 
# file <- foundry_file_upload(jsonl, purpose = "batch")
# unlink(jsonl)
# batch <- foundry_batch_create(file$file_id, endpoint = "/v1/responses")
# foundry_batch_get(batch$batch_id)

## ----embeddings---------------------------------------------------------------
embeddings <- foundry_embed(
  responses$response,
  model = "text-embedding-3-small"
)

similarity <- foundry_similarity(embeddings)
head(similarity, 10)

## ----groundedness-------------------------------------------------------------
finding <- paste(
  "Students generally praised clear instruction and practical examples.",
  "Several asked for more examples and more support before assessments."
)

grounding_text <- paste(responses$response, collapse = "\n")

groundedness <- foundry_groundedness(
  text = finding,
  grounding_sources = grounding_text,
  query = "What did students say about the course?",
  task = "QnA"
)

groundedness

## ----review-table-------------------------------------------------------------
review <- coded |>
  select(
    respondent_id,
    response,
    sentiment,
    primary_theme,
    needs_followup,
    short_summary
  )

review

## ----review-table-rendered, echo = FALSE, eval = run_api && requireNamespace("gt", quietly = TRUE)----
review |>
  dplyr::mutate(
    needs_followup = ifelse(needs_followup, "Review", "No review"),
    response = substr(response, 1, 70)
  ) |>
  gt::gt() |>
  gt::cols_label(
    respondent_id = "ID",
    response = "Response",
    sentiment = "Sentiment",
    primary_theme = "Theme",
    needs_followup = "Follow-up",
    short_summary = "Summary"
  ) |>
  gt::tab_header(title = "Structured annotations from open-ended responses") |>
  gt::tab_options(table.font.names = "Inter")

## ----sentiment-theme-chart, echo = FALSE, eval = run_api && requireNamespace("ggplot2", quietly = TRUE), fig.alt = "Bar chart of survey response themes by sentiment."----
theme_counts <- review |>
  dplyr::count(primary_theme, sentiment, name = "responses")

ggplot2::ggplot(
  theme_counts,
  ggplot2::aes(x = primary_theme, y = responses, fill = sentiment)
) +
  ggplot2::geom_col(position = "dodge", width = 0.72) +
  ggplot2::scale_fill_manual(
    values = c(
      negative = "#D13438",
      mixed = "#FFB900",
      positive = "#107C10"
    )
  ) +
  ggplot2::labs(
    title = "Extracted labels make response patterns countable",
    x = "Primary theme",
    y = "Responses",
    fill = "Sentiment"
  ) +
  ggplot2::theme_minimal(base_size = 12) +
  ggplot2::theme(
    legend.position = "bottom",
    panel.grid.minor = ggplot2::element_blank()
  )

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