suppressPackageStartupMessages({
library(dplyr)
library(huggingfaceR)
library(purrr)
library(readr)
library(reticulate)
library(stringr)
library(tibble)
library(tidyr)
})
source("R/use-nlg.R")
handbook <- read_csv(
"data/riverton/riverton-handbook.csv",
na = character(),
col_types = cols(
passage_id = col_character(),
topic = col_character(),
text = col_character(),
source = col_character(),
author_note = col_character()
)
)
questions <- read_csv(
"data/riverton/riverton-handbook-questions.csv",
na = c("", "NA"),
col_types = cols(
question_id = col_character(),
question = col_character(),
probe_type = col_character(),
expected_action = col_character(),
gold_passage_id = col_character(),
acceptable_answers = col_character(),
author_note = col_character()
)
) |>
mutate(
acceptable_list = str_split(coalesce(acceptable_answers, ""), "\\|")
)
metadata <- read_csv(
"data/riverton/riverton-handbook-metadata.csv",
na = character(),
col_types = cols(
artifact = col_character(),
description = col_character(),
source = col_character(),
license = col_character(),
created_on = col_date(),
rows = col_integer(),
fingerprint = col_character()
)
)
qa_model <- load_nlg_pipeline(
"qwen_1_5b_instruct",
"text-generation"
)
model_record <- qa_model$metadata |>
select(model_id, revision, license, task_scope)Answering questions from retrieved passages
Find candidate evidence first, then ask whether the answer is supported
Amara helps at the Riverton Skills Centre desk on days when staff are away from the phone. A short handbook answers many routine questions, but callers do not ask in handbook language. One person asks about a “kid” during night class; another asks a question that assumes a Saturday forklift class exists.
Question answering returns a short answer, an abstention, or a correction of a false premise. Retrieval is only the first step. The system has to choose passages, read only those passages, cite what it used, and say when the passages do not answer the question.
The Riverton Skills Centre handbook is an invented teaching fixture. It does not describe a real school, program, deadline, stipend, or policy.
This lesson shows how to:
- retrieve handbook passages with tf-idf weights fitted on the handbook;
- show when a gold passage shares no content words with the question;
- compare an extractive sentence baseline with a generated short answer;
- parse a strict two-line model reply without rewriting it;
- keep action correctness, reference agreement, support screens, and human review separate; and
- explain why abstention, citations, and fluent wording are not enough.
Load the local reader and handbook
The handbook, questions, and answer variants were written before this lesson retrieves or generates anything. The same author wrote all three, so they are a teaching fixture rather than an independent benchmark.
| Model | Revision | License | Use in this course |
|---|---|---|---|
| Qwen/Qwen2.5-1.5B-Instruct | 989aa7980e4cf806f80c7fef2b1adb7bc71aa306 | Apache-2.0 | abstractive summarization;paraphrasing;long-text generation;question answering;chatbot dialogue |
Read the handbook once
Each passage keeps its passage ID. Later tables cite these IDs instead of row positions.
| Passage ID | Topic | Handbook text |
|---|---|---|
| H01 | location | Classes are held at the Riverton Skills Centre on Mill Street in Riverton. |
| H02 | contact | The enrollment desk answers phone calls from 9 a.m. to 5 p.m., Monday to Friday. Messages left after hours are returned the next business day. |
| H03 | programs | The Riverton Skills Centre runs two programs this fall: the Data Support Certificate and the Forklift Operator Licence course. |
| H04 | forklift eligibility | Forklift Operator Licence applicants must be at least 18 years old and able to lift 50 pounds. |
| H05 | transit | Marrow County Transit bus passes are provided for the first month of either program. Riders pay the regular $2 fare after that. |
| H06 | data schedule | Data Support Certificate classes meet on Monday and Wednesday evenings from 6 p.m. to 9 p.m. The course lasts 12 weeks. |
| H07 | enrollment documents | Bring a photo ID and proof of address to your enrollment appointment. |
| H08 | stipend | Data Support Certificate students receive a training stipend of $150 per week. Students must attend at least 90 percent of classes to receive it. |
| H09 | course codes | In the enrollment system, the Data Support Certificate is listed as course DSC-104 and the forklift course is listed as FOL-210. |
| H10 | refresher workshop | An optional spreadsheet refresher workshop, listed as DSC-105, meets on two Saturday mornings in September. It does not count toward the certificate. |
| H11 | forklift schedule | Forklift Operator Licence classes meet on Tuesday and Thursday mornings from 8 a.m. to noon. There are no weekend forklift classes. |
| H12 | data eligibility | No prior data experience is required for the Data Support Certificate. Applicants need basic spreadsheet skills. |
| H13 | child care | Free child care is available in Room 104 during evening classes for children aged 3 to 10. |
| H14 | deadline | Applications for both fall programs close on October 15. |
| H15 | laptops | Laptops are provided in class for Data Support Certificate students and may not be taken home. |
Declare the questions and reference answers
The expected action is defined before retrieval and generation. A gold passage is the passage that answers the question or contradicts its false premise. The unanswerable parking question has no gold passage.
reference_table <- questions |>
transmute(
question_id,
question,
expected_action,
gold_passage_id = coalesce(gold_passage_id, "not applicable"),
acceptable_answers = coalesce(acceptable_answers, "not applicable")
)| Question | Question text | Expected action | Gold evidence | Acceptable short answers |
|---|---|---|---|---|
| Q1 | How much is the weekly training stipend? | answer | H08 | $150|$150 per week|$150 a week|150 dollars per week |
| Q2 | When do applications close? | answer | H14 | October 15|Oct. 15|October 15th |
| Q3 | Where can my kid stay while I study at night? | answer | H13 | Room 104|in Room 104|free child care in Room 104 |
| Q4 | Do I need data experience to join the Data Support Certificate? | answer | H12 | No|no prior data experience is required |
| Q5 | How much does parking cost at the centre? | abstain | not applicable | not applicable |
| Q6 | When does the Saturday forklift session start? | flag premise | H11 | not applicable |
Check overlap before retrieval
The retriever below uses simple English content tokens and removes the small stop-word list printed in the code, including at, while, and other function words. This choice matters. If stop words stayed in, Q3 would retrieve unrelated passages because of at; with this rule, Q3 has no content-word match and follows the no lexical match path.
stop_words <- c(
"a", "an", "and", "are", "as", "at", "be", "by", "can", "do", "does",
"for", "from", "how", "i", "in", "is", "it", "my", "of", "on", "or",
"the", "there", "this", "to", "when", "where", "while", "with", "your"
)
tokenize_text <- function(text) {
str_extract_all(
str_to_lower(text, locale = "en"),
"[\\p{L}\\p{N}][\\p{L}\\p{N}-]*"
)[[1]]
}
content_words <- function(text) {
tokenize_text(text) |>
setdiff(stop_words) |>
unique() |>
sort()
}
gold_overlap <- questions |>
left_join(
handbook |>
select(gold_passage_id = passage_id, gold_text = text),
by = "gold_passage_id"
) |>
mutate(
question_words = map(question, content_words),
gold_words = map(gold_text, \(text) {
if (is.na(text)) character() else content_words(text)
}),
shared_words = map2(question_words, gold_words, intersect),
shared_content_words = map_chr(
shared_words,
\(words) if (length(words) == 0L) "none" else paste(words, collapse = ", ")
)
) |>
select(question_id, gold_passage_id, shared_content_words)| Question | Gold evidence | Shared content words |
|---|---|---|
| Q1 | H08 | stipend, training |
| Q2 | H14 | applications, close |
| Q3 | H13 | none |
| Q4 | H12 | certificate, data, experience, need, support |
| Q5 | NA | none |
| Q6 | H11 | forklift |
Retrieve candidate passages
Tf-idf gives more weight to terms that appear in fewer handbook passages. The idf values are fitted once on the handbook and reused for each question. A passage with score zero is not retrieved, and score ties are broken by passage ID. The retrieval score is cosine similarity between the question and passage tf-idf vectors, so it ranges from 0 to 1.
Show the retrieval code
passage_terms <- handbook |>
transmute(
passage_id,
term = map(text, tokenize_text)
) |>
unnest(term) |>
filter(!term %in% stop_words)
document_frequency <- passage_terms |>
distinct(passage_id, term) |>
count(term, name = "document_frequency") |>
mutate(
idf = log(nrow(handbook) / document_frequency)
)
passage_vectors <- passage_terms |>
count(passage_id, term, name = "term_frequency") |>
left_join(document_frequency, by = "term") |>
mutate(weight = term_frequency * idf)
rank_question_passages <- function(question_id, question) {
question_terms <- tibble(term = tokenize_text(question)) |>
filter(!term %in% stop_words) |>
count(term, name = "term_frequency") |>
inner_join(document_frequency, by = "term") |>
mutate(question_weight = term_frequency * idf)
if (nrow(question_terms) == 0L) {
return(handbook |>
transmute(question_id = question_id, passage_id, score = 0))
}
question_norm <- sqrt(sum(question_terms$question_weight^2))
passage_norms <- passage_vectors |>
group_by(passage_id) |>
summarise(passage_norm = sqrt(sum(weight^2)), .groups = "drop")
scored <- passage_vectors |>
inner_join(question_terms |> select(term, question_weight), by = "term") |>
group_by(passage_id) |>
summarise(dot_product = sum(weight * question_weight), .groups = "drop") |>
left_join(passage_norms, by = "passage_id") |>
mutate(score = dot_product / (passage_norm * question_norm)) |>
select(passage_id, score)
handbook |>
select(passage_id) |>
left_join(scored, by = "passage_id") |>
mutate(
score = coalesce(score, 0),
question_id = question_id
) |>
select(question_id, passage_id, score)
}
ranked_passages <- map2_dfr(
questions$question_id,
questions$question,
rank_question_passages
) |>
arrange(question_id, desc(score), passage_id) |>
group_by(question_id) |>
mutate(display_rank = if_else(score > 0, row_number(), NA_integer_)) |>
ungroup()
retrieved <- ranked_passages |>
filter(score > 0, display_rank <= 3L) |>
transmute(question_id, passage_id, rank = display_rank, score)
gold_ranks <- ranked_passages |>
right_join(
questions |> select(question_id, gold_passage_id),
by = c("question_id", "passage_id" = "gold_passage_id")
) |>
transmute(
question_id,
gold_rank = display_rank,
gold_score = score,
gold_retrieval_label = case_when(
is.na(passage_id) ~ "not applicable",
coalesce(gold_score, 0) == 0 ~ "not retrieved (all scores 0)",
!is.na(gold_rank) ~ paste0("rank ", gold_rank),
TRUE ~ "not retrieved"
)
)
retrieval_display <- questions |>
select(question_id, question, expected_action, gold_passage_id) |>
left_join(
retrieved |>
group_by(question_id) |>
summarise(
retrieved_ids = paste(passage_id, collapse = ", "),
retrieved_ranks = paste(
paste0(passage_id, " (#", rank, ", ", sprintf("%.3f", score), ")"),
collapse = "; "
),
.groups = "drop"
),
by = "question_id"
) |>
left_join(gold_ranks, by = "question_id") |>
mutate(
retrieved_ids = if_else(is.na(retrieved_ids), "no lexical match", retrieved_ids),
retrieved_ranks = if_else(is.na(retrieved_ranks), "no lexical match", retrieved_ranks),
gold_passage_id = coalesce(gold_passage_id, "not applicable")
)| Question | Question text | Retrieved candidates | Gold evidence | Gold evidence retrieval |
|---|---|---|---|---|
| Q1 | How much is the weekly training stipend? | H08 (#1, 0.356) | H08 | rank 1 |
| Q2 | When do applications close? | H14 (#1, 0.572) | H14 | rank 1 |
| Q3 | Where can my kid stay while I study at night? | no lexical match | H13 | not retrieved (all scores 0) |
| Q4 | Do I need data experience to join the Data Support Certificate? | H12 (#1, 0.588); H03 (#2, 0.108); H15 (#3, 0.098) | H12 | rank 1 |
| Q5 | How much does parking cost at the centre? | H03 (#1, 0.311); H01 (#2, 0.297) | not applicable | not applicable |
| Q6 | When does the Saturday forklift session start? | H10 (#1, 0.261); H11 (#2, 0.140); H03 (#3, 0.089) | H11 | rank 2 |
Q3 shows the retrieval problem. The correct evidence is H13, but a lexical retriever that shares no content word with the question gives the reader no passage to read.
Add a sentence baseline
An extractive baseline returns one sentence from the highest-ranked passage. It is scored by a different unit from the generated answer: whether that sentence contains one acceptable answer variant.
normalize_answer <- function(text) {
text |>
str_to_lower(locale = "en") |>
str_replace_all("[\\p{P}\\p{S}]", "") |>
str_replace_all("\\b(a|an|the)\\b", " ") |>
str_squish()
}
contains_variant <- function(text, variants) {
variants <- variants[nzchar(variants)]
if (length(variants) == 0L || is.na(text)) {
return(NA)
}
normalized_text <- normalize_answer(text)
any(map_lgl(
variants,
\(variant) str_detect(
normalized_text,
fixed(normalize_answer(variant))
)
))
}
top_passage <- retrieved |>
filter(rank == 1L) |>
left_join(handbook |> select(passage_id, text), by = "passage_id") |>
mutate(
baseline_sentence = map_chr(
str_split(text, "(?<=[.!?])\\s+"),
\(sentences) sentences[[1]]
)
) |>
select(question_id, baseline_sentence)
extractive_baseline <- questions |>
select(question_id, expected_action, acceptable_list) |>
left_join(top_passage, by = "question_id") |>
mutate(
contains_acceptable_answer = map2_lgl(
baseline_sentence,
acceptable_list,
contains_variant
),
contains_acceptable_answer = if_else(
expected_action == "answer",
coalesce(contains_acceptable_answer, FALSE),
NA
),
baseline_sentence = if_else(
expected_action == "answer" & is.na(baseline_sentence),
"no sentence (no lexical match)",
baseline_sentence
)
) |>
select(question_id, baseline_sentence, contains_acceptable_answer)| Question | Sentence returned by the baseline | Contains an acceptable short answer |
|---|---|---|
| Q1 | Data Support Certificate students receive a training stipend of $150 per week. | TRUE |
| Q2 | Applications for both fall programs close on October 15. | TRUE |
| Q3 | no sentence (no lexical match) | FALSE |
| Q4 | No prior data experience is required for the Data Support Certificate. | TRUE |
| Q5 | The Riverton Skills Centre runs two programs this fall: the Data Support Certificate and the Forklift Operator Licence course. | NA |
| Q6 | An optional spreadsheet refresher workshop, listed as DSC-105, meets on two Saturday mornings in September. | NA |
The baseline is supported by construction because it copies a sentence. It can still fail to answer the question, and it has no way to explain a false premise.
Ask the reader to produce two lines
The generated reader sees the question and the retrieved passages only. If no passage is retrieved, that fact is placed in the prompt. The required output has exactly two lines: Answer: and Sources:.
reader_system <- paste(
"You are a strict formatter for handbook question answering.",
"Your reply must begin with Answer: on the first line.",
"The second and final line must begin with Sources:.",
"Use only IDs that appear in PASSAGES.",
"If no listed passage answers the question, write Answer: NOT IN HANDBOOK",
"and Sources: none.",
"If the question assumes a fact contradicted by a listed passage, write",
"Answer: PREMISE NOT SUPPORTED: plus a short correction.",
"Do not write a blank line, bullet, explanation, or extra source."
)
format_passages <- function(question_id) {
rows <- retrieved |>
filter(.data$question_id == .env$question_id) |>
arrange(rank) |>
left_join(handbook |> select(passage_id, text), by = "passage_id")
if (nrow(rows) == 0L) {
return("No passages were retrieved.")
}
rows |>
transmute(line = paste0(passage_id, ": ", text)) |>
pull(line) |>
paste(collapse = "\n")
}
reader_inputs <- questions |>
mutate(
passage_block = map_chr(question_id, format_passages),
user_prompt = paste0(
"QUESTION ID: ", question_id,
"\nQUESTION: ", question,
"\nPASSAGES:\n", passage_block,
"\n\nOUTPUT FORMAT:\nAnswer: <short answer, NOT IN HANDBOOK, or PREMISE NOT SUPPORTED: correction>",
"\nSources: <listed passage IDs, or none>"
),
model_prompt = map_chr(
user_prompt,
\(user) nlg_chat_prompt(qa_model$tokenizer, reader_system, user)
),
input_tokens = map_int(
model_prompt,
\(prompt) nlg_token_count(qa_model$tokenizer, prompt)
),
max_new_tokens = 48L
)
nlg_assert_input_budget(
reader_inputs$input_tokens,
max_input_tokens = 768L,
item_ids = reader_inputs$question_id
)| Question | Prompt tokens | Maximum new tokens |
|---|---|---|
| Q1 | 211 | 48 |
| Q2 | 187 | 48 |
| Q3 | 182 | 48 |
| Q4 | 249 | 48 |
| Q5 | 222 | 48 |
| Q6 | 272 | 48 |
Greedy decoding chooses the highest-scoring next token at each step. The helper sets do_sample = FALSE. This lesson passes a repetition penalty of 1.05, which overrides the checkpoint’s generation-config value of 1.1. Exact generated text can differ across machines, so every sentence that reports a model result is computed from this render.
reader_results <- reader_inputs |>
mutate(
generation = map2(
model_prompt,
max_new_tokens,
\(prompt, budget) {
nlg_generate(
qa_model,
prompt,
max_new_tokens = budget,
repetition_penalty = 1.05
)
}
),
raw_output = map_chr(generation, "text"),
output_tokens = map_int(generation, "output_tokens"),
ended_by_eos = map_lgl(generation, "ended_by_eos"),
hit_token_cap = map_lgl(generation, "hit_token_cap")
)| Question | Raw reader output (`⏎` marks a line break) | Output tokens | EOS emitted | Hit token cap |
|---|---|---|---|---|
| Q1 | Answer: $150 per week ⏎ Sources: H08 | 15 | TRUE | FALSE |
| Q2 | Answer: Applications close on October 15. ⏎ Sources: H14 | 16 | TRUE | FALSE |
| Q3 | Answer: NOT IN HANDBOOK ⏎ Sources: none | 13 | TRUE | FALSE |
| Q4 | Answer: NO PRIOR DATA EXPERIENCE IS REQUIRED ⏎ Sources: H12 | 17 | TRUE | FALSE |
| Q5 | Answer: NOT IN HANDBOOK ⏎ Sources: H01 | 15 | TRUE | FALSE |
| Q6 | Answer: NOT IN HANDBOOK ⏎ Sources: H11 | 15 | TRUE | FALSE |
Parse without rewriting
A strict parser accepts only the two requested lines. In this render every output parsed; if a later output adds a third line or omits Sources:, the lesson stops before publishing a malformed row.
parse_reader_output <- function(text) {
parsed <- str_match(
str_trim(text),
"^Answer: ([^\\r\\n]+)\\r?\\nSources: ([^\\r\\n]+)$"
)
if (is.na(parsed[1, 1])) {
return(tibble(
parse_ok = FALSE,
parsed_answer = NA_character_,
parsed_sources = list(character()),
observed_action = "parse failure"
))
}
answer <- str_squish(parsed[1, 2])
source_text <- str_squish(parsed[1, 3])
sources <- if (str_to_lower(source_text) == "none") {
character()
} else {
str_split(source_text, "\\s*,\\s*")[[1]]
}
action <- case_when(
str_starts(answer, "NOT IN HANDBOOK") ~ "abstain",
str_starts(answer, "PREMISE NOT SUPPORTED") ~ "flag premise",
TRUE ~ "answer"
)
tibble(
parse_ok = TRUE,
parsed_answer = answer,
parsed_sources = list(sources),
observed_action = action
)
}
parsed_results <- reader_results |>
select(question_id, raw_output, output_tokens, ended_by_eos, hit_token_cap) |>
mutate(parsed = map(raw_output, parse_reader_output)) |>
unnest(parsed) |>
left_join(questions, by = "question_id")
parsed_display <- parsed_results |>
transmute(
question_id,
parsed_answer = coalesce(parsed_answer, "parse failure"),
parsed_sources = map_chr(
parsed_sources,
\(sources) if (length(sources) == 0L) "none" else paste(sources, collapse = ", ")
),
observed_action,
expected_action
)| Question | Parsed answer | Parsed sources | Observed action | Expected action |
|---|---|---|---|---|
| Q1 | $150 per week | H08 | answer | answer |
| Q2 | Applications close on October 15. | H14 | answer | answer |
| Q3 | NOT IN HANDBOOK | none | abstain | answer |
| Q4 | NO PRIOR DATA EXPERIENCE IS REQUIRED | H12 | answer | answer |
| Q5 | NOT IN HANDBOOK | H01 | abstain | abstain |
| Q6 | NOT IN HANDBOOK | H11 | abstain | flag premise |
Score answers, actions, and retrieval
Exact match (EM) is 1 only when the normalized prediction exactly equals one acceptable answer. Token F1 balances shared-token precision and recall after normalization. SQuAD is a widely used question-answering benchmark; this lesson copies its scoring steps: lowercase, delete punctuation and symbols, remove English articles, and squeeze spaces. The only difference is that stringr’s ICU class removes Unicode punctuation and symbols, not only ASCII punctuation.
Show the scoring code
answer_f1 <- function(prediction, reference) {
prediction_tokens <- str_split(normalize_answer(prediction), "\\s+")[[1]]
reference_tokens <- str_split(normalize_answer(reference), "\\s+")[[1]]
prediction_tokens <- prediction_tokens[nzchar(prediction_tokens)]
reference_tokens <- reference_tokens[nzchar(reference_tokens)]
if (length(prediction_tokens) == 0L || length(reference_tokens) == 0L) {
return(0)
}
common <- intersect(unique(prediction_tokens), unique(reference_tokens))
overlap <- sum(pmin(
tabulate(match(prediction_tokens, common), nbins = length(common)),
tabulate(match(reference_tokens, common), nbins = length(common))
))
if (overlap == 0L) {
return(0)
}
precision <- overlap / length(prediction_tokens)
recall <- overlap / length(reference_tokens)
2 * precision * recall / (precision + recall)
}
best_reference_scores <- function(answer, variants) {
variants <- variants[nzchar(variants)]
if (length(variants) == 0L || is.na(answer)) {
return(tibble(exact_match = NA_real_, f1 = NA_real_))
}
tibble(
exact_match = as.numeric(map_lgl(
variants,
\(variant) identical(normalize_answer(answer), normalize_answer(variant))
)),
f1 = map_dbl(variants, \(variant) answer_f1(answer, variant))
) |>
summarise(
exact_match = max(exact_match),
f1 = max(f1),
.groups = "drop"
)
}
retrieval_success <- questions |>
select(question_id, expected_action, gold_passage_id) |>
left_join(gold_ranks, by = "question_id") |>
mutate(
recall_at_3 = case_when(
is.na(gold_passage_id) ~ NA,
gold_rank <= 3L ~ TRUE,
TRUE ~ FALSE
)
)
score_table <- parsed_results |>
mutate(
answer_for_reference_score = if_else(
observed_action == "answer" & parse_ok,
parsed_answer,
""
),
reference_scores = map2(
answer_for_reference_score,
acceptable_list,
best_reference_scores
)
) |>
unnest(reference_scores) |>
left_join(retrieval_success, by = c("question_id", "expected_action", "gold_passage_id")) |>
mutate(
action_correct = observed_action == expected_action,
reader_action = observed_action,
reader_given_passages = case_when(
expected_action == "answer" & recall_at_3 %in% FALSE & observed_action == "abstain" ~
"reasonable abstention from retrieved passages",
action_correct ~ "expected action",
TRUE ~ "unexpected action"
),
end_to_end_outcome = case_when(
expected_action == "answer" & recall_at_3 %in% FALSE ~ "failed before reading",
action_correct ~ "expected action",
TRUE ~ "unexpected action"
),
reference_agreement = case_when(
expected_action != "answer" ~ "not applicable",
is.na(exact_match) ~ "not applicable",
TRUE ~ sprintf("EM %.0f; F1 %.2f", exact_match, f1)
),
recall_at_3_label = case_when(
is.na(recall_at_3) ~ "not applicable",
recall_at_3 ~ "gold in top 3",
TRUE ~ "gold not in top 3"
)
)| Question | Reader action | Expected action | Action correct | Reader given retrieved passages | Reference agreement | Retrieval recall at 3 | End-to-end outcome |
|---|---|---|---|---|---|---|---|
| Q1 | answer | answer | TRUE | expected action | EM 1; F1 1.00 | gold in top 3 | expected action |
| Q2 | answer | answer | TRUE | expected action | EM 0; F1 0.57 | gold in top 3 | expected action |
| Q3 | abstain | answer | FALSE | reasonable abstention from retrieved passages | EM 0; F1 0.00 | gold not in top 3 | failed before reading |
| Q4 | answer | answer | TRUE | expected action | EM 1; F1 1.00 | gold in top 3 | expected action |
| Q5 | abstain | abstain | TRUE | expected action | not applicable | not applicable | expected action |
| Q6 | abstain | flag premise | FALSE | unexpected action | not applicable | gold in top 3 | unexpected action |
In this render, the parsed reader actions include 3 answer actions, 3 abstentions, and 0 premise flags. Exact action matched the predeclared reference on 4 of 6 rows, and 1 row failed before reading because the gold passage was not retrieved. The generated short answer receives EM and F1 only when the expected action is answer; parsed abstentions and parse failures count as empty predictions, so they receive EM 0 and F1 0 on answerable questions. The sentence baseline used a different unit, whether the copied sentence contained an acceptable answer. These numbers should not be read as a model comparison. In this render, Q2 has exact match 0 because the answer contains an acceptable variant but includes extra words.
Screen citations and surface support
The support screen checks six mechanical facts: the row parsed, cited IDs exist, cited IDs were retrieved, an answered row has a citation, an abstention cites no passages, and answer numerals appear in cited passages after citation tokens are removed. False-premise handling is scored in the action table using the author’s reference; no screen on this page detects a false premise from text alone. A screen can miss number words and wrong attachments, such as using the right number for the wrong item.
Show the citation and support screens
strip_citation_tokens <- function(text) {
str_remove_all(text, "\\bH\\d{2}\\b")
}
numbers_in <- function(text) {
str_extract_all(
strip_citation_tokens(coalesce(text, "")),
"(?<![\\p{L}\\p{N}])\\d+"
)[[1]]
}
screen_one <- function(answer, sources, parse_ok, observed_action, retrieved_ids) {
cited_text <- handbook |>
filter(passage_id %in% sources) |>
pull(text) |>
paste(collapse = " ")
answer_numbers <- numbers_in(answer)
cited_numbers <- numbers_in(cited_text)
parsed <- isTRUE(parse_ok)
cited_exist <- all(sources %in% handbook$passage_id)
cited_retrieved <- all(sources %in% retrieved_ids)
answer_has_citation <- if (observed_action == "answer") {
length(sources) > 0L
} else {
TRUE
}
abstain_sources_ok <- if (observed_action == "abstain") {
length(sources) == 0L
} else {
TRUE
}
numbers_supported <- if (length(answer_numbers) == 0L) {
TRUE
} else {
all(answer_numbers %in% cited_numbers)
}
c(
parsed = parsed,
cited_exist = cited_exist,
cited_retrieved = cited_retrieved,
answer_has_citation = answer_has_citation,
abstain_sources_ok = abstain_sources_ok,
numbers_supported = numbers_supported
)
}
screen_results <- parsed_results |>
left_join(
retrieved |>
group_by(question_id) |>
summarise(retrieved_ids = list(passage_id), .groups = "drop"),
by = "question_id"
) |>
mutate(
retrieved_ids = map(retrieved_ids, \(ids) if (is.null(ids)) character() else ids),
screen_values = pmap(
list(parsed_answer, parsed_sources, parse_ok, observed_action, retrieved_ids),
screen_one
),
surface_support_screen = map_lgl(screen_values, all),
failed_checks = map_chr(
screen_values,
\(values) {
failed <- names(values)[!values]
if (length(failed) == 0L) "none" else paste(failed, collapse = ", ")
}
),
screen_label = nlg_screen_label(surface_support_screen),
human_support_review = "pending"
)
screen_display <- screen_results |>
transmute(
question_id,
parsed_answer,
cited_passages = map_chr(
parsed_sources,
\(sources) if (length(sources) == 0L) "none" else paste(sources, collapse = ", ")
),
cited_text = map_chr(
parsed_sources,
\(sources) {
text <- handbook |>
filter(passage_id %in% sources) |>
transmute(line = paste0(passage_id, ": ", text)) |>
pull(line)
if (length(text) == 0L) "none" else paste(text, collapse = " ")
}
),
failed_checks,
screen_label,
human_support_review
)| Question | Parsed answer | Cited IDs | Cited passage text | Failed screen checks | Surface support screen | Human support review |
|---|---|---|---|---|---|---|
| Q1 | $150 per week | H08 | H08: Data Support Certificate students receive a training stipend of $150 per week. Students must attend at least 90 percent of classes to receive it. | none | not flagged by screen | pending |
| Q2 | Applications close on October 15. | H14 | H14: Applications for both fall programs close on October 15. | none | not flagged by screen | pending |
| Q3 | NOT IN HANDBOOK | none | none | none | not flagged by screen | pending |
| Q4 | NO PRIOR DATA EXPERIENCE IS REQUIRED | H12 | H12: No prior data experience is required for the Data Support Certificate. Applicants need basic spreadsheet skills. | none | not flagged by screen | pending |
| Q5 | NOT IN HANDBOOK | H01 | H01: Classes are held at the Riverton Skills Centre on Mill Street in Riverton. | abstain_sources_ok | held for human review | pending |
| Q6 | NOT IN HANDBOOK | H11 | H11: Forklift Operator Licence classes meet on Tuesday and Thursday mornings from 8 a.m. to noon. There are no weekend forklift classes. | abstain_sources_ok | held for human review | pending |
The plain-language human support test is: would someone who read only the cited passage agree, “according to this passage, this answer is supported”? This page does not make that human judgment. In this render, the surface screen labels 2 reader rows as held for review and 4 as not flagged by the screen.
Show screen controls
If every generated answer looks clean in one render, a reader still needs to see the screen catch something. The next two rows are author-written control strings, not model outputs.
control_outputs <- tibble(
control_id = c("control-unsupported-number", "control-unretrieved-citation"),
question_id = c("Q1", "Q1"),
parsed_answer = c(
"The weekly training stipend is $200.",
"The stipend is paid weekly."
),
parsed_sources = list(c("H08"), c("H14")),
parse_ok = TRUE,
observed_action = "answer"
) |>
left_join(
retrieved |>
group_by(question_id) |>
summarise(retrieved_ids = list(passage_id), .groups = "drop"),
by = "question_id"
) |>
mutate(
screen_values = pmap(
list(parsed_answer, parsed_sources, parse_ok, observed_action, retrieved_ids),
screen_one
),
surface_support_screen = map_lgl(screen_values, all),
failed_checks = map_chr(
screen_values,
\(values) {
failed <- names(values)[!values]
if (length(failed) == 0L) "none" else paste(failed, collapse = ", ")
}
),
screen_label = nlg_screen_label(surface_support_screen)
)| Control | Control answer | Cited IDs | Failed screen checks | Screen label |
|---|---|---|---|---|
| control-unsupported-number | The weekly training stipend is $200. | H08 | numbers_supported | held for human review |
| control-unretrieved-citation | The stipend is paid weekly. | H14 | cited_retrieved | held for human review |
These controls do not prove that the screen is complete. They show only that two known failure shapes are caught.
Count action choices
The fixture has three expected actions, so the table keeps all three: answer, abstain, and flag premise. The simple-policy comparison uses the same exact-action basis. A policy that always answers matches the four answer rows; a policy that always abstains matches only Q5, because the false-premise row is a separate expected action.
action_table <- score_table |>
count(expected_action, reader_action, name = "questions") |>
complete(
expected_action = c("answer", "abstain", "flag premise"),
reader_action = c("answer", "abstain", "flag premise"),
fill = list(questions = 0L)
)
always_answer_exact <- sum(questions$expected_action == "answer")
always_abstain_exact <- sum(questions$expected_action == "abstain")
observed_reader_exact <- sum(score_table$action_correct)
policy_misses <- bind_rows(
score_table |>
filter(!action_correct) |>
summarise(policy = "observed reader", misses = paste(question_id, collapse = ", ")),
questions |>
filter(expected_action != "answer") |>
summarise(policy = "always answer", misses = paste(question_id, collapse = ", ")),
questions |>
filter(expected_action != "abstain") |>
summarise(policy = "always abstain", misses = paste(question_id, collapse = ", "))
)| Expected action | Observed action | Questions |
|---|---|---|
| abstain | abstain | 1 |
| abstain | answer | 0 |
| abstain | flag premise | 0 |
| answer | abstain | 1 |
| answer | answer | 3 |
| answer | flag premise | 0 |
| flag premise | abstain | 1 |
| flag premise | answer | 0 |
| flag premise | flag premise | 0 |
| Policy | Exact action matches | Questions | Rows missed |
|---|---|---|---|
| observed reader | 4 | 6 | Q3, Q6 |
| always answer | 4 | 6 | Q5, Q6 |
| always abstain | 1 | 6 | Q1, Q2, Q3, Q4, Q6 |
The abstention row matters because an unanswerable question alone can flatter a system that refuses everything. The premise row matters too: a false assumption needs a correction, not just a generic refusal. The observed reader and the always-answer policy both match 4 of 6 actions, but they miss different rows: the reader misses Q3, Q6, while always-answer misses Q5, Q6.
How to use this pattern
This is a retrieve-then-read demonstration over a small English (en) handbook. The term retrieval-augmented generation, or RAG, usually refers to a broader family of systems that combine a generator with an external memory; the original RAG paper used a dense Wikipedia index and trained components together. This lesson does neither.
Questions about money, eligibility, or deadlines need a person to check the source before anyone acts. Typed questions are user text; this page stores none after the render. Retrieved passages are evidence, not instructions. The next lesson shows why dialogue systems should keep safety and routing rules in code rather than trusting retrieved or typed text.
A common shortcut is to ask a second language model whether each answer is supported by its cited passages. Recent benchmark work finds such judges close to chance on hard unsupported answers, so their scores are a screening signal at best. Keep mechanical screens like the ones above, and have a person read a random sample of answers against their sources before reporting a support rate.
What to remember
- Question answering is retrieval plus reading, not retrieval alone.
- A lexical retriever can miss an answerable question before the reader starts.
- EM and F1 score short answer strings; they do not measure support.
- A citation is a clue to inspect, not proof that the answer follows.
- Screens can hold obvious failures, but human support review stays pending.
- Abstention must be checked on answerable and unanswerable questions.
Sources
- Rajpurkar, Jia, and Liang on unanswerable questions for SQuAD 2.0
- Rajpurkar et al. on SQuAD exact match and F1
- Chen et al. on retrieval plus reading in DrQA
- SQuAD explorer and evaluation script
- Qwen2.5-1.5B-Instruct model card
- Liu, Zhang, and Liang on verifiability in generative search
- Kim et al. on question answering with questionable assumptions
- Kamalloo et al. on open-domain QA evaluation with lexical metrics
- Rashkin et al. on attribution to identified sources
- Lewis et al. on retrieval-augmented generation
- Tamber et al. (2025), Benchmarking LLM faithfulness in RAG with evolving leaderboards