Beyond CLIP: Calibrated (Few-Shot) Defect Detection With Structured Decision Models
Replication document: data, methods, results, tables and figures
Fadel M. Megahed 
Ying-Ju (Tessa) Chen
This document reproduces every table and figure of the paper from the saved results in results/fair/. It renders offline, at no cost, in a few minutes. It needs the images in imgs/ (see the README). The switches in Section 1.1 re-run the steps that call a paid API or need a GPU, and Section 12 lists all steps.
The study asks if structured decision models (JEV and Clef-Flash) can detect manufacturing defects as well as few-shot CLIP (Megahed et al., 2026; Radford et al., 2021), with fewer images in the prompt, and give calibrated probabilities. A structured decision model returns a probability for each allowed answer to a question about an image. In this design, every method gets the same labeled images, every method is calibrated on the same calibration images, and every comparison is paired on the same test images. Section 10 tells what changed from the first version, v0.0.1.
This document holds the results of all runs: the eight description loops, and the calibration and test runs of every configuration. A section shows a note only when a re-run lacks one of its results. With use_rerun, the numbers in the tables, figures and text come from the re-run, but the words describe the saved results.
1 Setup
1.1 Switches
Code
# Re-run switches. FALSE reads the saved results. Each switch runs one step
# of the section "Re-run steps"; a score switch also runs the evaluation.
run_evaluate <- FALSE # metrics, paired tests and k-curve of the re-run (no cost)
run_clip <- FALSE # CLIP variants on a local GPU (set RETICULATE_PYTHON first)
run_clef <- FALSE # Clef-Flash calibration and test runs (local SGLang server)
run_jev <- FALSE # JEV calibration and test runs (paid TypeSafe API; needs
# FAIR_RECORD_ROOT and a "Re-run" budget row)
# TRUE builds every table and figure from the re-run (render again after
# the render that ran the switches).
use_rerun <- FALSE
# Folders. The sets, the loop logs and the frozen descriptions always come
# from saved_root. The re-run writes to rerun_root only; with use_rerun, the
# scores, summaries, figures and tables all come from rerun_root.
saved_root <- "results/fair"
rerun_root <- "results/rerun/fair"
results_root <- if (use_rerun) rerun_root else saved_root
figs_dir <- if (use_rerun) file.path(rerun_root, "figs") else "figs"
tables_dir <- if (use_rerun) file.path(rerun_root, "tables") else "tables"1.2 Packages
Code
# Install the packages that are missing; all calls below use pkg::fun().
packages <- c(
"dplyr", "tidyr", "purrr", "readr", "stringr", "tibble", "rlang", "withr",
"ggplot2", "ggtext", "patchwork", "knitr", "kableExtra",
"DT", "magick", "showtext", "sysfonts", "systemfonts", "ragg", "scales",
"yardstick"
)
missing <- purrr::discard(packages, \(p) requireNamespace(p, quietly = TRUE))
if (length(missing) > 0) {
install.packages(missing, repos = "https://cloud.r-project.org")
}
knitr::opts_chunk$set(dev = "ragg_png", dpi = 150)1.3 Figure and table style
Figures use theme_bw() with no grid lines, bold axis titles and tick labels, Outfit for titles and Cabin for all other text (both under the SIL Open Font License, in fonts/). Five colors mark the models, the calibration and the defective class: teal for JEV, gold for Clef-Flash, blue for CLIP, plum for Platt scaling and the Accent Red of Miami University for defective images. Each color has a contrast of 4.5:1 or more on white (WCAG 2.2 AA for text), and each pair of colors stays apart in normal vision and in simulated protan, deutan and tritan vision (Machado et al., 2009). scripts/palette_check.R compares them with published palettes. Colored words in the subtitle replace the legend. Subtitles are bold and centered over the panels, in lines of about the same length; the subtitle of F1 fills each line over the image columns, and its caption fills each line of the figure. Panel titles are bold and near-black. No figure has a title: the caption takes its place, and the subtitle reads on its own. Small labels give the values on a fixed side of each mark: in F3 to F5 and F8, the difference over each point and the 2.5% and 97.5% bounds over the ends of its interval, above JEV and below Clef-Flash; in F2, F6 and F7, the value of each point. A label that would overlap a mark or another label is left out. Each figure is saved as PNG (600 dpi), PDF and SVG, in a one-column size (3.4 in wide) and a two-column size (7 in wide) for a two-column letter page. For the paper, each figure is also saved as a PDF at the column width (3.56 in) and the text width (7.5 in) of the ASME class asmeconf, in figs/paper/. The paper reports fewer metrics than this document: accuracy where this document gives balanced accuracy (the two are equal on the balanced test sets), and no MCC. PDF and SVG files hold the text as outlines, so they look the same on every computer. Each table is saved as CSV and LaTeX and shown here as an interactive table.
Code
# Fonts: register the files in fonts/ for ragg (PNG) and showtext (PDF, SVG).
title_font <- "Outfit"
body_font <- "Cabin"
fonts <- list(
Outfit = c(plain = "fonts/Outfit-SemiBold.ttf", bold = "fonts/Outfit-Bold.ttf",
italic = "fonts/Outfit-SemiBold.ttf"),
Cabin = c(plain = "fonts/Cabin-Regular.ttf", bold = "fonts/Cabin-Bold.ttf",
italic = "fonts/Cabin-Italic.ttf")
)
known <- c(systemfonts::system_fonts()$family,
systemfonts::registry_fonts()$family)
purrr::iwalk(fonts, \(f, family) {
if (!family %in% known) {
systemfonts::register_font(family, plain = f[["plain"]], bold = f[["bold"]],
italic = f[["italic"]], bolditalic = f[["bold"]])
}
sysfonts::font_add(family, regular = f[["plain"]], bold = f[["bold"]],
italic = f[["italic"]], bolditalic = f[["bold"]])
})
# Colors: one per model, class and calibration method. Each reaches 4.5:1
# on white, and each pair stays apart in normal and simulated protan, deutan
# and tritan vision (scripts/palette_check.R). The red is the Accent Red of
# Miami University.
figure_colors <- c(teal = "#00829B", gold = "#917300", blue = "#0A4BC3",
plum = "#872D91", red = "#AD102A")
model_colors <- c("JEV" = figure_colors[["teal"]],
"Clef-Flash" = figure_colors[["gold"]],
"CLIP" = figure_colors[["blue"]])
class_colors <- c(nominal = "grey30", defective = figure_colors[["red"]])
calibration_colors <- c(raw = "grey45", Platt = figure_colors[["plum"]])
# Text in tables: 25% darker model colors. Teal and gold are below the WCAG
# AA contrast of 4.5:1 for text on the grey rows (4.1:1); the darker ones
# reach 6.4:1 or more on both table backgrounds.
model_text_colors <- purrr::map_chr(model_colors, \(color) {
grDevices::rgb(t(grDevices::col2rgb(color) * 0.75), maxColorValue = 255)
})
# Background of every second dataset in the tables.
group_color <- "#F4F4F4"
# Markdown for a bold word in a color (ggtext), and the same in HTML (tables).
paint <- function(text, color) {
as.character(stringr::str_glue("<span style='color:{color}'>**{text}**</span>"))
}
paint_html <- function(text, color) {
as.character(stringr::str_glue("<span style='color:{color}'><b>{text}</b></span>"))
}
# Round half up, as in the paper. Floating point stores 0.725 as
# 0.72499..., so round() and sprintf() give 0.72.
round_half_up <- function(x, digits = 2) {
sign(x) * floor(abs(x) * 10^digits + 0.5 + 1e-9) / 10^digits
}
# Fixed decimals and a comma every three digits (1,212); "+ 0" turns a
# rounded -0 into 0, so no "-0.00".
fmt <- function(x, digits = 2) {
formatC(round_half_up(x, digits) + 0, format = "f", digits = digits, big.mark = ",")
}
# A sign before each difference that is not 0 after rounding.
signed <- function(x, digits = 2) {
shown <- round_half_up(x, digits) + 0
sign_text <- dplyr::case_when(shown < 0 ~ "-", shown > 0 ~ "+", .default = "")
stringr::str_c(sign_text, fmt(abs(shown), digits))
}
capitalize <- function(s) {
stringr::str_c(stringr::str_to_upper(stringr::str_sub(s, 1, 1)),
stringr::str_sub(s, 2))
}Code
# Figure sizes for a two-column letter page.
layouts <- list(
"one-column" = list(width = 3.4, base_size = 8),
"two-column" = list(width = 7.0, base_size = 9)
)
# No figure has a title: the caption takes its place, in this document and
# in the paper. The subtitle reads on its own.
# Subtitles are wrapped here, not by ggtext: its text boxes sometimes
# reserve one line less than they draw, and the subtitle then overlaps the
# panels. Each word is measured in its font (systemfonts), bold or not. The
# text takes the fewest lines that fit the figure, and then the narrowest
# width that keeps that number of lines, so the lines are about the same
# length. A colored span or "k = 2" never breaks across lines (its spaces
# become no-break spaces first). `bold`: the text outside the bold spans is
# bold; `size`: the text size relative to the base size; `width`: the width
# of the figure in inches; `balance = FALSE` fills each line to that width.
subline <- function(layout, ..., bold = TRUE, size = 1,
width = layouts[[layout]]$width, balance = TRUE) {
nbsp <- " "
text <- stringr::str_c(...) |>
stringr::str_replace_all("<span[^>]*>.*?</span>|k = \\d",
\(s) stringr::str_replace_all(s, " ", nbsp))
words <- stringr::str_split_1(text, " ")
measure <- \(s, weight) systemfonts::string_width(
s, family = body_font, weight = weight,
size = layouts[[layout]]$base_size * size, res = 7200
) / 100 # points
widths <- purrr::map2_dbl(
stringr::str_replace_all(stringr::str_remove_all(words, "<[^>]+>|\\*\\*"), nbsp, " "),
dplyr::if_else(bold | stringr::str_detect(words, "\\*\\*"), "bold", "normal"),
measure
)
space <- measure(" ", if (bold) "bold" else "normal")
# The line of each word when no line is wider than `limit` points.
wrap <- function(limit) {
line <- integer(length(widths))
n <- 1
used <- -space
for (i in seq_along(widths)) {
if (used > 0 && used + space + widths[i] > limit) {
n <- n + 1
used <- -space
}
used <- used + space + widths[i]
line[i] <- n
}
line
}
# The figure less its margins (5.5 pt each side), and 3% to spare.
limit <- (width * 72 - 11) * 0.97
lines <- max(wrap(limit))
while (balance && limit > max(widths) && max(wrap(limit - 1)) == lines) limit <- limit - 1
split(words, wrap(limit)) |>
purrr::map_chr(\(w) stringr::str_c(w, collapse = " ")) |>
stringr::str_c(collapse = "<br>") |>
stringr::str_replace_all(nbsp, " ")
}
# The theme of all figures: no grid lines; bold axis titles, tick labels
# and ticks; bold subtitles, each line centered (center_subtitle() below
# centers them over the panels); bold panel titles in near-black, 90% of
# the base size.
theme_paper <- function(layout) {
ggplot2::theme_bw(base_size = layouts[[layout]]$base_size,
base_family = body_font) +
ggplot2::theme(
legend.position = "none",
plot.title.position = "plot",
plot.subtitle = ggtext::element_markdown(
face = "bold", colour = "grey10", lineheight = 1.15,
hjust = 0.5, halign = 0.5, margin = ggplot2::margin(0, 0, 6, 0)
),
plot.caption.position = "plot",
plot.caption = ggtext::element_markdown(
colour = "grey35", size = ggplot2::rel(0.8), hjust = 0,
lineheight = 1.1, margin = ggplot2::margin(6, 0, 0, 0)
),
panel.grid = ggplot2::element_blank(),
strip.background = ggplot2::element_rect(fill = "grey95",
colour = "grey70"),
strip.text = ggplot2::element_text(face = "bold", colour = "grey10",
size = ggplot2::rel(0.9)),
axis.title = ggplot2::element_text(face = "bold", colour = "grey15"),
axis.text = ggplot2::element_text(face = "bold", colour = "grey15"),
axis.ticks = ggplot2::element_line(colour = "grey15", linewidth = ggplot2::rel(1.6)),
axis.ticks.length = ggplot2::unit(3, "pt")
)
}
# Paper versions: the column and text widths of the ASME class asmeconf.
paper_widths <- c("one-column" = 3.56, "two-column" = 7.5)
# Value labels of points and intervals (R/figure_labels.R): each label takes
# the first of its candidate places that overlaps no mark, no other label
# and no panel edge, or is left out. The places depend on the size of the
# figure, so each figure function gets the size it is drawn at.
source("R/figure_labels.R")
# Small labels, so that they do not draw the eye from the data.
label_size <- c("one-column" = 5.5, "two-column" = 6)
add_labels <- function(plot, spec, layout, width, height) {
plot <- center_subtitle(plot, layout, width, height)
annotate_plot(plot, spec, width, height, size_pt = label_size[[layout]], family = body_font)
}
# Center the subtitle over the panels: wrap it again to the width of the
# panel area (the figure less the axes and margins left and right of the
# panels) and place it there. The axes do not depend on the subtitle, and
# the labels above are placed after this step, at the final panel height.
center_subtitle <- function(plot, layout, width, height) {
file <- tempfile(fileext = ".png")
ragg::agg_png(file, width = width, height = height, units = "in", res = 72)
on.exit({
grDevices::dev.off()
unlink(file)
}, add = TRUE)
gtable <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(plot))
panels <- gtable$layout[grepl("^panel", gtable$layout$name), ]
outside <- setdiff(seq_along(gtable$widths), min(panels$l):max(panels$r))
span <- width - sum(grid::convertWidth(gtable$widths[outside], "in", valueOnly = TRUE))
# subline() takes the figure width and keeps 11 pt for the plot margins.
text <- stringr::str_replace_all(plot$labels$subtitle, "<br>", " ")
plot +
ggplot2::labs(subtitle = subline(layout, text, width = span + 11 / 72)) +
ggplot2::theme(plot.title.position = "panel")
}
# Text as outlines in a PDF or SVG file (showtext).
save_outlined <- function(plot, file, open, width, height) {
open(file, width = width, height = height)
showtext::showtext_begin()
print(plot)
showtext::showtext_end()
grDevices::dev.off()
}
# Save one figure in both sizes and three formats, and the paper version of
# each size; show the two-column one. make_plot(layout, paper, width,
# height) gives the figure at that size; with paper = TRUE, it gives the
# metrics of the paper (accuracy for balanced accuracy, no MCC). The paper
# version is as high as the figure, or `paper_height` when it has fewer
# panels.
save_figure <- function(make_plot, name, height, paper_height = height) {
purrr::iwalk(layouts, \(spec, layout) {
plot <- make_plot(layout, width = spec$width, height = height[[layout]])
dir.create(file.path(figs_dir, layout), recursive = TRUE,
showWarnings = FALSE)
stem <- file.path(figs_dir, layout, name)
# PNG with ragg (system text rendering).
ragg::agg_png(stringr::str_c(stem, ".png"), width = spec$width,
height = height[[layout]], units = "in", res = 600)
print(plot)
grDevices::dev.off()
# PDF and SVG with showtext (text as outlines).
devices <- list(pdf = grDevices::cairo_pdf, svg = grDevices::svg)
purrr::iwalk(devices, \(open, extension) {
save_outlined(plot, stringr::str_c(stem, ".", extension), open,
spec$width, height[[layout]])
})
# Paper version: PDF only.
dir.create(file.path(figs_dir, "paper", layout), recursive = TRUE,
showWarnings = FALSE)
paper <- make_plot(layout, paper = TRUE, width = paper_widths[[layout]],
height = paper_height[[layout]])
save_outlined(paper, stringr::str_c(file.path(figs_dir, "paper", layout, name), ".pdf"),
grDevices::cairo_pdf, paper_widths[[layout]], paper_height[[layout]])
})
make_plot("two-column", width = layouts[["two-column"]]$width,
height = height[["two-column"]])
}Code
# Save one table as CSV and LaTeX (for the paper) and show it as an
# interactive table. `widths` sets LaTeX column widths, `wide` names the
# long-text columns (the only ones that wrap), `filter` adds a filter box
# above each column, `display` (optional) is an HTML version of the table to
# show instead, `page_length` is the number of rows on one page, and `group`
# names a column (for example Dataset): all rows of one group share one
# background, which alternates between groups, in place of DT's stripe per
# row.
save_table <- function(data, name, caption, digits = 2, widths = NULL,
wide = NULL, filter = FALSE, display = NULL,
page_length = 15, group = NULL) {
data <- dplyr::mutate(
data,
dplyr::across(dplyr::where(is.double), \(v) round_half_up(v, digits))
)
# Files for the paper.
dir.create(tables_dir, recursive = TRUE, showWarnings = FALSE)
readr::write_csv(data, file.path(tables_dir, stringr::str_c(name, ".csv")))
latex <- kableExtra::kbl(data, format = "latex", booktabs = TRUE,
caption = caption)
for (column in names(widths)) {
latex <- kableExtra::column_spec(latex, match(column, names(data)),
width = widths[[column]])
}
writeLines(latex, file.path(tables_dir, stringr::str_c(name, ".tex")))
# Interactive table: search and pages only for long tables.
shown <- if (is.null(display)) data else display
long <- nrow(shown) > page_length
# unname(): a named vector would become a JSON object, which DT ignores.
is_number <- unname(purrr::map_lgl(shown, is.numeric))
is_wide <- names(shown) %in% wide
column_defs <- list(
list(className = "dt-left cell-nowrap", targets = which(!is_number & !is_wide) - 1),
list(className = "dt-left", targets = which(!is_number & is_wide) - 1),
list(className = "dt-right cell-nowrap", targets = which(is_number) - 1)
)
if (!is.null(wide)) {
column_defs <- c(column_defs, list(list(
width = if (length(wide) == 1) "35%" else "220px",
targets = which(is_wide) - 1
)))
}
widget <- DT::datatable(
shown,
escape = is.null(display), # the display version holds HTML
rownames = FALSE,
filter = if (filter) "top" else "none",
class = if (is.null(group)) "compact stripe hover" else "compact hover",
options = list(
dom = if (long) "ftip" else "t",
pageLength = page_length,
scrollX = TRUE,
autoWidth = !is.null(wide),
columnDefs = column_defs
)
)
# Fixed decimals for numbers; none for columns of whole numbers.
doubles <- purrr::map_lgl(shown, is.double)
whole <- purrr::map_lgl(shown, \(v) is.double(v) && all(v == round(v), na.rm = TRUE))
if (any(doubles & !whole)) {
widget <- DT::formatRound(widget, names(shown)[doubles & !whole], digits)
}
if (any(whole)) {
widget <- DT::formatRound(widget, names(shown)[whole], digits = 0)
}
# One background per group, alternating between groups (white, light grey).
if (!is.null(group)) {
groups <- unique(shown[[group]])
shades <- rep(c("#FFFFFF", group_color), length.out = length(groups))
widget <- DT::formatStyle(widget, group, target = "row",
backgroundColor = DT::styleEqual(groups, shades))
}
widget
}1.5 Results status
Code
# Names and order of the datasets, models and metrics in all tables and figures.
dataset_order <- c("pan_images", "extrusion", "textiles", "pipe_staple",
"microstructure")
dataset_labels <- c(pan_images = "Metallic pans", extrusion = "Extrusion",
textiles = "Textiles", pipe_staple = "Pipe staple",
microstructure = "Microstructure")
label_dataset <- function(x) {
factor(dataset_labels[x], levels = dataset_labels[dataset_order])
}
# Two-line labels for the narrow one-column figures.
short_labels <- c(pan_images = "Metallic\npans", extrusion = "Extrusion",
textiles = "Textiles", pipe_staple = "Pipe\nstaple",
microstructure = "Micro-\nstructure")
model_labels <- c(jev = "JEV", clef = "Clef-Flash", clip = "CLIP")
metric_labels <- c(
bal_accuracy = "Balanced accuracy", mcc = "MCC", roc_auc = "AUC",
accuracy = "Accuracy", sens = "Sensitivity", spec = "Specificity",
precision = "Precision", f_meas = "F1", brier_class = "Brier",
mn_log_loss = "Log loss", ece = "ECE"
)
# The sets of the fair comparison (scripts/fair_draw_sets.R) and the image
# manifest of all splits.
read_csv_quiet <- function(path, ...) {
readr::read_csv(path, show_col_types = FALSE, ...)
}
sets_dir <- file.path(saved_root, "sets")
sets <- c("learning", "calibration", "references", "design", "draw_report") |>
rlang::set_names() |>
purrr::map(\(name) read_csv_quiet(file.path(sets_dir, stringr::str_c(name, ".csv"))))
manifest <- read_csv_quiet("results/image_split_manifest.csv")
test_set <- dplyr::filter(manifest, split == "test")
# Score files and summaries of scripts/fair_evaluate.R, both from
# results_root: every table and figure then uses the same scores. A re-run
# can lack the rows of the decision models; paired.csv then has its header
# only.
scores_dir <- file.path(results_root, "scores")
summary_dir <- file.path(results_root, "summary")
if (!file.exists(file.path(summary_dir, "metrics.csv"))) {
stop("No summaries in ", summary_dir, ". Render once with a re-run switch ",
"on, then set use_rerun to TRUE and render again.", call. = FALSE)
}
metrics <- read_csv_quiet(file.path(summary_dir, "metrics.csv"))
paired <- read_csv_quiet(
file.path(summary_dir, "paired.csv"),
col_types = readr::cols(.default = "d", comparison = "c", model = "c",
dataset = "c", metric = "c")
)
k_curve <- read_csv_quiet(file.path(summary_dir, "k_curve.csv"))
# Closed loop logs and their audits (scripts/fair_close_loop.R). The mirror
# that the loop writes while it runs (<model>-<dataset>_loop_log.csv) does
# not count: only a closed loop has a _log.csv file.
loop_dir <- file.path(saved_root, "loop")
descriptions_dir <- file.path(saved_root, "descriptions")
read_loop_files <- function(kind) {
pattern <- stringr::str_c("^(jev|clef)-(", stringr::str_c(dataset_order, collapse = "|"),
")_", kind, "\\.csv$")
files <- list.files(loop_dir, pattern = pattern, full.names = TRUE)
if (length(files) == 0) {
return(tibble::tibble(file = character(), model = character(), dataset = character()))
}
files |>
rlang::set_names(basename(files)) |>
purrr::map(\(f) read_csv_quiet(f, col_types = readr::cols(.default = "c"))) |>
purrr::list_rbind(names_to = "file") |>
dplyr::mutate(
model = stringr::str_extract(file, "^[a-z]+"),
dataset = stringr::str_match(file, stringr::str_c("^[a-z]+-(.+)_", kind))[, 2]
)
}
loops <- read_loop_files("log")
audits <- read_loop_files("audit")
if (nrow(loops) > 0) {
loops <- dplyr::mutate(loops, candidate = as.integer(candidate),
auc = as.numeric(auc), kept = as.logical(kept))
}
# What exists decides which sections run. The guards look at the rows, not
# at the files: metrics.csv can exist with CLIP rows only.
has_decision <- any(metrics$model %in% c("jev", "clef"))
has_loop <- nrow(loops) > 0
has_paired <- nrow(paired) > 0
has_comparison <- function(id) any(paired$comparison == id)
placeholder <- "This result needs the runs of the decision models (@sec-rerun)."
# A note in place of a section, or of its decision-model part.
note <- function(show, text = "") {
if (show) {
cat("\n::: {.callout-note}\n", placeholder, " ", text, "\n:::\n\n", sep = "")
}
}
# Marks of the configurations whose Platt fit does not keep the order of the
# raw scores, from the column platt_slope: a negative slope reverses it
# (decision D82), and an undefined slope (NA) gives 0.5 to every image
# (decision D89).
slopes <- dplyr::distinct(metrics, model, description, k, dataset, platt_slope)
slope_of <- function(m, desc, kk, ds) {
slopes$platt_slope[slopes$model == m & slopes$description == desc &
slopes$k == kk & slopes$dataset == ds]
}
slope_mark <- function(slope) {
dplyr::case_when(is.na(slope) ~ " ‡", slope < 0 ~ " †", .default = "")
}
mark_text <- c(
" †" = "† Negative Platt slope: Platt reverses the order of the raw scores (decision D82).",
" ‡" = "‡ Platt slope not defined: all C scores are above the clamp of 0.995, so Platt gives 0.5 to every image (decision D89)."
)
# The meaning of the marks that a table shows, for its caption.
mark_caption <- function(marks) {
stringr::str_c(" ", mark_text[intersect(names(mark_text), marks)], collapse = "")
}
# Table of what exists now.
score_files <- list.files(scores_dir, pattern = "^(jev|clef|clip)_.+_(calibration|test)\\.csv$")
count_files <- function(prefix) sum(stringr::str_starts(score_files, prefix))
status <- tibble::tribble(
~Item, ~Count,
"Set files (results/fair/sets)", length(list.files(sets_dir, "\\.csv$")),
"CLIP score files", count_files("clip_"),
"JEV score files", count_files("jev_"),
"Clef-Flash score files", count_files("clef_"),
"Closed description loops (of 8)", dplyr::n_distinct(loops$file),
"Frozen descriptions (of 8)", length(list.files(descriptions_dir, "\\.csv$")),
"Metric rows of the decision models", sum(metrics$model %in% c("jev", "clef")),
"Paired comparison rows", nrow(paired)
)
knitr::kable(status)| Item | Count |
|---|---|
| Set files (results/fair/sets) | 5 |
| CLIP score files | 58 |
| JEV score files | 56 |
| Clef-Flash score files | 56 |
| Closed description loops (of 8) | 8 |
| Frozen descriptions (of 8) | 8 |
| Metric rows of the decision models | 3696 |
| Paired comparison rows | 84 |
2 Data
2.1 Sets
The five datasets of Megahed et al. (2026) are copies of fmegahed/qe_genai/data in imgs/. The pipe staple images are from AutoVI (Carvalho et al., 2024). results/image_split_manifest.csv lists every image and its split. Before v0.0.1, duplicate pan test files and three extrusion frames that copied test frames were removed (README, section Data). scripts/fair_draw_sets.R draws the sets of the fair comparison from the non-test images of each dataset:
- Learning set L. The CLIP baseline set of each dataset: 50 images per class (pans: 10). The defective images are spread evenly over the defect types. The references and the design images come from L.
- References. k images per class from L, with k = 1, 2 or 4. The sets are nested: the references at k = 1 are in the set at k = 2, which is in the set at k = 4.
- Design images. The images of L that are not references at k = 2. The description loop scores its candidates on them.
- Calibration set C. 25 images per class from the non-test images that are not in L. The defective images are stratified over the defect types. Pans have no C, because all 20 non-test pan images are in L.
- Test set. The test sets of v0.0.1 and of the CLIP study. Each configuration scores the test set once.
Code
# Defect types of each dataset, from all its images, with readable names for
# three datasets.
named_types <- c(
microstructure = "Band, Bimodal, SingleCrystal (low, medium, high)",
pan_images = "One defective class",
pipe_staple = "Missing staple"
)
defect_types <- manifest |>
dplyr::filter(actual_class == "defective") |>
dplyr::summarise(
n_types = dplyr::n_distinct(defect_type),
types = stringr::str_c(sort(unique(stringr::str_replace_all(defect_type, "_", " "))),
collapse = ", "),
.by = dataset
) |>
dplyr::mutate(
types = dplyr::coalesce(unname(named_types[dataset]), types),
types = dplyr::if_else(n_types > 1, stringr::str_c(n_types, " types: ", types), types)
)
# "nominal + defective" counts of one set.
count_set <- function(data, name) {
data |>
dplyr::count(dataset, actual_class) |>
tidyr::pivot_wider(names_from = actual_class, values_from = n) |>
dplyr::transmute(dataset, "{name}" := stringr::str_c(nominal, " + ", defective))
}
# Table T1.
t1 <- tibble::tibble(dataset = dataset_order) |>
dplyr::left_join(defect_types, by = "dataset") |>
dplyr::left_join(count_set(sets$learning, "learning"), by = "dataset") |>
dplyr::left_join(count_set(sets$references, "references"), by = "dataset") |>
dplyr::left_join(count_set(sets$design, "design"), by = "dataset") |>
dplyr::left_join(count_set(sets$calibration, "calibration"), by = "dataset") |>
dplyr::left_join(count_set(test_set, "test"), by = "dataset") |>
dplyr::transmute(
Dataset = dataset_labels[dataset],
`Defect types` = types,
`Learning set L` = learning,
`References in L (k = 4)` = references,
`Design images` = dplyr::coalesce(design, "none (no loop)"),
`Calibration set C` = dplyr::coalesce(calibration, "none"),
`Test set` = test
)
save_table(t1, "T1_sets", "Datasets and sets (images, nominal + defective).",
wide = "Defect types", group = "Dataset")2.2 Label budget
The paper separates two numbers. The first is the number of images that the model sees for each test image: k per class. The second is the number of labeled images that the method needs in total. Table 2 gives the second number for each method, per class. JEV, Clef-Flash and the CLIP baseline need the same labeled images.
Code
# Images per class in L and in C (C: 0 for pans).
per_class <- function(data, name) {
data |>
dplyr::count(dataset, actual_class) |>
dplyr::summarise("{name}" := min(n), .by = dataset)
}
k_main <- 2
budget <- tibble::tibble(dataset = dataset_order) |>
dplyr::left_join(per_class(sets$learning, "n_l"), by = "dataset") |>
dplyr::left_join(per_class(sets$calibration, "n_c"), by = "dataset") |>
dplyr::mutate(
n_c = dplyr::coalesce(n_c, 0L),
pans = dataset == "pan_images",
decision = dplyr::if_else(pans, n_l, n_l + n_c),
refs = dplyr::if_else(pans, n_l, k_main + n_c),
zero = dplyr::if_else(pans, n_l, n_c)
)
# Table T2: one row per method, one column per dataset.
t2 <- budget |>
dplyr::transmute(
dataset = dataset_labels[dataset],
`JEV and Clef-Flash` = decision, `CLIP baseline` = decision,
`CLIP, same references` = refs, `CLIP, zero-shot` = zero
) |>
tidyr::pivot_longer(-dataset, names_to = "Method") |>
tidyr::pivot_wider(names_from = dataset, values_from = value) |>
dplyr::mutate(
Learning = c("L (k references; the rest chooses the description)", "L",
"the k references", "none"),
Calibration = "C",
`Images seen per test image, per class` = c("k", "50 (pans 10)", "k", "0"),
.after = Method
)
save_table(t2, "T2_label_budget",
"Label budget: labeled images per class that each method needs (k = 2).",
digits = 0)2.3 Calibration draw
Code
# Numbers for the text below.
draw <- sets$draw_report
excluded <- \(ds, class) draw$excluded_near_copies[draw$dataset == ds & draw$actual_class == class]C excludes the near-copies of L and test images. CLIP scores an image by its highest similarity to the images of L. A C image that nearly copies an L image thus gets a very confident score, and a Platt fit on C becomes too steep for CLIP. The rule depends on the dataset (Table 3):
- Extrusion frames come from video, so a frame can nearly copy another frame. The draw excluded 34 nominal and 13 defective frames with a dHash distance of 6 or less to an L or test frame. This is the check of
experiments/check_leakage.R, with the same distance limit. - The other datasets show one fixed scene, so dHash flags almost every pair of images. They exclude byte-identical copies (MD5) only. The draw found none.
Pipe staple has only 17 defective images outside L and the test set. C then takes 17 images per class, so it stays balanced. Open item O3 stays open: L is the CLIP baseline set of the CLIP paper, and some extrusion test frames can nearly copy L frames. The paper states this as a limitation of the CLIP baseline on extrusion.
Code
rule_labels <- c(
dhash6 = "dHash distance of 6 or less to an L or test image",
md5 = "Byte-identical (MD5) copy of an L or test image"
)
# Table T3.
t3 <- draw |>
dplyr::arrange(match(dataset, dataset_order), dplyr::desc(actual_class == "nominal")) |>
dplyr::transmute(
Dataset = dataset_labels[dataset],
Class = actual_class,
`Near-copy rule` = unname(rule_labels[rule]),
`Images left after exclusion` = available,
`Excluded near-copies` = excluded_near_copies,
Drawn = drawn,
Shortfall = shortfall
)
save_table(t3, "T3_calibration_draw", "Draw of the calibration set C (seed 202611).",
digits = 0, wide = "Near-copy rule", group = "Dataset")2.4 Reference images
Code
# Label of one reference image: its class, or its defect type.
type_names <- c(defective = "Defective", missing = "Missing staple",
over = "Over-extrusion", under = "Under-extrusion",
local = "Local defect", global = "Global defect")
tile_label <- function(class, type) {
dplyr::case_when(
class == "nominal" ~ "Nominal",
type %in% names(type_names) ~ type_names[type],
.default = capitalize(stringr::str_replace_all(type, "_", " "))
)
}
# One image tile: center-cropped and scaled as sent to the models. The
# pixels go in as a numeric array; as.raster() of a magick image sometimes
# drew blank or garbled tiles.
tile_plot <- function(path, class, type, layout) {
image <- magick::image_read(path)
info <- magick::image_info(image)
side <- min(info$width, info$height)
pixels <- image |>
magick::image_crop(stringr::str_glue("{side}x{side}"), gravity = "center") |>
magick::image_scale("320x320!") |>
magick::image_data(channels = "rgb") |>
as.integer() # height x width x 3
label <- tile_label(class, type)
if (layout == "one-column") label <- stringr::str_replace(label, " ", "<br>")
ggplot2::ggplot() +
ggplot2::annotation_raster(pixels / 255, 0, 1, 0, 1) +
ggplot2::coord_fixed(xlim = c(0, 1), ylim = c(0, 1), expand = FALSE) +
ggplot2::labs(title = paint(label, class_colors[[class]])) +
ggplot2::theme_void(base_size = layouts[[layout]]$base_size,
base_family = body_font) +
ggplot2::theme(
plot.title = ggtext::element_markdown(
hjust = 0.5, size = ggplot2::rel(0.85), lineheight = 1.1,
margin = ggplot2::margin(0, 0, 2, 0)
),
plot.margin = ggplot2::margin(2, 2, 2, 2)
)
}
# Dataset name at the start of each row.
row_label <- function(text, layout) {
ggplot2::ggplot() +
ggplot2::annotate(
"text", x = 0, y = 0.5, label = text, hjust = 0, family = title_font,
lineheight = 0.95, fontface = "bold",
size = layouts[[layout]]$base_size / ggplot2::.pt
) +
ggplot2::xlim(0, 1) +
ggplot2::ylim(0, 1) +
ggplot2::theme_void()
}
# Width of the column of dataset names: the widest line of a name, and a gap
# of 6 pt to the images. The image columns share the rest of the width, so
# the images move to the left and spread out.
label_width <- function(layout) {
names <- if (layout == "one-column") short_labels else dataset_labels
lines <- unlist(stringr::str_split(names, "\n"))
widths <- systemfonts::string_width(lines, family = title_font, weight = "bold",
size = layouts[[layout]]$base_size, res = 7200) / 100
max(widths) + 6
}
# Figure F1: one row per dataset, nominal images first.
refs_main <- dplyr::filter(sets$references, rank <= k_main)
fig_references <- function(layout, paper = FALSE, width = layouts[[layout]]$width, ...) {
tiles <- purrr::map(dataset_order, function(ds) {
refs <- refs_main |>
dplyr::filter(dataset == ds) |>
dplyr::arrange(dplyr::desc(actual_class == "nominal"), rank)
row <- purrr::pmap(
list(refs$image_path, refs$actual_class, refs$defect_type),
\(path, class, type) tile_plot(path, class, type, layout)
)
name <- if (layout == "one-column") short_labels[[ds]] else dataset_labels[[ds]]
c(list(row_label(name, layout)), row)
})
patchwork::wrap_plots(unlist(tiles, recursive = FALSE), ncol = 1 + 2 * k_main,
widths = grid::unit(c(label_width(layout), rep(1, 2 * k_main)),
c("pt", rep("null", 2 * k_main)))) +
patchwork::plot_annotation(
# Subtitle and caption fill each line (fmm): the subtitle, bold and
# centered, over the image columns; the caption over the whole width.
subtitle = subline(
layout,
"Two ", paint("nominal", class_colors[["nominal"]]), " and two ",
paint("defective", class_colors[["defective"]]),
" reference images, drawn from the learning set and center-cropped.",
width = width - label_width(layout) / 72, balance = FALSE
),
# Image sources, one sentence on each line. AutoVI is CC BY-NC-SA 4.0:
# the pipe staple tiles of this figure keep that license. The license
# name does not break across lines (no-break spaces).
caption = stringr::str_c(
subline(layout,
"**Images** from Megahed et al. (2026), github.com/fmegahed/qe_genai.",
bold = FALSE, size = 0.8, width = width, balance = FALSE),
"<br>",
subline(layout,
"Pipe staple images sampled from AutoVI (Carvalho et al., 2024), CC BY-NC-SA 4.0.",
bold = FALSE, size = 0.8, width = width, balance = FALSE)
),
# The left margin of the subtitle is the column of dataset names.
theme = theme_paper(layout) +
ggplot2::theme(plot.subtitle = ggtext::element_markdown(
margin = ggplot2::margin(0, 0, 6, label_width(layout))
))
)
}
save_figure(fig_references, "F1_reference_images",
height = c("one-column" = 4.86, "two-column" = 7.18))
3 Methods
3.1 Common settings
All methods do the binary task: nominal or defective. The event class of all metrics is defective. Each image is center-cropped to a square and scaled to at most 768 px, with no upscaling (the frozen v0.0.1 setting). The models are JEV jev-1.13.0 on the TypeSafe API (TypeSafe, 2026), Clef-Flash (Cloudflare, 2026) on a local SGLang server, and CLIP ViT-L/14 (Radford et al., 2021) on a local GPU. The settings of each model are those of v0.0.1.
3.2 References
Each call to JEV or Clef-Flash holds k reference images per class, then the image to classify. The main setting is k = 2, so a call holds 4 references. The reference curve uses k = 0, 1, 2 and 4. The nominal references are a random draw from the nominal images of L. The defective references take one image per defect type, in a random order of the types, until there are k images. Pans and pipe staple have one defect type and take a random draw. The seed is 202610. JEV, Clef-Flash and CLIP use the same references (Figure 1). Microstructure has 9 defect types, so at k = 2 its references show only 2 of them. This is the cost of few references, and the curve to k = 4 measures it.
3.3 Description loop
A description is the pair of texts that tells the model what a nominal and a defective image look like. The loop looks for a better description, for JEV and for Clef-Flash separately, on the four datasets other than pans:
- The design images are the images of L that are not references at k = 2 (48 per class).
- The loop starts from the generic description of
classify_image(). Nominal: “No visible manufacturing defects; the part appears conforming.” Defective: “At least one visible manufacturing defect or anomaly.” - A candidate changes only the two texts. The references (k = 2), the image size and the crop do not change. Each dataset and model has at most 6 candidates, including the start.
- The score of a candidate is its ROC AUC (Hanley & McNeil, 1982) on the design images. A candidate replaces the current best if its AUC is at least 0.02 higher. The final description is the last one kept.
- A Claude Code agent runs the loop: one fresh agent for each model and dataset (8 loops, 8 agents; decision D81), so each loop is audited and closed on its own. The agent works in a sandbox folder that holds only the design images (with neutral file names), their class and defect type, the four reference images, the generic description, the scoring command and the loop instructions (
scripts/fair_loop_instructions.md). It cannot see the test images, C or any result. - The loop is blind: the instructions carry no dataset knowledge from the researchers (decision D74). The researchers approve the instructions before the loop starts, and they do not edit a description during the loop.
scripts/fair_close_loop.Raudits the transcript of the agent. It flags every tool call outside the sandbox and every read of the scoring script, then freezes the final description.
scripts/fair_run_loop.sh <model> <dataset> starts each agent as a separate, isolated Claude Code process, with the sandbox as its working folder. The process reads no user, project or local settings, and it loads no CLAUDE.md, skills, plugins, hooks, MCP servers or slash commands. It has only the tools Read, Write, Edit, Glob, Grep, Bash and TodoWrite. The agent reads with the Read, Glob and Grep tools, which stay in the sandbox; reads outside the sandbox are refused. Bash runs without a prompt for the scoring command and for the read-only commands that Claude Code allows by default, which also stay in the sandbox. Writes run without a prompt only for candidates/*.csv, and writes to score.sh, LOOP.md, labels.csv, loop_log.csv and generic_description.csv are denied. The permission mode is pinned (dontAsk), so the process denies every other shell command and every other call. The model is pinned too. Each loop gets a new session ID, so the path of its transcript is known. The command:
claude -p "Read LOOP.md and follow it." --restricted --safe-mode --strict-mcp-config --settings '{"permissions":{"blockReadsOutsideWorkingDirectories":true}}' --tools Read,Write,Edit,Glob,Grep,Bash,TodoWrite --allowedTools Read Glob Grep TodoWrite "Edit(./candidates/*.csv)" "Bash(bash score.sh:*)" "Bash(./score.sh:*)" --disallowedTools "Edit(./score.sh)" "Edit(./LOOP.md)" "Edit(./labels.csv)" "Edit(./loop_log.csv)" "Edit(./generic_description.csv)" --disable-slash-commands --permission-mode dontAsk --permission-prompts none --model claude-opus-5-5 --session-id <new UUID>The launcher refuses to start when the sandbox does not exist, when a loop log from an earlier attempt exists, or when the description is already frozen. With JEV_CHECK_ONLY=true, a rehearsal runs the checks only and makes no paid call. The md5 check of score.sh and the audit of the transcript stay as a second layer. The agent runs on the researchers’ computer, not in a container or a virtual machine.
The design AUC of the final description is optimistic, because the loop chose on these images. Its AUC on C is not, because C chose nothing. Pans have no loop: 20 images cannot give references, design images and calibration images. JEV and Clef-Flash use the generic description on pans.
3.4 Calibration and decision
Each configuration scores C once, and then the test set once. scripts/fair_score.R refuses a second run, and a test run before the calibration run. Platt scaling (Platt, 1999), fitted on the C scores of the same configuration, gives the calibrated probability. It uses the smoothed targets of Platt, so a C that separates perfectly still gives a finite fit. Platt keeps the order of the scores only when its slope is positive; a negative slope reverses the order. metrics.csv reports the slope of each configuration (column platt_slope). The decision is defective when the calibrated probability is 0.5 or more. No method tunes a threshold. C is balanced, so this rule aims at balanced accuracy. Isotonic regression (Zadrozny & Elkan, 2002), fitted on C, is a sensitivity analysis (Section 11.1).
Before the test runs, the researchers see the results on C: scripts/fair_evaluate.R writes calibration_summary.csv, with the number of images per class, the AUC and the balanced accuracy at 0.5 of the raw scores, and the Platt slope of each configuration that has a calibration file. It needs no test file. A test run of a final description stops when the frozen description changed after the calibration run (the calibration file keeps the md5 of the frozen file). A run of a final description also stops when the audit of its loop flagged a tool call, unless a recorded decision accepts the flagged calls (FAIR_AUDIT_DECISION; runs.csv keeps the decision ID).
Pans have no C. JEV, Clef-Flash and CLIP with the same references calibrate on the images of L that are not references; these images choose nothing. The CLIP baseline calibrates on leave-one-out scores in L. Near-identical pan photos make these scores optimistic. CLIP zero-shot calibrates on all 20 images of L.
3.5 CLIP variants
The CLIP score of an image with labeled images is the softmax of its two highest cosine similarities: to the nominal images and to the defective images (Megahed et al., 2026). The zero-shot score is the softmax of the similarities to two text prompts, the prompts of v0.0.1. A raw score of 0.5 or more thus means that the image is closer to the defective class: this is the rule of the CLIP paper.
| Variant | Learning images | Calibration | Purpose |
|---|---|---|---|
| CLIP baseline | L | Platt on C (pans: leave-one-out on L) | the benchmark |
| CLIP, same references | the k references of JEV, k = 1, 2, 4 | Platt on C | the same few images as JEV |
| CLIP, zero-shot | none (text prompts of v0.0.1) | Platt on C | no labeled images in the model |
| CLIP, zero-shot with the final descriptions | none (the final JEV descriptions as text prompts, cut at 77 tokens) | Platt on C | does a better description help CLIP too? |
| CLIP, paper rule | L | none (raw score at 0.5) | continuity with the CLIP paper |
3.6 Configurations
| Model | Description | k per class | Datasets |
|---|---|---|---|
| JEV | final description of the loop | 0, 1, 2, 4 | 4 (pans: generic) |
| JEV | generic | 0, 2 | 4 |
| Clef-Flash | final description of its loop | 0, 1, 2, 4 | 4 (pans: generic) |
| Clef-Flash | generic | 0, 2 | 4 |
| CLIP | the variants above | as above | 5 |
3.7 Metrics
Each configuration reports these metrics on C and on the test set, with the yardstick package: accuracy, balanced accuracy, sensitivity (recall), specificity, precision, F1, the Matthews correlation coefficient (MCC), ROC AUC, the Brier score and the log loss. The expected calibration error (ECE) uses 10 equal-width bins (Guo et al., 2017); yardstick has no ECE, so R/evaluation.R has a short function. The factor level defective comes first, so yardstick uses it as the event.
The headline metrics are balanced accuracy and MCC. Balanced accuracy does not depend on the prevalence. MCC uses all four cells of the confusion matrix. F1 and precision ignore true negatives, and they change when the other class is the event. All test sets are balanced, so accuracy equals balanced accuracy on the test sets; the tables show both. After calibration, the metrics on C are in sample (column in_sample of metrics.csv), so the tables of this document use the test set.
3.8 Time and cost
The time per image of JEV and Clef-Flash is the wall time of the call for that image, with the image preparation (elapsed_ms in the score files). When a call fails (an HTTP error, a connection error or an answer with no valid probability), the runner tries the image again: at most 3 attempts in all, after waits of 2 s and 8 s; then the run stops. The retries and the waits count in elapsed_ms. The call log keeps each failed attempt, so the budget counts it. The CLIP score files have no time, because they are one-time files. A separate pass on the test images times each CLIP variant: encode_ms is the time to load, prepare and encode the image, and score_ms is the time to score the encoded image. One warm-up call runs before the timing, because the first call on the GPU is slower. The features of the learning and reference images are encoded once and do not count. Each scoring run adds one row to runs.csv (start, end, seconds and hardware). The cost of JEV comes from the TypeSafe call log (Section 9).
3.9 Paired comparisons
These comparisons were fixed before the test runs (decision D71). Each one applies to each dataset and to each decision model (JEV and Clef-Flash):
| ID | Comparison | Goal |
|---|---|---|
| P1 | Decision model (final description, k = 2, calibrated) against the CLIP baseline (calibrated) | a fair comparison with CLIP |
| P2 | Final description against generic description, both at k = 2 | the description makes a difference |
| P3 | k = 2 against k = 0, both with the final description | only a few images are necessary |
A paired bootstrap over the test images, stratified by class (2,000 resamples, seed 202612), gives the difference and its 95% percentile interval for balanced accuracy, MCC and AUC. An exact McNemar test on the correctness of each image is a second check. The McNemar p-values are Holm-adjusted within each model, over 14 tests (P1 to P3 for 4 datasets, P1 and P3 for pans).
3.10 Code
The functions that draw the sets (R/fair_sets.R, with the near-copy check of R/image_hash.R):
Code
# Helpers for the shared learning, calibration, reference and design sets.
# Draws use withr::with_seed(), so they do not depend on call order and
# leave the global RNG unchanged.
# Images per defect type: floor(n / T) each, and one more for the first
# n %% T types (alphabetical). A type with too few images gives its
# remainder to the types that still have images.
type_quota <- function(available, n) {
types <- sort(names(available))
quota <- stats::setNames(rep(0L, length(types)), types)
left <- min(n, sum(available))
while (left > 0) {
open <- types[quota[types] < available[types]]
base <- left %/% length(open)
extra <- left %% length(open)
add <- base + (seq_along(open) <= extra)
add <- pmin(add, available[open] - quota[open])
quota[open] <- quota[open] + add
left <- left - sum(add)
}
quota
}
# Calibration set C for one dataset. `pool` holds the candidates (columns
# dataset, image_path, defect_type, actual_class); `exclude` holds the
# near-copy paths to drop. Both classes get the same number of images.
draw_calibration <- function(pool, n_per_class = 25, seed = 202611,
exclude = character()) {
pool <- pool |>
dplyr::filter(!.data$image_path %in% exclude) |>
dplyr::arrange(.data$image_path)
nominal <- dplyr::filter(pool, .data$actual_class == "nominal")
defective <- dplyr::filter(pool, .data$actual_class == "defective")
n <- min(n_per_class, nrow(nominal), nrow(defective))
withr::with_seed(seed, {
drawn_nominal <- dplyr::slice_sample(nominal, n = n)
quota <- type_quota(table(defective$defect_type), n)
drawn_defective <- defective |>
dplyr::group_split(.data$defect_type) |>
purrr::map(\(x) dplyr::slice_sample(x, n = quota[[x$defect_type[1]]])) |>
purrr::list_rbind()
})
dplyr::bind_rows(drawn_nominal, drawn_defective)
}
# One row for each dataset and class: available, excluded, drawn, shortfall.
# shortfall = n_per_class - drawn, so it is positive by design when a class
# has fewer images than n_per_class (pipe staple: 17 drawn, shortfall 8).
draw_report <- function(pool, drawn, exclude = character(), n_per_class = 25,
rule = NA_character_) {
excluded <- pool |>
dplyr::filter(.data$image_path %in% exclude) |>
dplyr::count(.data$dataset, .data$actual_class, name = "excluded_near_copies")
pool |>
dplyr::filter(!.data$image_path %in% exclude) |>
dplyr::count(.data$dataset, .data$actual_class, name = "available") |>
dplyr::left_join(excluded, by = c("dataset", "actual_class")) |>
dplyr::left_join(
dplyr::count(drawn, .data$dataset, .data$actual_class, name = "drawn"),
by = c("dataset", "actual_class")
) |>
dplyr::mutate(
excluded_near_copies = tidyr::replace_na(.data$excluded_near_copies, 0L),
drawn = tidyr::replace_na(.data$drawn, 0L),
shortfall = n_per_class - .data$drawn,
rule = rule
) |>
dplyr::select("dataset", "actual_class", "rule", "available",
"excluded_near_copies", "drawn", "shortfall")
}
# References of one dataset and class, ranks 1 to k_max.
draw_references_class <- function(x, k_max, seed) {
x <- dplyr::arrange(x, .data$image_path)
withr::with_seed(seed, {
if (x$actual_class[1] == "nominal" || dplyr::n_distinct(x$defect_type) == 1) {
picked <- dplyr::slice_sample(x, n = k_max)
} else {
types <- sample(sort(unique(x$defect_type)))
shuffled <- x |>
dplyr::group_split(.data$defect_type) |>
purrr::set_names(purrr::map_chr(
dplyr::group_split(x, .data$defect_type), \(g) g$defect_type[1]
)) |>
purrr::map(\(g) dplyr::slice_sample(g, prop = 1))
type_for_rank <- types[(seq_len(k_max) - 1) %% length(types) + 1]
occurrence <- stats::ave(seq_len(k_max), type_for_rank, FUN = seq_along)
picked <- purrr::map2(type_for_rank, occurrence, \(t, j) shuffled[[t]][j, ]) |>
purrr::list_rbind()
}
})
dplyr::mutate(picked, rank = seq_len(nrow(picked)))
}
# References for every dataset and class; each has its own seeded call.
draw_references <- function(learning, k_max = 4, seed = 202610) {
learning |>
dplyr::group_split(.data$dataset, .data$actual_class) |>
purrr::map(\(x) draw_references_class(x, k_max, seed)) |>
purrr::list_rbind() |>
dplyr::arrange(.data$dataset, .data$actual_class, .data$rank)
}Code
# 64-bit difference hash (dHash) of an image: same algorithm as
# experiments/check_leakage.R. Near-copy = Hamming distance <= 6.
dhash <- function(path) {
pixels <- magick::image_read(path) |>
magick::image_orient() |>
magick::image_convert(colorspace = "gray") |>
magick::image_resize("9x8!") |>
magick::image_data(channels = "gray") |>
as.integer()
pixels <- matrix(pixels, nrow = 8, ncol = 9)
as.vector(pixels[, 2:9] > pixels[, 1:8])
}
# One row of 64 bits for each path.
hash_matrix <- function(paths) {
do.call(rbind, purrr::map(paths, dhash))
}
# Paths with a Hamming distance <= max_distance to any image of `others`.
near_copies <- function(paths, others, max_distance = 6) {
if (length(paths) == 0 || length(others) == 0) {
return(character())
}
x <- hash_matrix(paths) * 1
y <- hash_matrix(others) * 1
# Hamming distance = bits that differ, for all pairs at once.
distance <- x %*% (1 - t(y)) + (1 - x) %*% t(y)
paths[apply(distance, 1, min) <= max_distance]
}
# Paths with a byte-identical copy (MD5) among `others`.
md5_copies <- function(paths, others) {
if (length(paths) == 0 || length(others) == 0) {
return(character())
}
paths[unname(tools::md5sum(paths)) %in% unname(tools::md5sum(others))]
}The metrics and the paired tests (R/evaluation.R):
Code
# Metrics and paired tests for the fair comparison (no API calls).
# Source from the project root.
#' Expected calibration error
#' @param prob Defect probabilities.
#' @param y 1 for defective, 0 for nominal.
#' @param bins Number of equal-width bins on [0, 1].
#' @return The ECE (weighted mean gap between mean prob and defect rate).
ece <- function(prob, y, bins = 10) {
tibble::tibble(prob = prob, y = y) |>
dplyr::mutate(bin = cut(prob, seq(0, 1, length.out = bins + 1),
include.lowest = TRUE)) |>
dplyr::summarise(gap = dplyr::n() * abs(mean(prob) - mean(y)), .by = bin) |>
dplyr::pull(gap) |>
sum() / length(prob)
}
# Add the two factors yardstick needs. The first level is the event.
add_classes <- function(data, threshold) {
lvl <- c("defective", "nominal")
data |>
dplyr::mutate(
truth = factor(as.character(actual_class), levels = lvl),
estimate = factor(dplyr::if_else(prob_defective >= threshold,
"defective", "nominal"), levels = lvl)
)
}
#' All common metrics at one threshold
#' @param data Tibble with `actual_class` and `prob_defective`.
#' @param threshold Decision threshold (default 0.5).
#' @return One-row tibble. The event is "defective".
class_metrics <- function(data, threshold = 0.5) {
data <- add_classes(data, threshold)
hard <- yardstick::metric_set(
yardstick::accuracy, yardstick::bal_accuracy, yardstick::sens,
yardstick::spec, yardstick::precision, yardstick::f_meas, yardstick::mcc
)
soft <- yardstick::metric_set(
yardstick::roc_auc, yardstick::brier_class, yardstick::mn_log_loss
)
out <- dplyr::bind_rows(
hard(data, truth = truth, estimate = estimate),
soft(data, truth = truth, prob_defective)
) |>
dplyr::select(.metric, .estimate) |>
tidyr::pivot_wider(names_from = .metric, values_from = .estimate)
# MCC is NaN when a class is never predicted or present: count it as 0.
out |>
dplyr::mutate(mcc = tidyr::replace_na(mcc, 0)) |>
dplyr::mutate(ece = ece(data$prob_defective,
as.integer(data$truth == "defective")))
}
#' Exact McNemar test
#' @param correct_a,correct_b Logical: was each method right on each image?
#' @return Two-sided exact p-value from the discordant pairs.
mcnemar_exact <- function(correct_a, correct_b) {
only_a <- sum(correct_a & !correct_b)
only_b <- sum(!correct_a & correct_b)
if (only_a + only_b == 0) return(1)
stats::binom.test(only_a, only_a + only_b, p = 0.5)$p.value
}
#' Paired bootstrap of a metric difference (a minus b)
#' @param a,b Prediction tibbles on the same images, in the same order.
#' @param metric "bal_accuracy", "mcc" or "roc_auc".
#' @return Tibble with `difference`, `low`, `high` (95% percentile interval).
#' Images are resampled within class; a and b share the indices.
paired_bootstrap <- function(a, b, metric, times = 2000, seed = 202612) {
metric <- rlang::arg_match(metric, c("bal_accuracy", "mcc", "roc_auc"))
score <- function(d, i) {
d <- add_classes(d[i, ], 0.5)
switch(metric,
bal_accuracy = yardstick::bal_accuracy_vec(d$truth, d$estimate),
mcc = tidyr::replace_na(yardstick::mcc_vec(d$truth, d$estimate), 0),
roc_auc = yardstick::roc_auc_vec(d$truth, d$prob_defective)
)
}
diff_at <- function(i) score(a, i) - score(b, i)
by_class <- split(seq_len(nrow(a)), a$actual_class)
# with_seed leaves the global random state untouched.
boot <- withr::with_seed(seed, purrr::map_dbl(seq_len(times), \(r) {
diff_at(unlist(purrr::map(by_class, \(i) sample(i, length(i), replace = TRUE))))
}))
ci <- stats::quantile(boot, c(0.025, 0.975), names = FALSE)
tibble::tibble(difference = diff_at(seq_len(nrow(a))), low = ci[1], high = ci[2])
}Platt scaling and isotonic regression (R/calibration_functions.R):
Code
# Calibration and threshold functions shared by calibration.R and
# validation_size.R (no API calls). Source from the project root.
# Scores can be 0 or 1; clamp them to avoid logit(0).
clamp <- function(p) pmin(pmax(p, 0.005), 0.995)
#' Measure calibration of defect probabilities
#' @param p Defect probabilities.
#' @param y 1 for defective, 0 for nominal.
#' @return Tibble with `brier`, `ece` (10 equal-width bins), `log_loss`,
#' `mean_p_minus_rate`, and `ba_at_050`.
calibration_metrics <- function(p, y) {
gap <- tibble::tibble(p = p, y = y) |>
dplyr::mutate(bin = cut(p, seq(0, 1, 0.1), include.lowest = TRUE)) |>
dplyr::summarise(gap = dplyr::n() * abs(mean(p) - mean(y)), .by = bin) |>
dplyr::pull(gap) |>
sum()
tibble::tibble(
brier = mean((p - y)^2),
ece = gap / length(p),
log_loss = -mean(y * log(clamp(p)) + (1 - y) * log(1 - clamp(p))),
mean_p_minus_rate = mean(p) - mean(y),
ba_at_050 = (mean(p[y == 1] >= 0.5) + mean(p[y == 0] < 0.5)) / 2
)
}
#' Fit Platt scaling
#' @details Logistic regression on logit(p) with Platt's soft targets
#' (N+ + 1)/(N+ + 2) and 1/(N- + 2), which keep the fit finite when the
#' scores are perfectly separated.
#' @return A function that maps new probabilities to calibrated ones.
platt <- function(p, y) {
target <- dplyr::if_else(y == 1, (sum(y) + 1) / (sum(y) + 2),
1 / (sum(1 - y) + 2))
fit <- stats::glm(target ~ x, family = stats::quasibinomial(),
data = tibble::tibble(target = target,
x = stats::qlogis(clamp(p))))
function(new_p) {
new_x <- tibble::tibble(x = stats::qlogis(clamp(new_p)))
unname(stats::predict(fit, new_x, type = "response"))
}
}
#' Fit isotonic regression
#' @details Pool-adjacent-violators fit of y on p (stats::isoreg), linear
#' interpolation between knots, constant beyond the fitted range.
#' @return A function that maps new probabilities to calibrated ones.
isotonic <- function(p, y) {
ord <- order(p)
fit <- stats::isoreg(p[ord], y[ord])
# One fitted value per distinct score (tied scores share the pooled value).
knots <- tibble::tibble(score = p[ord], fitted = fit$yf) |>
dplyr::summarise(fitted = mean(fitted), .by = score) |>
dplyr::arrange(score)
if (nrow(knots) == 1L) {
return(function(new_p) rep(knots$fitted, length(new_p)))
}
function(new_p) {
stats::approx(knots$score, knots$fitted, xout = new_p, rule = 2,
ties = mean)$y
}
}
#' Tune a decision threshold (the rule of the experiment)
#' @details On an exact 2-decimal grid, the midpoint of the widest run of
#' thresholds that all reach the maximum balanced accuracy.
#' @return The threshold.
tune_threshold <- function(p, y) {
tibble::tibble(t = round(seq(0.01, 0.99, 0.01), 2)) |> # exact grid
dplyr::mutate(
ba = purrr::map_dbl(t, \(x) (mean(p[y == 1] >= x) + mean(p[y == 0] < x)) / 2),
best = abs(ba - max(ba)) < 1e-9,
run = dplyr::consecutive_id(best)
) |>
dplyr::filter(best) |>
dplyr::summarise(start = min(t), end = max(t), n = dplyr::n(), .by = run) |>
dplyr::slice_max(n, n = 1, with_ties = FALSE) |>
dplyr::mutate(mid = round((start + end) / 2, 2)) |>
dplyr::pull(mid)
}The evaluation of all configurations (R/fair_evaluate.R, run by scripts/fair_evaluate.R):
Code
# Evaluation of the fair comparison (no API calls). Needs R/evaluation.R and
# R/calibration_functions.R. Source from the project root.
headline <- c("bal_accuracy", "mcc", "roc_auc")
config_keys <- c("model", "description", "k", "dataset")
#' Read every score file of a folder into one tibble
#' @details Only files that end in _calibration.csv or _test.csv count. A file
#' may or may not have the column elapsed_ms (CLIP files have none).
read_fair_scores <- function(dir) {
list.files(dir, pattern = "_(calibration|test)\\.csv$", full.names = TRUE) |>
purrr::map(readr::read_csv, show_col_types = FALSE) |>
purrr::list_rbind()
}
#' Slope of the Platt fit on logit(p)
#' @details The coefficient of the fit that platt() makes (platt() is not
#' changed). A positive slope keeps the order of the scores; a negative
#' slope reverses it.
platt_slope <- function(p, y) {
unname(stats::coef(environment(platt(p, y))$fit)[["x"]])
}
#' Raw-score metrics on C of every configuration, before any test run
#' @details Every configuration with calibration rows of both classes, with
#' or without a test file: the number of images per class, the AUC and the
#' balanced accuracy at 0.5 of the raw scores, and the Platt slope.
calibration_summary <- function(scores) {
scores |>
dplyr::filter(split == "calibration") |>
dplyr::group_by(dplyr::across(dplyr::all_of(config_keys))) |>
dplyr::filter(dplyr::n_distinct(actual_class) == 2) |>
dplyr::group_modify(\(d, key) {
y <- as.integer(d$actual_class == "defective")
m <- class_metrics(d)
tibble::tibble(n_nominal = sum(y == 0), n_defective = sum(y == 1),
raw_roc_auc = m$roc_auc, raw_bal_accuracy = m$bal_accuracy,
platt_slope = platt_slope(d$prob_defective, y))
}) |>
dplyr::ungroup()
}
#' Add Platt and isotonic probabilities to the scores of each configuration
#' @details Both calibrators are fitted on the calibration rows of the same
#' configuration only. A configuration without test rows, or with one class
#' in its calibration rows, is dropped, and a message names it. Test rows
#' never enter a fit. The column platt_slope holds the slope of the fit.
calibrate_all <- function(scores) {
# The configurations that cannot be calibrated.
dropped <- scores |>
dplyr::summarise(
has_test = any(split == "test"),
n_classes = dplyr::n_distinct(actual_class[split == "calibration"]),
.by = dplyr::all_of(config_keys)
) |>
dplyr::filter(!has_test | n_classes < 2) |>
dplyr::mutate(
label = paste(model, description, paste0("k", k), dataset),
reason = dplyr::if_else(has_test, "one calibration class", "no test rows")
)
if (nrow(dropped) > 0) {
message("calibrate_all drops ", nrow(dropped), " configuration(s): ",
paste0(dropped$label, " (", dropped$reason, ")", collapse = "; "))
}
scores |>
dplyr::group_by(dplyr::across(dplyr::all_of(config_keys))) |>
dplyr::group_modify(\(d, key) {
cal <- dplyr::filter(d, split == "calibration")
y <- as.integer(cal$actual_class == "defective")
if (!any(d$split == "test") || length(unique(y)) < 2) return(d[0, ])
dplyr::mutate(d,
raw = prob_defective,
platt = platt(cal$prob_defective, y)(prob_defective),
isotonic = isotonic(cal$prob_defective, y)(prob_defective),
platt_slope = platt_slope(cal$prob_defective, y)
)
}) |>
dplyr::ungroup()
}
#' Long metrics table: raw, Platt and isotonic, on both splits
#' @details Platt and isotonic rows of the calibration split are in sample.
#' Each row has the Platt slope of its configuration (platt_slope).
metrics_table <- function(calibrated) {
slopes <- dplyr::distinct(calibrated, dplyr::across(dplyr::all_of(c(config_keys, "platt_slope"))))
calibrated |>
tidyr::pivot_longer(c(raw, platt, isotonic), names_to = "calibration",
values_to = "prob") |>
dplyr::group_by(dplyr::across(dplyr::all_of(c(config_keys, "split",
"calibration")))) |>
dplyr::group_modify(\(d, key) {
class_metrics(dplyr::mutate(d, prob_defective = prob))
}) |>
dplyr::ungroup() |>
dplyr::mutate(in_sample = split == "calibration" & calibration != "raw") |>
tidyr::pivot_longer(accuracy:ece, names_to = "metric", values_to = "value") |>
dplyr::left_join(slopes, by = config_keys) |>
dplyr::select(model, description, k, dataset, split, calibration,
in_sample, metric, value, platt_slope)
}
# Platt-calibrated test predictions of one configuration (NA k: any k).
test_side <- function(calibrated, model, description, k = NA, dataset) {
out <- calibrated |>
dplyr::filter(split == "test", .data$model == .env$model,
.data$description == .env$description,
.data$dataset == .env$dataset)
if (!is.na(k)) out <- dplyr::filter(out, .data$k == .env$k)
dplyr::transmute(out, image_path, actual_class, prob_defective = platt)
}
# Both sides on the same images, in the same order.
align_sides <- function(a, b, label = "") {
if (!setequal(a$image_path, b$image_path)) {
stop("The two test files do not hold the same images: ", label, call. = FALSE)
}
b <- dplyr::arrange(b, match(image_path, a$image_path))
stopifnot(identical(a$actual_class, b$actual_class))
list(a = a, b = b)
}
#' Pre-specified comparisons P1 to P3 of one model on every dataset
comparison_plan <- function(model, datasets) {
tidyr::expand_grid(dataset = datasets, comparison = c("P1", "P2", "P3")) |>
dplyr::mutate(
final = dplyr::if_else(dataset == "pan_images", "generic", "final"),
b_model = dplyr::if_else(comparison == "P1", "clip", model),
b_desc = dplyr::case_when(comparison == "P1" ~ "baseline",
comparison == "P2" ~ "generic", .default = final),
b_k = dplyr::case_when(comparison == "P1" ~ NA_real_,
comparison == "P2" ~ 2, .default = 0)
) |>
dplyr::filter(!(comparison == "P2" & dataset == "pan_images"))
}
#' Paired comparisons of one model (difference = decision model minus other)
#' @details A comparison runs only when both sides exist. Holm adjusts the
#' McNemar p-values of the tests that ran; `holm_family_size` counts them.
paired_for_model <- function(calibrated, model, datasets, times = 2000) {
right <- \(d) (d$prob_defective >= 0.5) == (d$actual_class == "defective")
rows <- purrr::pmap(comparison_plan(model, datasets),
\(dataset, comparison, final, b_model, b_desc, b_k) {
a <- test_side(calibrated, model, final, 2, dataset)
b <- test_side(calibrated, b_model, b_desc, b_k, dataset)
if (nrow(a) == 0 || nrow(b) == 0) return(NULL)
s <- align_sides(a, b, paste(model, comparison, dataset))
p <- mcnemar_exact(right(s$a), right(s$b))
purrr::map(headline, \(m) {
dplyr::bind_cols(
tibble::tibble(comparison = comparison, model = model,
dataset = dataset, metric = m),
paired_bootstrap(s$a, s$b, m, times = times),
tibble::tibble(mcnemar_p = p)
)
}) |> purrr::list_rbind()
}) |> purrr::list_rbind()
if (nrow(rows) == 0) return(rows)
tests <- dplyr::distinct(rows, comparison, dataset, mcnemar_p) |>
dplyr::mutate(holm_p = stats::p.adjust(mcnemar_p, "holm"),
holm_family_size = dplyr::n())
dplyr::left_join(rows, tests, by = c("comparison", "dataset", "mcnemar_p"))
}
#' k-curve of one model on one dataset, with differences against k = 0
#' @details Decision models use the final description (pans: generic). CLIP
#' uses the same-reference variant at k 1, 2, 4 and zero-shot as k 0.
curve_for <- function(calibrated, model, dataset, times = 2000) {
desc <- dplyr::if_else(dataset == "pan_images", "generic", "final")
spec <- tibble::tibble(k = c(0, 1, 2, 4)) |>
dplyr::mutate(description = dplyr::case_when(
model != "clip" ~ desc, k == 0 ~ "zero", .default = "refs"))
sides <- purrr::map2(spec$description, spec$k, \(d, k) {
test_side(calibrated, model, d, if (model == "clip" && k == 0) NA else k,
dataset)
})
base <- sides[[1]]
if (nrow(base) == 0) return(NULL)
purrr::map(seq_len(nrow(spec)), \(i) {
if (nrow(sides[[i]]) == 0) return(NULL)
s <- align_sides(sides[[i]], base, paste(model, dataset, "k", spec$k[i]))
purrr::map(headline, \(m) {
diff <- tibble::tibble(difference_vs_k0 = NA_real_, low = NA_real_,
high = NA_real_)
if (spec$k[i] > 0) {
diff <- paired_bootstrap(s$a, s$b, m, times = times) |>
dplyr::rename(difference_vs_k0 = difference)
}
dplyr::bind_cols(
tibble::tibble(model = model, dataset = dataset, k = spec$k[i],
metric = m,
value = dplyr::pull(class_metrics(s$a), dplyr::all_of(m))),
diff)
}) |> purrr::list_rbind()
}) |> purrr::list_rbind()
}
k_curve_table <- function(calibrated, datasets, times = 2000) {
tidyr::expand_grid(model = c("jev", "clef", "clip"), dataset = datasets) |>
purrr::pmap(\(model, dataset) curve_for(calibrated, model, dataset, times)) |>
purrr::list_rbind()
}
#' Time per image, total time and JEV cost of each configuration
#' @details Time per image comes from elapsed_ms (decision models) or from
#' encode_ms + score_ms in clip_timing.csv (CLIP, test split): median,
#' quartiles and the 5th and 95th percentiles. The total time comes from
#' runs.csv. The calls, tokens and cost of JEV come from the TypeSafe call
#' log, and the calls and tokens of Clef-Flash from clef-calls.csv in
#' timing_dir, grouped by the configuration in the purpose
#' ("fair <split> <model> <description> k<k> <dataset>"). cost_sd_usd is the
#' standard deviation of the cost of one call. A column that does not apply
#' is NA. Missing timing files give NA, not an error.
timing_table <- function(scores, timing_dir, record_root) {
keys <- c(config_keys, "split")
read_if <- \(file, ...) {
if (file.exists(file)) readr::read_csv(file, show_col_types = FALSE, ...) else NULL
}
if (!"elapsed_ms" %in% names(scores)) scores$elapsed_ms <- NA_real_
clip <- read_if(file.path(timing_dir, "clip_timing.csv"))
if (is.null(clip)) {
clip <- tibble::tibble(variant = character(), k = double(), dataset = character(),
encode_ms = double(), score_ms = double())
}
per_image <- clip |>
dplyr::transmute(model = "clip", description = variant, k, dataset, split = "test",
elapsed_ms = encode_ms + score_ms) |>
dplyr::bind_rows(dplyr::select(scores, dplyr::all_of(c(keys, "elapsed_ms")))) |>
dplyr::filter(!is.na(elapsed_ms)) |>
dplyr::summarise(
n_images = dplyr::n(),
median_ms = stats::median(elapsed_ms),
q25_ms = stats::quantile(elapsed_ms, 0.25, names = FALSE),
q75_ms = stats::quantile(elapsed_ms, 0.75, names = FALSE),
p05_ms = stats::quantile(elapsed_ms, 0.05, names = FALSE),
p95_ms = stats::quantile(elapsed_ms, 0.95, names = FALSE),
.by = dplyr::all_of(keys)
)
runs <- read_if(file.path(timing_dir, "runs.csv"),
col_types = readr::cols(.default = "c", k = "d", n_images = "d", seconds = "d"))
if (is.null(runs)) {
runs <- tibble::tibble(model = character(), description = character(), k = double(),
dataset = character(), split = character(),
n_images = double(), seconds = double())
}
totals <- runs |>
dplyr::summarise(runs_images = sum(n_images), total_seconds = sum(seconds),
.by = dplyr::all_of(keys))
# Calls, tokens and cost of each configuration in one call log. The check
# calls ("fair check <model> k<k>") do not match the pattern.
log_rows <- function(file, log_model, model) {
calls <- read_if(file, col_types = readr::cols(.default = "c"))
if (is.null(calls)) return(NULL)
pattern <- stringr::str_c("^fair (\\S+) ", model, " (\\S+) k(\\d+) (\\S+)$")
calls |>
dplyr::filter(.data$model == .env$log_model,
stringr::str_detect(.data$purpose, .env$pattern)) |>
dplyr::mutate(
parts = stringr::str_match(.data$purpose, .env$pattern),
model = .env$model, split = parts[, 2], description = parts[, 3],
k = as.numeric(parts[, 4]), dataset = parts[, 5], cost_usd = as.numeric(cost_usd)
) |>
dplyr::summarise(
n_calls = dplyr::n(),
input_tokens = sum(as.numeric(input_tokens), na.rm = TRUE),
output_tokens = sum(as.numeric(output_tokens), na.rm = TRUE),
# Before cost_usd: summarise() gives the later lines the new cost_usd.
cost_sd_usd = if (sum(!is.na(cost_usd)) < 2) NA_real_ else stats::sd(cost_usd, na.rm = TRUE),
cost_usd = if (all(is.na(cost_usd))) NA_real_ else sum(cost_usd, na.rm = TRUE),
.by = dplyr::all_of(keys)
)
}
call_cost <- dplyr::bind_rows(
tibble::tibble(model = character(), description = character(), k = double(),
dataset = character(), split = character(), n_calls = integer(),
input_tokens = double(), output_tokens = double(),
cost_usd = double(), cost_sd_usd = double()),
log_rows(file.path(record_root, "calls", "typesafe-calls.csv"), "jev-1.13.0", "jev"),
log_rows(file.path(timing_dir, "clef-calls.csv"), "Cloudflare/clef-flash", "clef")
)
# Full joins: a configuration with calls but no run row (a failed run) keeps its cost.
per_image |>
dplyr::full_join(totals, by = keys) |>
dplyr::full_join(call_cost, by = keys) |>
dplyr::mutate(n_images = dplyr::coalesce(n_images, runs_images)) |>
dplyr::select(dplyr::all_of(keys), n_images, median_ms, q25_ms, q75_ms, p05_ms, p95_ms,
total_seconds, n_calls, input_tokens, output_tokens, cost_usd, cost_sd_usd) |>
dplyr::arrange(dplyr::across(dplyr::all_of(keys)))
}
#' Run the whole evaluation and write the summaries
#' @details calibration_summary.csv needs no test file: it is the summary of
#' C that the researchers see before the test runs.
run_fair_evaluation <- function(scores_dir, out_dir, times = 2000,
timing_dir = "results/fair/timing",
record_root = Sys.getenv("FAIR_RECORD_ROOT",
unset = "replication_materials")) {
scores <- read_fair_scores(scores_dir)
calibrated <- calibrate_all(scores)
datasets <- sort(unique(calibrated$dataset))
dir.create(out_dir, showWarnings = FALSE, recursive = TRUE)
paired <- purrr::map(c("jev", "clef"), \(m) {
paired_for_model(calibrated, m, datasets, times)
}) |> purrr::list_rbind()
if (nrow(paired) == 0) {
paired <- tibble::tibble(
comparison = character(), model = character(), dataset = character(),
metric = character(), difference = double(), low = double(),
high = double(), mcnemar_p = double(), holm_p = double(),
holm_family_size = integer())
}
out <- list(metrics = metrics_table(calibrated), paired = paired,
k_curve = k_curve_table(calibrated, datasets, times),
timing = timing_table(scores, timing_dir, record_root),
calibration_summary = calibration_summary(scores))
purrr::iwalk(out, \(d, name) {
readr::write_csv(d, file.path(out_dir, paste0(name, ".csv")))
})
invisible(out)
}4 Description loop
For each dataset and model, the loop log keeps every candidate: its texts, its design AUC, the mean score per defect type, the reason that the agent gave and the transcript of the agent. Section 11.2 shows all candidates.
Code
# One row per model and dataset. With no closed loop, the table is empty but
# has the same columns, so the text below shows no number and stops nothing.
loop_summary <- tibble::tibble(
model = character(), dataset = character(), candidates = integer(),
final = integer(), design_generic = double(), design_final = double(),
c_generic = double(), c_final = double(), flagged = integer()
)
if (has_loop) {
# AUC on C of the generic and final descriptions at k = 2 (raw scores,
# which are not in sample). Platt keeps the order only when its slope is
# positive; metrics.csv reports the slope (platt_slope).
auc_on_c <- metrics |>
dplyr::filter(model %in% c("jev", "clef"), split == "calibration",
calibration == "raw", metric == "roc_auc", k == k_main) |>
dplyr::summarise(
c_generic = value[description == "generic"][1],
c_final = value[description == "final"][1],
.by = c(model, dataset)
)
# Audit result of each loop: the number of flagged tool calls.
audit_summary <- audits |>
dplyr::summarise(flagged = sum(tool != "none"), .by = c(model, dataset))
# The final description is the last kept one.
loop_summary <- loops |>
dplyr::summarise(
candidates = dplyr::n(),
final = max(candidate[kept]),
design_generic = auc[candidate == 1],
design_final = auc[candidate == max(candidate[kept])],
.by = c(model, dataset)
) |>
dplyr::left_join(auc_on_c, by = c("model", "dataset")) |>
dplyr::left_join(audit_summary, by = c("model", "dataset"))
}
# Numbers for the text below: the loops that kept a new description, with
# the change from the generic to the final description.
changed <- loop_summary |>
dplyr::filter(final > 1) |>
dplyr::mutate(design_gain = design_final - design_generic, c_gain = c_final - c_generic)
loop_row <- \(m, ds) dplyr::filter(loop_summary, model == m, dataset == ds)Each loop scored 1 to 6 candidates, the generic description included (Table 4). Of the 8 loops, 7 kept a new description, and their design AUC rose by 0.051 to 0.429. On C, which chose nothing, the final description has a higher AUC than the generic one in 6 of these 7 loops. For Clef-Flash on extrusion, it is lower (0.692 against 0.738).
The largest gain is that of Clef-Flash on pipe staple: the AUC rose from 0.569 to 0.997 on the design images, and from 0.476 to 0.976 on C. JEV on pipe staple kept the generic description: its design AUC was already 0.994, so no candidate could pass the margin of 0.02. The audits of the 8 loops flagged 0 tool calls outside the sandbox. The page Description loops shows how the descriptions changed: each candidate against the text that it revised. Section 11.2 gives all candidates in full, with the reason that the agent gave.
Code
# Table T4.
t4 <- loop_summary |>
dplyr::arrange(match(dataset, dataset_order), match(model, names(model_labels))) |>
dplyr::transmute(
Dataset = dataset_labels[dataset],
Model = model_labels[model],
Candidates = candidates,
`Final candidate` = final,
`Design AUC, generic` = design_generic,
`Design AUC, final` = design_final,
`AUC on C, generic` = c_generic,
`AUC on C, final` = c_final,
`Audit: calls outside the sandbox` = flagged
)
save_table(t4, "T4_description_loop", "Description loop: candidates and AUC.",
digits = 3, group = "Dataset")Code
# The current best after each candidate (the AUC of the last kept one).
loop_steps <- loops |>
dplyr::arrange(model, dataset, candidate) |>
dplyr::mutate(best = dplyr::if_else(kept, auc, NA_real_)) |>
dplyr::group_by(model, dataset) |>
tidyr::fill(best, .direction = "down") |>
dplyr::ungroup() |>
dplyr::mutate(model = factor(model_labels[model], names(model_colors)),
dataset = label_dataset(dataset))
loop_final <- loop_summary |>
dplyr::filter(!is.na(c_final)) |>
dplyr::mutate(model = factor(model_labels[model], names(model_colors)),
dataset = label_dataset(dataset))
# Figure F2: one row per model, one column per dataset. Labels: the AUC
# above each candidate and the AUC on C below the diamond, on the other side
# when that place is taken (kept candidates first, then the diamonds, then
# the others).
fig_loop <- function(layout, paper = FALSE, width, height) {
d <- loop_steps
f <- loop_final
if (layout == "one-column") {
levels(d$dataset) <- short_labels[dataset_order]
levels(f$dataset) <- short_labels[dataset_order]
}
labels <- dplyr::bind_rows(
dplyr::transmute(dplyr::filter(d, kept), model, dataset, x = candidate, y = auc,
gap_pt = 2.9, side = "above", other = "below"),
dplyr::transmute(f, model, dataset, x = final, y = c_final,
gap_pt = 3.6, side = "below", other = "above"),
dplyr::transmute(dplyr::filter(d, !kept), model, dataset, x = candidate, y = auc,
gap_pt = 2.9, side = "above", other = "below")
) |>
dplyr::mutate(id = dplyr::row_number(), label = fmt(y),
colour = unname(model_colors[as.character(model)]))
labels <- dplyr::bind_rows(labels, dplyr::mutate(labels, side = other)) |>
dplyr::arrange(id)
plot <- ggplot2::ggplot(d, ggplot2::aes(candidate, auc, colour = model)) +
ggplot2::geom_hline(yintercept = 0.5, colour = "grey70", linewidth = 0.3) +
ggplot2::geom_step(ggplot2::aes(y = best), direction = "hv", linewidth = 0.6) +
ggplot2::geom_point(ggplot2::aes(shape = kept), size = 1.6, stroke = 0.6) +
ggplot2::geom_point(data = f, ggplot2::aes(final, c_final), shape = 23,
fill = "white", size = 2, stroke = 0.7) +
ggplot2::scale_colour_manual(values = model_colors) +
ggplot2::scale_shape_manual(values = c(`TRUE` = 16, `FALSE` = 1)) +
ggplot2::scale_x_continuous(breaks = 1:6) +
ggplot2::scale_y_continuous(breaks = seq(0.5, 1, 0.1)) +
# Room above 1 for the labels.
ggplot2::coord_cartesian(xlim = c(0.7, 6.3), ylim = c(0.45, 1.06)) +
ggplot2::facet_grid(rows = ggplot2::vars(model), cols = ggplot2::vars(dataset)) +
ggplot2::labs(
subtitle = subline(
layout,
"Design AUC of each candidate description in the description loops of ",
paint("JEV", model_colors[["JEV"]]), " and ",
paint("Clef-Flash", model_colors[["Clef-Flash"]]),
". Filled: kept (AUC at least 0.02 above the current best); open: not ",
"kept. The line follows the current best. Diamond: AUC of the final ",
"description on the calibration set C, which chose nothing."
),
x = "Candidate (1 = generic description)", y = "ROC AUC"
) +
theme_paper(layout)
add_labels(plot, labels, layout, width, height)
}
save_figure(fig_loop, "F2_description_loop",
height = c("one-column" = 4.0, "two-column" = 3.99))
5 Main results
Table 5 gives all metrics on the test set for the five methods of the main comparison. All use Platt scaling on C and the decision at 0.5. JEV and Clef-Flash use the final description of their loop at k = 2 (pans: the generic description). On this page, the chart column shows the balanced accuracy of each method on an axis from 0.4 to 1, with a dashed line at the CLIP baseline of the same dataset. The rows of one dataset thus form a dot chart. The glyphs compare each method with the CLIP baseline (★): ▲ at least 0.02 higher, ● within 0.02, ▼ at least 0.02 lower. Point at a glyph or a dot for the values.
Code
# The five methods of the main comparison, with their mark in the chart.
main_methods <- tibble::tribble(
~method, ~model, ~description, ~k, ~mark,
"JEV, k = 2", "jev", "final", 2, "circle",
"Clef-Flash, k = 2", "clef", "final", 2, "circle",
"CLIP baseline", "clip", "baseline", 50, "triangle",
"CLIP, same references, k = 2", "clip", "refs", 2, "diamond",
"CLIP, zero-shot", "clip", "zero", 0, "open"
)
benchmark <- "CLIP baseline"
# The configuration of each method on each dataset. Pans: the decision
# models use the generic description, and the CLIP baseline has k = 10.
# `flag` marks a reversed or undefined Platt fit.
main_configs <- tidyr::expand_grid(main_methods, dataset = dataset_order) |>
dplyr::mutate(
description = dplyr::if_else(model != "clip" & dataset == "pan_images",
"generic", description),
k = dplyr::if_else(description == "baseline" & dataset == "pan_images", 10, k)
) |>
dplyr::left_join(slopes, by = c("model", "description", "k", "dataset")) |>
dplyr::mutate(flag = slope_mark(platt_slope)) |>
dplyr::select(-platt_slope)
# Test metrics of one calibration ("platt", "raw" or "isotonic"), one row per
# configuration and dataset, one column per metric.
test_metrics <- function(cal) {
metrics |>
dplyr::filter(split == "test", calibration == cal) |>
dplyr::select(model, description, k, dataset, metric, value) |>
tidyr::pivot_wider(names_from = metric, values_from = value)
}
# One metric of one configuration (default: test set, after Platt).
metric_value <- function(m, desc, kk, ds, name, cal = "platt", set = "test") {
metrics$value[metrics$model == m & metrics$description == desc & metrics$k == kk &
metrics$dataset == ds & metrics$split == set &
metrics$calibration == cal & metrics$metric == name]
}
main <- main_configs |>
dplyr::inner_join(test_metrics("platt"),
by = c("model", "description", "k", "dataset")) |>
dplyr::arrange(match(dataset, dataset_order), match(method, main_methods$method))
# Numbers for the text below: the balanced accuracy of a decision model or
# of the CLIP baseline, as in the table.
ba_main <- function(m, ds) {
d <- dplyr::filter(main, model == m, dataset == ds,
method %in% c("JEV, k = 2", "Clef-Flash, k = 2", benchmark))
fmt(d$bal_accuracy, 3)
}
# The CLIP baseline on pans: the leave-one-out scores in L (its calibration
# file), the test scores, the score where its Platt fit reaches 0.5, and the
# raw rule of the CLIP paper (score 0.5 or more).
pan_clip <- list.files(scores_dir, "^clip_baseline_k10_pan_images_(calibration|test)\\.csv$",
full.names = TRUE) |>
purrr::map(read_csv_quiet) |>
purrr::list_rbind()
pan_l <- dplyr::filter(pan_clip, split == "calibration")
pan_test <- dplyr::filter(pan_clip, split == "test")
pan_fit <- fair$platt(pan_l$prob_defective, as.integer(pan_l$actual_class == "defective"))
pan_cut <- stats::uniroot(\(p) pan_fit(p) - 0.5, c(0.01, 0.99), tol = 1e-9)$root
median_defective <- \(d) stats::median(d$prob_defective[d$actual_class == "defective"])
pan_platt <- dplyr::filter(main, method == benchmark, dataset == "pan_images")
pan_raw <- dplyr::filter(test_metrics("raw"), model == "clip", description == "baseline",
dataset == "pan_images")On pipe staple and pans, both decision models are well above the CLIP baseline. On pipe staple, JEV has a balanced accuracy of 0.940 and Clef-Flash 0.990, against 0.570. On pans, JEV has 1.000 and Clef-Flash 0.885, against 0.641. On extrusion, the three are close: JEV 0.750, Clef-Flash 0.710 and the CLIP baseline 0.715. On textiles, JEV is close to the CLIP baseline (0.965 against 0.975), and Clef-Flash is lower (0.840). On microstructure, the CLIP baseline is the highest (0.933), with JEV at 0.902 and Clef-Flash at 0.867. Section 6 tells which differences the test images support.
Pans. The CLIP baseline ranks the pans test images almost perfectly (AUC 0.999), but its scores lie in a narrow band around 0.5, from 0.496 to 0.517. Platt scaling, fitted on the leave-one-out scores of the 10 + 10 images in L, puts the cut (the score where the calibrated probability reaches 0.5) at 0.504. The median score of the defective images is 0.513 in L, but only 0.502 in the test set. Thus the cut is too high for most test defectives: after Platt, the CLIP baseline has a sensitivity of 0.282 and a balanced accuracy of 0.641. With the raw rule of the CLIP paper (row “CLIP baseline, paper rule” of Table 16), its balanced accuracy is 0.910. So the pans difference against the CLIP baseline comes from the calibration of CLIP on very few, near-identical images (Section 3.4 says that these scores are optimistic), not from its ranking.
Code
# Table T5 (CSV and LaTeX: values only).
t5 <- main |>
dplyr::transmute(Dataset = dataset_labels[dataset], Method = stringr::str_c(method, flag),
dplyr::across(dplyr::all_of(names(metric_labels)))) |>
dplyr::rename_with(\(x) unname(metric_labels[x]), dplyr::all_of(names(metric_labels)))
# Interactive view, part 1: glyphs. Each method against the CLIP baseline on
# the same dataset (balanced accuracy as shown, margin 0.02).
glyph <- function(diff, tip) {
up <- diff >= 0.02 - 1e-9
down <- diff <= -0.02 + 1e-9
color <- dplyr::case_when(up ~ "#1B7837", down ~ "#B2182B", .default = "#555555")
symbol <- dplyr::case_when(up ~ "▲", down ~ "▼", .default = "●")
as.character(stringr::str_glue("<span style='color:{color}' title='{tip}'>{symbol}</span>"))
}
# Interactive view, part 2: the chart cell of one row. Inline SVG with no
# script, so it works offline. Axis 0.4 to 1; grid at 0.5, 0.75 and 1.
svg_mark <- function(mark, cx, cy, color) {
switch(mark,
triangle = stringr::str_glue("<path d='M{cx},{cy - 5.5} l5.5,9.5 l-11,0 z' fill='{color}'/>"),
diamond = stringr::str_glue("<path d='M{cx},{cy - 5.5} l5.5,5.5 l-5.5,5.5 l-5.5,-5.5 z' fill='{color}'/>"),
open = stringr::str_glue("<circle cx='{cx}' cy='{cy}' r='4.3' fill='white' stroke='{color}' stroke-width='1.8'/>"),
stringr::str_glue("<circle cx='{cx}' cy='{cy}' r='4.8' fill='{color}'/>")
)
}
clip_color <- model_colors[["CLIP"]]
chart_cell <- function(ba, base, mark, color, tip) {
x <- \(v) round(6 + (pmin(pmax(v, 0.4), 1) - 0.4) / 0.6 * 148, 1)
ticks <- x(c(0.5, 0.75, 1))
grid <- stringr::str_c(
stringr::str_glue("<line x1='{ticks}' x2='{ticks}' y1='0' y2='20' stroke='#E5E5E5'/>"),
collapse = ""
)
base_line <- stringr::str_glue(
"<line x1='{x(base)}' x2='{x(base)}' y1='0' y2='20' stroke='{clip_color}' stroke-dasharray='3,2'/>"
)
as.character(stringr::str_glue(
"<svg xmlns='http://www.w3.org/2000/svg' width='160' height='20' role='img' ",
"aria-label='{tip}'><title>{tip}</title>{grid}{base_line}",
"{svg_mark(mark, x(ba), 10, color)}</svg>"
))
}
# The display version of T5: chart and glyphs for balanced accuracy, method
# names in the darker text color of their model.
t5_display <- main |>
dplyr::mutate(
base_ba = bal_accuracy[method == benchmark],
base_mcc = mcc[method == benchmark],
.by = dataset
) |>
dplyr::mutate(
ba_diff = round_half_up(bal_accuracy, 3) - round_half_up(base_ba, 3),
color = unname(model_colors[model_labels[model]]),
tip = stringr::str_glue(
"{method}: BA {fmt(bal_accuracy, 3)}, MCC {fmt(mcc, 3)}; ",
"{signed(ba_diff, 3)} BA and ",
"{signed(mcc - base_mcc, 3)} MCC against the CLIP baseline"
),
chart = purrr::pmap_chr(list(bal_accuracy, base_ba, mark, color, tip), chart_cell),
ba_cell = dplyr::if_else(
method == benchmark,
as.character(stringr::str_glue(
"<span title='The CLIP baseline: the benchmark'>★</span> <b>{fmt(bal_accuracy, 3)}</b>"
)),
stringr::str_c(glyph(ba_diff, tip),
" ", fmt(bal_accuracy, 3))
),
Method = paint_html(stringr::str_c(method, flag),
unname(model_text_colors[model_labels[model]]))
) |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Method,
`Chart: balanced accuracy, 0.4 to 1` = chart,
`Balanced accuracy` = ba_cell,
dplyr::across(dplyr::all_of(setdiff(names(metric_labels), "bal_accuracy")))
) |>
dplyr::rename_with(\(x) unname(metric_labels[x]),
dplyr::all_of(setdiff(names(metric_labels), "bal_accuracy")))
save_table(t5, "T5_main_results",
stringr::str_c("Main results on the test sets: all metrics, after Platt scaling on C.",
mark_caption(main_configs$flag)),
digits = 3, display = t5_display, page_length = 25, group = "Dataset")6 Paired comparisons
The paired comparisons P1 to P3 (Section 3.9) use the Platt probabilities and the decision at 0.5 on the same test images. Each figure shows the difference (decision model minus the other side) and its paired 95% bootstrap interval. An interval that does not cross 0 shows a difference that the test images support. The table at the end of this section adds the McNemar p-values, before and after the Holm adjustment.
Code
# Numbers for the text below: the difference in balanced accuracy of one
# comparison with its 95% interval, and its McNemar p-values, as in the
# table. A p-value below 0.001 shows as "< 0.001", not as 0.000.
fmt_p <- function(p) dplyr::if_else(p < 0.001, "< 0.001", fmt(p, 3))
ba_row <- function(id, m, ds) {
dplyr::filter(paired, comparison == id, model == m, dataset == ds,
metric == "bal_accuracy")
}
diff_text <- function(id, m, ds) {
r <- ba_row(id, m, ds)
stringr::str_glue("{signed(r$difference, 3)} ({fmt(r$low, 3)} to {fmt(r$high, 3)})")
}
holm_text <- function(id, m, ds) {
p <- ba_row(id, m, ds)$holm_p
stringr::str_c("Holm p ", dplyr::if_else(p < 0.001, "", "= "), fmt_p(p))
}
# The largest Holm p-value of some rows of one comparison (pairs of model
# and dataset).
max_holm <- function(id, m, ds) {
d <- dplyr::filter(paired, comparison == id, metric == "bal_accuracy",
stringr::str_c(model, ":", dataset) %in% stringr::str_c(m, ":", ds))
fmt_p(max(d$holm_p))
}Code
# Forest figure of one comparison: one row per dataset, one panel per
# headline metric, one point and interval per decision model.
headline_metrics <- c("bal_accuracy", "mcc", "roc_auc")
# The paper reports accuracy and AUC. On the balanced test sets, accuracy
# equals balanced accuracy, also in each bootstrap sample (the bootstrap
# resamples within class), so the paper uses these rows as accuracy.
paper_metric_labels <- c(bal_accuracy = "Accuracy", roc_auc = metric_labels[["roc_auc"]])
forest_data <- function(id, labels = metric_labels[headline_metrics]) {
d <- paired |>
dplyr::filter(comparison == id, metric %in% names(labels)) |>
dplyr::mutate(
model = factor(model_labels[model], names(model_colors)),
metric = factor(labels[metric], labels)
)
present <- intersect(dataset_order, d$dataset)
# Datasets top to bottom; JEV just above Clef-Flash in each row.
dplyr::mutate(d, y = match(dataset, present) +
dplyr::if_else(model == "JEV", -0.12, 0.12))
}
# Labels of a forest figure, small and in the model color: the difference
# over its point and the 2.5% and 97.5% bounds over the ends of the
# interval; above the JEV row, below the Clef-Flash row. A bound that does
# not fit over its end goes beside the difference.
forest_labels <- function(d, size) {
width_pt <- \(s) systemfonts::string_width(s, family = body_font, size = size, res = 7200) / 100
rows <- dplyr::mutate(
d, n = dplyr::row_number(), colour = unname(model_colors[as.character(model)]),
v = dplyr::if_else(model == "JEV", "above", "below"),
beside = width_pt(fmt(difference)) / 2 + 2 # half the difference label, and 2 pt
)
candidate <- function(part, rank, label, x, side, dx = 0) {
dplyr::mutate(rows, id = 3 * n + part, rank = rank, label = .env$label, x = .env$x,
side = .env$side, dx_pt = .env$dx)
}
dplyr::bind_rows(
candidate(0, 1, fmt(rows$difference), rows$difference, rows$v),
candidate(1, 1, fmt(rows$low), rows$low, rows$v),
candidate(1, 2, fmt(rows$low), rows$low, stringr::str_c(rows$v, "-left")),
candidate(1, 3, fmt(rows$low), rows$difference, stringr::str_c(rows$v, "-left"), -rows$beside),
candidate(2, 1, fmt(rows$high), rows$high, rows$v),
candidate(2, 2, fmt(rows$high), rows$high, stringr::str_c(rows$v, "-right")),
candidate(2, 3, fmt(rows$high), rows$difference, stringr::str_c(rows$v, "-right"), rows$beside)
) |>
dplyr::arrange(id, rank) |>
dplyr::mutate(gap_pt = 3.1) # just over the point (radius 3.0 pt)
}
# The panels stand side by side, except the three panels of the one-column
# size of this document (one above the other).
fig_forest <- function(id, text) {
function(layout, paper = FALSE, width, height) {
d <- forest_data(id, if (paper) paper_metric_labels else metric_labels[headline_metrics])
present <- intersect(dataset_order, d$dataset)
labels <- if (layout == "one-column") short_labels[present] else dataset_labels[present]
plot <- ggplot2::ggplot(d, ggplot2::aes(difference, y, colour = model)) +
ggplot2::geom_vline(xintercept = 0, colour = "grey55", linewidth = 0.3) +
ggplot2::geom_linerange(ggplot2::aes(xmin = low, xmax = high), linewidth = 0.6) +
ggplot2::geom_point(size = 1.8) +
ggplot2::scale_colour_manual(values = model_colors) +
# Room at both ends for a bound beside its difference label.
ggplot2::scale_x_continuous(
expand = ggplot2::expansion(mult = if (layout == "one-column") 0.25 else 0.15)
) +
# Room for the labels above the first row and below the last one.
ggplot2::scale_y_continuous(breaks = seq_along(present), labels = labels,
transform = "reverse",
expand = ggplot2::expansion(add = 0.45)) +
ggplot2::facet_wrap(ggplot2::vars(metric), scales = "free_x",
ncol = if (layout == "one-column" && !paper) 1 else nlevels(d$metric)) +
ggplot2::labs(
subtitle = subline(
layout,
"Difference and paired 95% bootstrap interval for ",
paint("JEV", model_colors[["JEV"]]), " and ",
paint("Clef-Flash", model_colors[["Clef-Flash"]]),
" on the test images. ", text
),
x = "Difference", y = NULL
) +
theme_paper(layout) +
# Free x scales: space so that the end ticks of two panels stay apart.
ggplot2::theme(panel.spacing.x = ggplot2::unit(14, "pt"))
add_labels(plot, forest_labels(d, label_size[[layout]]), layout, width, height)
}
}
forest_heights <- c("one-column" = 8.0, "two-column" = 3.3)
# Paper versions: two panels (accuracy, AUC).
forest_paper_heights <- c("one-column" = 3.6, "two-column" = 3.3)6.1 P1: against the CLIP baseline
Both decision models are higher than the CLIP baseline on pipe staple and on pans. On pipe staple, the difference in balanced accuracy is +0.370 (0.280 to 0.470) for JEV (Holm p < 0.001) and +0.420 (0.340 to 0.500) for Clef-Flash (Holm p < 0.001). On pans, it is +0.359 (0.282 to 0.423) for JEV (Holm p < 0.001) and +0.244 (0.167 to 0.321) for Clef-Flash (Holm p < 0.001). Clef-Flash is lower than the CLIP baseline on textiles and on microstructure: -0.135 (-0.190 to -0.080) and -0.067 (-0.098 to -0.036), with Holm p < 0.001 and Holm p < 0.001. On extrusion, both intervals include 0, and so does the JEV interval on textiles. The pans differences come from the calibration of CLIP, not from its ranking (see Pans in Section 5).
On microstructure, the JEV difference is -0.031 (-0.058 to -0.004). Its interval excludes 0, but the McNemar test is not significant after the Holm adjustment (Holm p = 0.168). The unadjusted McNemar p-value is 0.034: the interval is not adjusted for the 14 McNemar tests of each model, but the Holm p-value is.
Code
# Figure F3.
save_figure(
fig_forest("P1",
"Decision model (k = 2 references per class; final description, pans: generic) minus the CLIP baseline (k = 50; pans: k = 10); both use Platt scaling on the calibration set C."),
"F3_paired_P1", height = forest_heights,
# The subtitle names the k of both sides: 5 lines in one column.
paper_height = c("one-column" = 4.1, "two-column" = 3.3)
)
6.2 P2: final against generic description
The final description raises JEV on extrusion by +0.130 (0.070 to 0.190), on textiles by +0.145 (0.090 to 0.205) and on microstructure by +0.147 (0.107 to 0.187). It raises Clef-Flash on pipe staple by +0.530 (0.430 to 0.620) and on microstructure by +0.064 (0.033 to 0.096). These five gains survive the Holm adjustment (largest Holm p-value: 0.002). For Clef-Flash on textiles, the gain is +0.085 (0.005 to 0.165): its interval excludes 0, but the gain does not survive the Holm adjustment (Holm p = 0.284). On extrusion, the Clef-Flash interval includes 0. On pipe staple, the generic side of Clef-Flash has a negative Platt slope (-1.05; † in Table 6), so Platt reverses its raw scores.
For JEV on pipe staple, the final description is the generic text (decision D85), so P2 compares two runs of the same prompts. This row thus measures the run-to-run variation of JEV (decision D88): 0.000 (-0.030 to 0.030). The two runs gave slightly different probabilities. On the test set, the final run has a sensitivity of 0.920 and a specificity of 0.960, and the generic run 0.940 and 0.940.
Code
# Figure F4.
save_figure(
fig_forest("P2",
"Final minus generic description, both at k = 2 references per class. Pans have no description loop and thus no row."),
"F4_paired_P2", height = forest_heights, paper_height = forest_paper_heights
)
6.3 P3: two references against none
Two references per class raise the balanced accuracy of JEV on four datasets: extrusion by +0.090 (0.040 to 0.145), textiles by +0.090 (0.050 to 0.135), pipe staple by +0.210 (0.110 to 0.310) and pans by +0.231 (0.154 to 0.308). All four gains survive the Holm adjustment (largest Holm p-value: 0.018). Clef-Flash gains on textiles (Holm p < 0.001) and on pans (Holm p = 0.016). Its gain on extrusion, +0.070 (0.015 to 0.130), has an interval that excludes 0, but it does not survive the Holm adjustment (Holm p = 0.173); its gain on pipe staple, +0.040 (0.000 to 0.090), has an interval that reaches 0. Microstructure gains little: +0.013 (-0.009 to 0.036) for JEV and +0.013 (-0.009 to 0.036) for Clef-Flash, with intervals that include 0.
The k = 0 side of JEV on pipe staple has a negative Platt slope (-9.07; decision D82). Its raw scores run backwards (raw test AUC 0.191), and Platt reverses them. Its calibrated result thus comes from the calibration labels, not from the raw ranking. On pans and pipe staple, the size of P3 depends on the calibration method (Section 11.1).
Code
# Figure F5.
save_figure(
fig_forest("P3",
"Two references per class (k = 2) minus none (k = 0), both with the final description (pans: generic)."),
"F5_paired_P3", height = forest_heights, paper_height = forest_paper_heights
)
6.4 Figure of the three comparisons
Figure 6 shows the difference in accuracy of P1, P2 and P3 in one figure. It uses the word of the paper, accuracy: on the balanced test sets, accuracy and balanced accuracy are equal. The figure leaves out MCC and AUC to show fewer marks; Table 6 gives all three metrics.
Code
# Figure F8: one panel per comparison, accuracy only (equal to balanced
# accuracy on the balanced test sets), in this document and in the paper.
# All panels share the x scale, so that the sizes of the differences compare
# across the comparisons. The panels stand side by side, and one above the
# other in the one-column sizes. The panel titles tell the two sides of
# each comparison, after the letter of the panel, (a) to (c); the subtitle
# only names the colors.
comparison_labels <- c(
P1 = "(a) P1: decision model (k = 2) minus\nCLIP baseline (k = 50; pans: k = 10)\n(final description; pans: generic)",
P2 = "(b) P2: final minus generic description\n(both at k = 2; no pans)",
P3 = "(c) P3: k = 2 minus k = 0\nreferences per class\n(final description; pans: generic)"
)
# `paper` is not used: both versions show the same figure.
fig_paired_all <- function(layout, paper = FALSE, width, height) {
d <- paired |>
dplyr::filter(comparison %in% names(comparison_labels), metric == "bal_accuracy") |>
dplyr::mutate(
model = factor(model_labels[model], names(model_colors)),
comparison = factor(comparison_labels[comparison], comparison_labels)
)
present <- intersect(dataset_order, d$dataset)
# Datasets top to bottom; JEV just above Clef-Flash in each row.
d <- dplyr::mutate(d, y = match(dataset, present) +
dplyr::if_else(model == "JEV", -0.12, 0.12))
labels <- if (layout == "one-column") short_labels[present] else dataset_labels[present]
plot <- ggplot2::ggplot(d, ggplot2::aes(difference, y, colour = model)) +
ggplot2::geom_vline(xintercept = 0, colour = "grey55", linewidth = 0.3) +
ggplot2::geom_linerange(ggplot2::aes(xmin = low, xmax = high), linewidth = 0.6) +
ggplot2::geom_point(size = 1.8) +
ggplot2::scale_colour_manual(values = model_colors) +
# Room at both ends for a bound beside its difference label.
ggplot2::scale_x_continuous(
expand = ggplot2::expansion(mult = if (layout == "one-column") 0.12 else 0.08)
) +
# Room for the labels above the first row and below the last one.
ggplot2::scale_y_continuous(breaks = seq_along(present), labels = labels,
transform = "reverse",
expand = ggplot2::expansion(add = 0.45)) +
ggplot2::facet_wrap(ggplot2::vars(comparison),
ncol = if (layout == "one-column") 1 else 3,
axes = "all_x", axis.labels = "margins") +
ggplot2::labs(
subtitle = subline(
layout,
"Difference and paired 95% bootstrap interval for ",
paint("JEV", model_colors[["JEV"]]), " and ",
paint("Clef-Flash", model_colors[["Clef-Flash"]]), "."
),
x = "Difference in accuracy", y = NULL
) +
theme_paper(layout) +
ggplot2::theme(panel.spacing.x = ggplot2::unit(10, "pt"))
add_labels(plot, forest_labels(d, label_size[[layout]]), layout, width, height)
}
paired_all_heights <- c("one-column" = 7.5, "two-column" = 3.3)
save_figure(fig_paired_all, "F8_paired_P1_P2_P3", height = paired_all_heights)
6.5 Table of the comparisons
Code
# The mark of each comparison: the mark of a side whose Platt fit reverses
# the raw order or is not defined. The sides come from the plan of
# R/fair_evaluate.R; the CLIP baseline of P1 has one k per dataset.
plan <- c("jev", "clef") |>
purrr::map(\(m) dplyr::mutate(fair$comparison_plan(m, dataset_order), model = m)) |>
purrr::list_rbind()
side_a <- plan |>
dplyr::inner_join(dplyr::filter(slopes, k == k_main),
by = c("model", final = "description", "dataset"))
side_b <- plan |>
dplyr::inner_join(dplyr::rename(slopes, b_model = model, b_desc = description),
by = c("b_model", "b_desc", "dataset"), relationship = "many-to-many") |>
dplyr::filter(is.na(b_k) | k == b_k)
comparison_flags <- dplyr::bind_rows(side_a, side_b) |>
dplyr::summarise(flag = stringr::str_c(unique(slope_mark(platt_slope)), collapse = ""),
.by = c(comparison, model, dataset))
# The meaning of the marks, for the caption of the table.
paired_marks <- ""
if (any(comparison_flags$flag != "")) {
paired_marks <- stringr::str_c(" A mark on a comparison applies to one of its two sides.",
mark_caption(comparison_flags$flag))
}Code
# Table T6: one row per comparison, model and dataset.
t6 <- paired |>
dplyr::left_join(comparison_flags, by = c("comparison", "model", "dataset")) |>
dplyr::mutate(cell = stringr::str_glue("{signed(difference, 3)} ({fmt(low, 3)} to {fmt(high, 3)})")) |>
dplyr::select(comparison, flag, model, dataset, metric, cell, mcnemar_p, holm_p,
holm_family_size) |>
tidyr::pivot_wider(names_from = metric, values_from = cell) |>
dplyr::arrange(match(dataset, dataset_order), comparison,
match(model, names(model_labels))) |>
dplyr::transmute(
Dataset = dataset_labels[dataset],
Comparison = stringr::str_c(comparison, dplyr::coalesce(flag, "")),
Model = model_labels[model],
`Balanced accuracy` = as.character(bal_accuracy), MCC = as.character(mcc),
AUC = as.character(roc_auc),
`McNemar p` = fmt_p(mcnemar_p), `Holm p` = fmt_p(holm_p),
`Holm tests` = holm_family_size
)
save_table(t6, "T6_paired_comparisons",
stringr::str_c("Paired comparisons on the test sets.", paired_marks),
digits = 3, page_length = 30, group = "Dataset")7 Reference curve
Figure 7 shows the test balanced accuracy and AUC against the number of references per class, k = 0, 1, 2 and 4. The decision models use the final description (pans: generic) at every k, so only the references change. For CLIP, k = 0 is zero-shot, and k > 0 uses the same references as the decision models. All values use Platt scaling on C. The bars give the paired 95% interval of the change from k = 0, placed at the value: a bar that does not reach the value at k = 0 shows a change that the test images support. A bar stops at 0 and 1, the limits of both metrics.
Code
# Numbers for the text below: the balanced accuracy of one model at one k,
# and the change from k = 2 to k = 4.
curve_ba <- function(m, ds, kk) {
k_curve$value[k_curve$model == m & k_curve$dataset == ds & k_curve$k == kk &
k_curve$metric == "bal_accuracy"]
}
change_2_to_4 <- k_curve |>
dplyr::filter(metric == "bal_accuracy", k %in% c(2, 4)) |>
dplyr::summarise(change = value[k == 4] - value[k == 2], .by = c(model, dataset))
max_change <- function(m, datasets = dataset_order) {
fmt(max(abs(change_2_to_4$change[change_2_to_4$model == m &
change_2_to_4$dataset %in% datasets])), 3)
}
# The k = 0 points whose Platt fit has a negative slope (decision D82): the
# decision models with the description of the curve, and CLIP zero-shot.
reversed_k0 <- k_curve |>
dplyr::filter(k == 0, metric == "bal_accuracy") |>
dplyr::mutate(description = dplyr::case_when(model == "clip" ~ "zero",
dataset == "pan_images" ~ "generic",
.default = "final")) |>
dplyr::inner_join(slopes, by = c("model", "description", "k", "dataset")) |>
dplyr::filter(platt_slope < 0) |>
dplyr::arrange(match(model, names(model_labels)), match(dataset, dataset_order)) |>
dplyr::mutate(label = stringr::str_c(
dplyr::if_else(model == "clip", "CLIP zero-shot", model_labels[model]), " on ",
stringr::str_to_lower(dataset_labels[dataset])
))
reversed_k0_text <- as.character(knitr::combine_words(reversed_k0$label, oxford_comma = FALSE))
reversed_k0_caption <- ""
if (nrow(reversed_k0) > 0) {
reversed_k0_caption <- stringr::str_c(
" At k = 0, the Platt fit has a negative slope and reverses the raw scores ",
"(decision D82) for ", reversed_k0_text, "."
)
}The decision models get most of their gain from the first references. From k = 2 to k = 4, the balanced accuracy of JEV changes by 0.016 or less; the largest change is on microstructure, from 0.902 to 0.918. On extrusion, textiles, pipe staple and pans, most of the JEV gain comes at k = 1: from k = 0 to k = 1, JEV gains 0.180 on pipe staple and 0.218 on pans. From k = 2 to k = 4, Clef-Flash changes by 0.030 or less, except on pans, where it drops from 0.885 to 0.808. CLIP with the same references gains more slowly: on textiles, it has 0.685 at k = 2 and 0.880 at k = 4. At k = 0, the Platt fit reverses the raw scores (negative slope; decision D82) for JEV on pipe staple, CLIP zero-shot on textiles and CLIP zero-shot on microstructure.
Code
# Values and intervals; the interval of the change from k = 0 is moved to the
# value at k (value at k = 0 plus the bounds) and cut at 0 and 1, the limits
# of balanced accuracy and AUC. Models side by side at each k.
curve <- k_curve |>
dplyr::filter(metric %in% c("bal_accuracy", "roc_auc")) |>
dplyr::mutate(k0 = value[k == 0], .by = c(model, dataset, metric)) |>
dplyr::mutate(
low_value = pmax(k0 + low, 0), high_value = pmin(k0 + high, 1),
x = k + unname(c(jev = -0.12, clef = 0, clip = 0.12)[model]),
model = factor(model_labels[model], names(model_colors)),
metric = factor(metric_labels[metric], metric_labels[c("bal_accuracy", "roc_auc")]),
dataset = label_dataset(dataset)
)
curve_models <- intersect(names(model_colors), as.character(curve$model))
# Figure F6: metrics by dataset (two-column) or datasets by metric
# (one-column). Labels: the value of each point, as in F3 to F5 above JEV
# (over its bar) and below Clef-Flash and CLIP (under their bars); k = 2
# first, then k = 4, 1 and 0.
fig_curve <- function(layout, paper = FALSE, width, height) {
d <- curve
if (paper) {
levels(d$metric)[levels(d$metric) == metric_labels[["bal_accuracy"]]] <- "Accuracy"
}
if (layout == "one-column") {
levels(d$dataset) <- short_labels[dataset_order]
facets <- ggplot2::facet_grid(rows = ggplot2::vars(dataset), cols = ggplot2::vars(metric))
} else {
facets <- ggplot2::facet_grid(rows = ggplot2::vars(metric), cols = ggplot2::vars(dataset))
}
labels <- d |>
dplyr::mutate(
label = fmt(value), colour = unname(model_colors[as.character(model)]),
side = dplyr::if_else(model == "JEV", "above", "below"),
y = dplyr::if_else(model == "JEV", dplyr::coalesce(high_value, value),
dplyr::coalesce(low_value, value))
) |>
dplyr::arrange(match(k, c(2, 4, 1, 0)), model) |>
dplyr::mutate(id = dplyr::row_number(), gap_pt = 2.5) # point radius 2.5 pt
model_text <- purrr::map_chr(curve_models, \(m) paint(m, model_colors[[m]]))
plot <- ggplot2::ggplot(d, ggplot2::aes(x, value, colour = model)) +
ggplot2::geom_hline(yintercept = 0.5, colour = "grey70", linewidth = 0.3) +
ggplot2::geom_line(linewidth = 0.5) +
ggplot2::geom_linerange(ggplot2::aes(ymin = low_value, ymax = high_value),
linewidth = 0.5, na.rm = TRUE) +
ggplot2::geom_point(size = 1.4) +
ggplot2::scale_colour_manual(values = model_colors) +
ggplot2::scale_x_continuous(breaks = c(0, 1, 2, 4)) +
ggplot2::scale_y_continuous(breaks = seq(0.4, 1, 0.2)) +
# Room above 1 for the labels.
ggplot2::coord_cartesian(ylim = c(0.3, 1.07)) +
facets +
ggplot2::labs(
subtitle = subline(
layout,
"Test results of ", stringr::str_c(model_text, collapse = ", "),
" by references per class (k), after Platt scaling ",
"on the calibration set C. CLIP at k = 0 is zero-shot. Bars: paired ",
"95% interval of the change from k = 0, placed at the value and cut at 0 and 1."
),
x = "References per class (k)", y = NULL
) +
theme_paper(layout)
add_labels(plot, labels, layout, width, height)
}
save_figure(fig_curve, "F6_reference_curve",
height = c("one-column" = 6.06, "two-column" = 3.58))
8 Calibration
Raw scores are not probabilities that a quality engineer can trust. Table 7 gives the ECE, the Brier score and the log loss on the test set before (raw) and after Platt scaling on C. Figure 8 shows the reliability diagrams of the decision models and of the CLIP baseline. The raw CLIP scores are the softmax of two cosine similarities, which differ little, so they stay near 0.5.
Code
# Raw and Platt metrics of the main methods.
calibration_rows <- c("raw", "platt") |>
purrr::map(\(cal) dplyr::mutate(test_metrics(cal), calibration = cal)) |>
purrr::list_rbind() |>
dplyr::inner_join(main_configs, by = c("model", "description", "k", "dataset")) |>
dplyr::select(method, flag, dataset, calibration, ece, brier_class, mn_log_loss) |>
tidyr::pivot_wider(names_from = calibration,
values_from = c(ece, brier_class, mn_log_loss)) |>
dplyr::arrange(match(dataset, dataset_order), match(method, main_methods$method))
# Numbers for the text below: the test ECE of the two decision models and
# the CLIP baseline, the methods of the reliability diagrams.
reliability_methods <- c("JEV, k = 2", "Clef-Flash, k = 2", "CLIP baseline")
ece_rows <- calibration_rows |>
dplyr::filter(method %in% reliability_methods) |>
dplyr::mutate(drop = ece_raw - ece_platt)
ece_of <- function(meth, ds, cal) {
fmt(ece_rows[[stringr::str_c("ece_", cal)]][ece_rows$method == meth & ece_rows$dataset == ds], 3)
}
pan_ece <- ece_rows$ece_platt[ece_rows$dataset == "pan_images"]
other_ece <- ece_rows$ece_platt[ece_rows$dataset != "pan_images"]Platt scaling lowers the test ECE most where the raw scores are far from calibrated. The largest drop is that of the CLIP baseline on textiles, from 0.473 to 0.080. Outside pans, the ECE after Platt is 0.059 to 0.180 for the two decision models and the CLIP baseline. Platt does not lower the ECE everywhere: it raises it in 5 of the 15 cases, for both decision models on extrusion and pans, and for the CLIP baseline on pipe staple. Pans have the highest ECE after Platt, 0.205 to 0.290. The test ECE uses 10 equal bins, so with 78 pan images it is noisy.
Code
# Table T7.
t7 <- calibration_rows |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Method = stringr::str_c(method, flag),
`ECE raw` = ece_raw, `ECE Platt` = ece_platt,
`Brier raw` = brier_class_raw, `Brier Platt` = brier_class_platt,
`Log loss raw` = mn_log_loss_raw, `Log loss Platt` = mn_log_loss_platt
)
save_table(t7, "T7_calibration",
stringr::str_c("Calibration on the test sets.", mark_caption(calibration_rows$flag)),
digits = 3, page_length = 25, group = "Dataset")
# The reliability figure below has one panel per method and dataset, for
# the two decision models and the CLIP baseline (reliability_methods). Its
# height follows the number of panels (five per row; three in the
# one-column size).
n_panels <- sum(calibration_rows$method %in% reliability_methods)
reliability_heights <- c(
"one-column" = 1.15 + 1.5 * ceiling(n_panels / 3),
"two-column" = 1.0 + 1.75 * ceiling(n_panels / 5)
)Code
# Calibrated probabilities of every image, from the score files (the same
# fits as scripts/fair_evaluate.R).
calibrated <- list.files(scores_dir, pattern = "^(jev|clef|clip)_.+_(calibration|test)\\.csv$",
full.names = TRUE) |>
purrr::map(read_csv_quiet) |>
purrr::list_rbind() |>
fair$calibrate_all()
# Test probabilities of the two decision models and the CLIP baseline, in
# 10 equal bins.
reliability <- main_configs |>
dplyr::filter(method %in% reliability_methods) |>
dplyr::inner_join(dplyr::filter(calibrated, split == "test"),
by = c("model", "description", "k", "dataset")) |>
tidyr::pivot_longer(c(raw, platt), names_to = "calibration", values_to = "p") |>
dplyr::mutate(bin = cut(p, seq(0, 1, 0.1), include.lowest = TRUE),
y = as.integer(actual_class == "defective")) |>
dplyr::summarise(mean_p = mean(p), observed = mean(y), n = dplyr::n(),
.by = c(method, dataset, calibration, bin)) |>
dplyr::arrange(method, dataset, calibration, mean_p) |>
dplyr::mutate(calibration = factor(dplyr::if_else(calibration == "platt", "Platt", "raw"),
names(calibration_colors)))
# Strip of each panel: dataset, method, and the test ECE before and after
# Platt in their colors. Panels go by method, then by dataset.
strip_text <- function(layout) {
labels <- if (layout == "one-column") {
stringr::str_replace(short_labels, "\n", "<br>")
} else {
dataset_labels
}
calibration_rows |>
dplyr::filter(method %in% reliability_methods) |>
dplyr::arrange(match(method, reliability_methods), match(dataset, dataset_order)) |>
dplyr::transmute(
method, dataset,
strip = stringr::str_c(
"**", labels[dataset], "**<br>", method, "<br>ECE ",
paint(fmt(ece_raw), calibration_colors[["raw"]]), " to ",
paint(fmt(ece_platt), calibration_colors[["Platt"]])
),
strip = factor(strip, strip)
)
}
# Figure F7: five panels per row (two-column) or three (one-column).
# Labels: the observed defect rate of each bin, above the Platt points and
# below the raw ones (Platt first).
fig_reliability <- function(layout, paper = FALSE, width, height) {
d <- dplyr::inner_join(reliability, strip_text(layout), by = c("method", "dataset"))
labels <- d |>
dplyr::arrange(calibration != "Platt") |>
dplyr::transmute(strip, x = mean_p, y = observed, label = fmt(observed),
colour = unname(calibration_colors[as.character(calibration)]),
side = dplyr::if_else(calibration == "Platt", "above", "below"),
id = dplyr::row_number(), gap_pt = 1.8) # point radius 1.75 pt
plot <- ggplot2::ggplot(d, ggplot2::aes(mean_p, observed, colour = calibration)) +
ggplot2::geom_abline(slope = 1, intercept = 0, colour = "grey70", linewidth = 0.3) +
ggplot2::geom_line(linewidth = 0.55) +
ggplot2::geom_point(size = 0.9) +
ggplot2::scale_colour_manual(values = calibration_colors) +
ggplot2::scale_x_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1)) +
ggplot2::scale_y_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1)) +
ggplot2::facet_wrap(ggplot2::vars(strip), ncol = if (layout == "one-column") 3 else 5) +
ggplot2::labs(
subtitle = subline(
layout,
paint("Raw", calibration_colors[["raw"]]), " scores and ",
paint("Platt", calibration_colors[["Platt"]]),
" probabilities on the test images (Platt fitted on the calibration ",
"set C). Calibrated curves follow the diagonal. Strips give the test ",
"ECE before and after Platt scaling."
),
x = "Mean predicted defect probability (10 bins)",
y = "Observed defect rate"
) +
theme_paper(layout) +
ggplot2::theme(strip.text = ggtext::element_markdown(face = "plain", lineheight = 1.2))
add_labels(plot, labels, layout, width, height)
}
save_figure(fig_reliability, "F7_reliability", height = reliability_heights)
Figure 9 shows the diagrams of textiles, pipe staple and microstructure in a 3 x 3 grid with larger panels: one row per method and one column per dataset. Each panel gives its test ECE before and after Platt scaling in its lower right corner.
Code
# Figure F7b: the reliability diagrams of three datasets in a 3 x 3 grid,
# one row per method and one column per dataset, with larger panels and
# points than F7. The strips hold only the names; the test ECE before and
# after Platt goes in the lower right corner of each panel, where no curve
# passes (a curve there would give a high probability to nominal images).
grid_datasets <- c("textiles", "pipe_staple", "microstructure")
grid_methods <- c("JEV, k = 2" = "JEV, k = 2", "Clef-Flash, k = 2" = "Clef-Flash, k = 2",
"CLIP baseline" = "CLIP baseline, k = 50")
grid_panels <- function(d) {
d |>
dplyr::filter(dataset %in% grid_datasets, method %in% names(grid_methods)) |>
dplyr::mutate(row = factor(grid_methods[method], grid_methods),
col = factor(dataset_labels[dataset], dataset_labels[grid_datasets]))
}
fig_reliability_grid <- function(layout, paper = FALSE, width, height) {
d <- grid_panels(reliability)
# In the narrow one-column size the label has no "ECE" and the size of
# the value labels, so that it covers less of the panel.
one <- layout == "one-column"
ece <- grid_panels(ece_rows) |>
dplyr::mutate(label = stringr::str_c(
if (one) "" else "ECE ", paint(fmt(ece_raw), calibration_colors[["raw"]]), " to ",
paint(fmt(ece_platt), calibration_colors[["Platt"]])
))
point_size <- if (layout == "one-column") 0.9 else 1.3
# The radius of a point in pt: its size and half its stroke (0.5).
radius <- (point_size * ggplot2::.pt + 0.5 * ggplot2::.stroke / 2) / 2
labels <- d |>
dplyr::arrange(calibration != "Platt") |>
dplyr::transmute(row, col, x = mean_p, y = observed, label = fmt(observed),
colour = unname(calibration_colors[as.character(calibration)]),
side = dplyr::if_else(calibration == "Platt", "above", "below"),
id = dplyr::row_number(), gap_pt = radius + 0.1)
plot <- ggplot2::ggplot(d, ggplot2::aes(mean_p, observed, colour = calibration)) +
ggplot2::geom_abline(slope = 1, intercept = 0, colour = "grey70", linewidth = 0.3) +
ggplot2::geom_line(linewidth = 0.55) +
ggplot2::geom_point(size = point_size) +
ggtext::geom_richtext(
ggplot2::aes(x = 0.98, y = 0.02, label = label), data = ece, inherit.aes = FALSE,
hjust = 1, vjust = 0, fill = "white", label.colour = NA,
label.padding = grid::unit(rep(1, 4), "pt"), colour = "grey15", family = body_font,
size = label_size[[layout]] * (if (one) 1 else 1.15) / ggplot2::.pt
) +
ggplot2::scale_colour_manual(values = calibration_colors) +
ggplot2::scale_x_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1)) +
ggplot2::scale_y_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1)) +
ggplot2::facet_grid(rows = ggplot2::vars(row), cols = ggplot2::vars(col)) +
ggplot2::labs(
subtitle = subline(
layout,
paint("Raw", calibration_colors[["raw"]]), " scores and ",
paint("Platt", calibration_colors[["Platt"]]),
" probabilities on the test images (Platt fitted on the calibration ",
"set C). Calibrated curves follow the diagonal. Lower right: the ",
"test ECE before and after Platt scaling."
),
x = "Mean predicted defect probability (10 bins)",
y = "Observed defect rate"
) +
theme_paper(layout) +
ggplot2::theme(panel.spacing = ggplot2::unit(if (one) 5 else 8, "pt"))
add_labels(plot, labels, layout, width, height)
}
save_figure(fig_reliability_grid, "F7b_reliability_3x3",
height = c("one-column" = 4.6, "two-column" = 6.6))
8.1 Lower defect rates
Code
# Precision at a defect rate, from the test sensitivity and specificity after
# Platt scaling (decision D103). It holds if the scores of each class keep
# their distribution at the new defect rate.
precision_at <- function(sens, spec, rate) {
sens * rate / (sens * rate + (1 - spec) * (1 - rate))
}
prevalence_rows <- dplyr::mutate(
main,
p50 = precision_at(sens, spec, 0.5), p05 = precision_at(sens, spec, 0.05),
p01 = precision_at(sens, spec, 0.01)
)
# Numbers for the text below: the precision at 1% of the decision models
# where their specificity is below 1, and the nominal test images per dataset.
p01_models <- dplyr::filter(prevalence_rows, model != "clip", spec < 1)$p01
nominal_test <- dplyr::count(dplyr::filter(test_set, actual_class == "nominal"), dataset)$nThe test sets and C hold as many defective images as nominal images, but a production line has far fewer defects. At a defect rate π, the sensitivity and the specificity of a method stay the same if the scores of each class keep their distribution, but the precision falls: precision = sens × π / (sens × π + (1 − spec) × (1 − π)). Table 8 gives the precision of the five methods at defect rates of 50% (the test sets), 5% and 1%. At 1%, the precision of the decision models is 0.035 to 0.336 where their specificity is below 1: most of their alarms would be false. A specificity of 1.000 gives a precision of 1.000 at every defect rate, but it rests on zero false alarms in 39 to 225 nominal test images.
The Platt probabilities also refer to a defect rate of 50%. At a defect rate π, add log(π / (1 − π)) to their log-odds. If the Platt probabilities are calibrated and the scores of each class keep their distribution, the decision at 0.5 on them gives the highest balanced accuracy at every defect rate: it calls an image defective when its probability at the true defect rate is above π.
Code
# Table T11.
t11 <- prevalence_rows |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Method = stringr::str_c(method, flag),
Sensitivity = sens, Specificity = spec,
`Precision at 50%` = p50, `Precision at 5%` = p05, `Precision at 1%` = p01
)
save_table(t11, "T11_precision_defect_rate",
stringr::str_c("Precision at lower defect rates.", mark_caption(prevalence_rows$flag)),
digits = 3, page_length = 25, group = "Dataset")9 Time and cost
This section gives the time that each method needs for one image, the total time of each step, and the calls, tokens and estimated cost of JEV. scripts/fair_evaluate.R makes results/fair/summary/timing.csv from the elapsed_ms column of the score files, from clip_timing.csv and runs.csv in results/fair/timing/, and from the TypeSafe call log. Section 3.8 tells how each time is measured.
Code
# The timing summary, and the hardware of each method from runs.csv.
timing <- read_csv_quiet(
file.path(summary_dir, "timing.csv"),
col_types = readr::cols(.default = "d", model = "c", description = "c",
dataset = "c", split = "c")
)
runs_file <- file.path(results_root, "timing", "runs.csv")
hardware <- if (file.exists(runs_file)) {
read_csv_quiet(runs_file, col_types = readr::cols(.default = "c")) |>
dplyr::distinct(model, hardware)
} else {
tibble::tibble(model = character(), hardware = character())
}
has_decision_time <- any(timing$model %in% c("jev", "clef") & !is.na(timing$median_ms))
has_clip_time <- any(timing$model == "clip" & !is.na(timing$median_ms))
# timing.csv also has the calls and tokens of Clef-Flash, with no cost.
has_cost <- any(timing$model == "jev" & !is.na(timing$n_calls))
# Median time of the CLIP baseline: pans against the other datasets.
clip_base <- dplyr::filter(timing, model == "clip", description == "baseline", split == "test")
clip_pan_ms <- clip_base$median_ms[clip_base$dataset == "pan_images"]
clip_other_ms <- mean(clip_base$median_ms[clip_base$dataset != "pan_images"])
if (length(clip_pan_ms) == 0) clip_pan_ms <- clip_other_ms <- NA_real_
# Median time of the decision models at k = 2 (final description; pans:
# generic): the range over the other datasets, and pans.
decision_ms <- dplyr::filter(timing, model %in% c("jev", "clef"), split == "test", k == k_main,
description == dplyr::if_else(dataset == "pan_images",
"generic", "final"))
ms_range <- function(m) {
ms <- decision_ms$median_ms[decision_ms$model == m & decision_ms$dataset != "pan_images"]
stringr::str_c(fmt(min(ms), 0), " to ", fmt(max(ms), 0))
}
ms_pan <- \(m) fmt(decision_ms$median_ms[decision_ms$model == m & decision_ms$dataset == "pan_images"], 0)
# Calls and estimated cost of JEV: the test runs, and all runs with a cost.
jev_calls <- dplyr::filter(timing, model == "jev", !is.na(n_calls))
jev_test_calls <- dplyr::filter(jev_calls, split == "test")
no_cost <- sum(is.na(jev_calls$cost_usd))
cost_note <- ""
if (no_cost > 0) {
cost_note <- stringr::str_c(" The call log has no cost for ", no_cost,
" configurations; the total does not include them.")
}
# The cost sentence of the section JEV cost, only when the log has a cost.
cost_text <- ""
if (has_cost) {
cost_text <- stringr::str_c(
"The ", fmt(sum(jev_test_calls$n_calls), 0), " JEV calls of the test runs cost about USD ",
fmt(sum(jev_test_calls$cost_usd, na.rm = TRUE)), ". All ", fmt(sum(jev_calls$n_calls), 0),
" JEV calls of the description loops, the calibration runs and the test runs cost ",
"about USD ", fmt(sum(jev_calls$cost_usd, na.rm = TRUE)), " (@tbl-cost)."
)
}
# One sentence that names the hardware of each method.
hardware_text <- hardware |>
dplyr::mutate(label = model_labels[model]) |>
dplyr::arrange(match(model, names(model_labels))) |>
dplyr::summarise(text = stringr::str_c(label[1], ": ", stringr::str_c(hardware, collapse = ", ")),
.by = model) |>
dplyr::pull(text) |>
stringr::str_c(collapse = "; ")The times come from different hardware: JEV: TypeSafe API; Clef-Flash: NVIDIA RTX 5000 Ada Generation; CLIP: NVIDIA RTX 5000 Ada Generation. JEV time includes the network and the queue of the service, and CLIP time does not. The methods are therefore not ranked on time alone.
9.1 Time per image
Table 9 gives the median, the interquartile range (Q1 to Q3) and the 5th and 95th percentiles (P5 and P95) of the time per image on the test set. The CLIP time is the time of the timing pass, after one warm-up call. At k = 2, JEV needs a median of 175 to 290 ms per image on the four datasets other than pans, and 970 ms on pans. Clef-Flash needs 173 to 257 ms, and 1,212 ms on pans. The CLIP baseline needs a median of 98 ms for a pan image and 12 ms on average for an image of the other datasets.
Code
# Test rows of the main methods, with their hardware.
time_rows <- main_configs |>
dplyr::inner_join(dplyr::filter(timing, split == "test", !is.na(median_ms)),
by = c("model", "description", "k", "dataset")) |>
dplyr::left_join(hardware, by = "model") |>
dplyr::arrange(match(dataset, dataset_order), match(method, main_methods$method))
# Table T8.
t8 <- time_rows |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Method = method, Hardware = hardware,
Images = n_images, Median = median_ms, Q1 = q25_ms, Q3 = q75_ms, P5 = p05_ms, P95 = p95_ms
)
save_table(t8, "T8_time_per_image", "Time per image on the test sets (ms).",
digits = 1, page_length = 25, group = "Dataset")9.2 Total time
Table 10 gives the total time of each step: the description loops (design images), the calibration runs and the test runs, summed over the configurations of a model and a dataset. The step of CLIP is the timing pass on the test images. The original scoring runs of CLIP were not timed.
Code
step_labels <- c(design = "Design loop", calibration = "Calibration runs", test = "Test runs")
total_rows <- timing |>
dplyr::filter(!is.na(total_seconds)) |>
dplyr::summarise(runs = dplyr::n(), images = sum(n_images, na.rm = TRUE),
seconds = sum(total_seconds),
.by = c(model, dataset, split)) |>
dplyr::arrange(match(dataset, dataset_order), match(model, names(model_labels)),
match(split, names(step_labels)))
# Table T9.
t9 <- total_rows |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Method = model_labels[model],
Step = dplyr::if_else(model == "clip", "Timing pass", step_labels[split]),
Configurations = runs, Images = images, `Total time (s)` = seconds
)
save_table(t9, "T9_total_time", "Total time of each step (seconds).",
digits = 1, page_length = 25, group = "Dataset")9.3 JEV cost
The cost of JEV is an estimate: the input tokens of each call times USD 0.042 per million, the price in R/industrial_defect_classifier.R. The client logs the tokens of each call in the TypeSafe call log, with the purpose of the call, which names the step and the configuration. The estimate does not include the output tokens. The researchers can compare the logged total with the usage that the TypeSafe account shows.
The 6,012 JEV calls of the test runs cost about USD 0.53. All 8,430 JEV calls of the description loops, the calibration runs and the test runs cost about USD 0.73 (Table 11).
Code
cost_rows <- timing |>
dplyr::filter(model == "jev", !is.na(n_calls)) |>
dplyr::arrange(match(dataset, dataset_order), match(split, names(step_labels)), k)
# Table T10: one row per configuration, then the total.
t10 <- cost_rows |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Step = step_labels[split],
Configuration = dplyr::if_else(split == "design", stringr::str_c("candidate ", description),
stringr::str_c(description, ", k = ", k)),
Calls = n_calls, `Input tokens` = input_tokens, `Output tokens` = output_tokens,
`Estimated cost (USD)` = cost_usd
) |>
dplyr::bind_rows(tibble::tibble(
Dataset = "Total", Step = "All", Configuration = "All configurations",
Calls = sum(cost_rows$n_calls, na.rm = TRUE),
`Input tokens` = sum(cost_rows$input_tokens, na.rm = TRUE),
`Output tokens` = sum(cost_rows$output_tokens, na.rm = TRUE),
`Estimated cost (USD)` = sum(cost_rows$cost_usd, na.rm = TRUE)
))
save_table(t10, "T10_jev_cost",
stringr::str_c("Calls, tokens and estimated cost of the JEV runs.", cost_note),
digits = 4, page_length = 25, group = "Dataset")9.4 Compute
scripts/model_compute.R measures the size and the work of the two local models and writes results/fair/timing/model_compute.csv (no API call). For CLIP ViT-L/14, it counts the parameters and the FLOPs of the matrix products of one image encoding and of one encoding of the two zero-shot prompts (PyTorch FlopCounterMode). These FLOPs do not depend on the image or the text: CLIP resizes each image to 224 × 224 pixels, and its text encoder always reads 77 positions. On the GPU, the script measures the memory of the weights and the peak memory while one image is encoded. For Clef-Flash, it reads the number of parameters and their type from the Hugging Face API, at the revision in the file; the model is dense (its config.json has no expert setting). The GPU memory of Clef-Flash is that of the SGLang server (Section 9), which reserves memory for its cache; it is not a minimum. TypeSafe does not publish the size of JEV.
Table 12 gives the size and the memory of each model. Table 13 gives the work for one test image. JEV and Clef-Flash read the test image and the 2k reference images in each call. Their FLOPs grow with the input tokens of the call. For Clef-Flash, the table gives an estimate: 2 FLOPs per parameter and input token, the usual estimate for the forward pass of a dense transformer (Kaplan et al., 2020). CLIP encodes the test image once and compares its features with the n stored features of the references: 2 FLOPs per number of each feature vector. It encodes the references once, before the test images (one-time FLOPs), and this time is not in the time per image. CLIP zero-shot encodes its two prompts for each image, as in the scoring run.
Code
# Size and work of the local models, from the re-run if it has the file.
compute_file <- purrr::detect(file.path(c(results_root, saved_root), "timing", "model_compute.csv"),
file.exists)
has_compute <- !is.null(compute_file)Code
model_compute <- read_csv_quiet(compute_file)
clip_compute <- dplyr::filter(model_compute, model == "clip")
clef_parameters <- model_compute$parameters[model_compute$model == "clef"]
# Table T12.
t12 <- model_compute |>
dplyr::arrange(match(model, names(model_labels))) |>
dplyr::transmute(
Model = c(clef = "Clef-Flash", clip = "CLIP ViT-L/14")[model],
`Parameters (billions)` = parameters / 1e9, `Weight type` = dtype_as_run,
`Weights (GB)` = weights_gb, `GPU memory, measured (GB)` = gpu_gb_measured,
`GFLOPs, one image encoding` = image_flops / 1e9,
`GFLOPs, two prompts` = text_flops / 1e9, `Feature length` = embedding_dim,
Hardware = hardware
) |>
dplyr::bind_rows(tibble::tibble(Model = "JEV", `Weight type` = "not public",
Hardware = "TypeSafe API"), x = _) |>
dplyr::relocate(Model, `Parameters (billions)`, `Weight type`) |>
dplyr::relocate(Hardware, .after = dplyr::last_col())
save_table(t12, "T12_compute_size", "Size, memory and work units of each model.",
digits = 2)Code
# The test configurations: JEV and Clef-Flash with the final description (pans:
# generic) at each k, and each CLIP variant.
work_rows <- timing |>
dplyr::filter(split == "test", !is.na(median_ms),
model == "clip" | description == dplyr::if_else(dataset == "pan_images",
"generic", "final")) |>
dplyr::mutate(
method = dplyr::case_when(
model == "clip" & description == "baseline" ~ "CLIP baseline",
model == "clip" & description == "refs" ~ "CLIP, same references",
model == "clip" ~ "CLIP, zero-shot",
.default = model_labels[model]
),
references = dplyr::if_else(model == "clip" & description == "zero", 0, 2 * k),
tokens = input_tokens / n_calls,
flops = dplyr::case_when(
model == "clef" ~ 2 * clef_parameters * tokens,
model == "clip" & description == "zero" ~
clip_compute$image_flops + clip_compute$text_flops + 2 * 2 * clip_compute$embedding_dim,
model == "clip" ~ clip_compute$image_flops + 2 * references * clip_compute$embedding_dim,
.default = NA_real_
),
one_time = dplyr::if_else(model == "clip", references * clip_compute$image_flops, NA_real_),
cost_1000 = dplyr::if_else(model == "jev", 1000 * cost_usd / n_calls, 0),
cost_sd_1000 = dplyr::if_else(model == "jev", 1000 * cost_sd_usd, 0)
) |>
dplyr::arrange(match(dataset, dataset_order), match(model, names(model_labels)),
match(description, c("baseline", "refs", "zero")), k)
# Table T13.
t13 <- work_rows |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Method = method, k, References = references,
`Input tokens per call` = tokens,
`GFLOPs per test image` = round_half_up(flops / 1e9, 1),
`One-time GFLOPs` = round_half_up(one_time / 1e9, 1),
`Median (ms)` = round_half_up(median_ms, 1),
`Cost per 1,000 images (USD)` = cost_1000, `SD (USD)` = cost_sd_1000
)
save_table(t13, "T13_compute_work", "Work for one test image.",
digits = 3, page_length = 25, group = "Dataset")10 v0.0.1
Version v0.0.1 is the tag v0.0.1 (commit 33ffd59). Its analysis document, tables and figures stay in the tag, and the v0.0.1 scripts in scripts/ reproduce it. The v0.0.1 results stay in the replication record. A reader can find five weak points in v0.0.1:
- The calibration used the validation images that chose the description. A description that separates these images well looks better on them than on new images. Thus the calibrated probabilities were too confident.
- The label budgets were different: 103 to 104 labeled images for JEV, 100 for the CLIP baseline, and mostly different images.
- Claude Code wrote the descriptions after it had seen test results.
- Clef-Flash used a description that was optimized for JEV.
- CLIP was not calibrated, and the report gave only two metrics.
| Item | v0.0.1 | This design |
|---|---|---|
| Labeled images, JEV and Clef-Flash | 3 to 4 references plus 100 validation images (pans: 4 + 16) | 50 per class for learning (the references come from it) plus 25 per class for calibration |
| Labeled images, CLIP baseline | 50 per class (pans: 10) | the same 75 per class as JEV |
| Same images for all methods | partly | yes |
| Description chosen on | the 100 validation images | the learning images that are not references (48 per class) |
| Description written by | Claude Code, which had seen test results | a fresh agent that cannot see test images or results |
| Clef-Flash description | the description of JEV | its own loop |
| Threshold | tuned on raw validation probabilities | 0.5 on calibrated probabilities |
| Calibration fitted on | the validation images that chose the description | the separate calibration set C |
| CLIP calibrated | no | yes |
| Metrics | balanced accuracy and AUC | all metrics of Section 3, with paired comparisons |
The v0.0.1 runs used the test sets once, and this design keeps the same test sets. A new test set would break the comparison with the CLIP paper, and pans have no spare images. Thus the researchers know the v0.0.1 test results, but the agent that writes the descriptions does not.
11 Appendix
11.1 Isotonic calibration
The plan made isotonic regression a sensitivity analysis, because Platt scaling fits 2 parameters and isotonic regression overfits with 25 images per class. Table 14 gives the test results of every configuration after both. The differences below are point differences of the test balanced accuracy, from metrics.csv, because paired.csv uses Platt only.
Code
# Numbers for the text below. The point differences of P1 to P3 after Platt
# and after isotonic, with the sides of the plan (chunk paired-marks).
ba_test <- metrics |>
dplyr::filter(split == "test", metric == "bal_accuracy", calibration != "raw") |>
dplyr::select(model, description, k, dataset, calibration, value)
iso_diffs <- plan |>
dplyr::mutate(k = k_main) |>
dplyr::inner_join(ba_test, by = c("model", final = "description", "k", "dataset"),
relationship = "many-to-many") |>
dplyr::inner_join(dplyr::rename(ba_test, b_model = model, b_desc = description,
b_k_side = k, b_value = value),
by = c("b_model", "b_desc", "dataset", "calibration"),
relationship = "many-to-many") |>
dplyr::filter(is.na(b_k) | b_k_side == b_k) |>
dplyr::transmute(comparison, model, dataset, calibration, difference = value - b_value)
iso_diff <- function(id, m, ds, cal) {
signed(iso_diffs$difference[iso_diffs$comparison == id & iso_diffs$model == m &
iso_diffs$dataset == ds & iso_diffs$calibration == cal], 3)
}
# One calibration score file; with no file, an empty table with the same
# columns, so the text below shows no number and stops nothing.
read_scores_if <- function(name) {
file <- file.path(scores_dir, name)
if (!file.exists(file)) {
return(tibble::tibble(actual_class = character(), prob_defective = double()))
}
read_csv_quiet(file)
}
# JEV with the generic description at k = 0 on pans: the scores of its
# calibration images (the 10 + 10 images of L), and the cut of each fit (the
# score where the calibrated probability reaches 0.5).
pan_k0 <- read_scores_if("jev_generic_k0_pan_images_calibration.csv")
pan_k0_y <- as.integer(pan_k0$actual_class == "defective")
pan_k0_cut <- c(platt = NA_real_, isotonic = NA_real_)
if (dplyr::n_distinct(pan_k0_y) == 2) {
pan_k0_cut <- purrr::map_dbl(list(platt = fair$platt, isotonic = fair$isotonic), \(fit) {
calibrate <- fit(pan_k0$prob_defective, pan_k0_y)
stats::uniroot(\(p) calibrate(p) - 0.5, c(0.01, 0.99), tol = 1e-9)$root
})
}
pan_k0_defective <- sort(pan_k0$prob_defective[pan_k0_y == 1])
# CLIP zero-shot with the final descriptions on textiles: its scores on C.
zero_final_c <- read_scores_if("clip_zero_final_k0_textiles_calibration.csv")
# The configurations with a negative Platt slope, and those of them whose
# isotonic fit gives 0.5 to every test image (one pooled block).
config_keys <- c("model", "description", "k", "dataset")
reversed <- slopes |>
dplyr::filter(platt_slope < 0) |>
dplyr::inner_join(dplyr::filter(ba_test, calibration == "isotonic"), by = config_keys)
one_block <- calibrated |>
dplyr::filter(split == "test") |>
dplyr::summarise(pooled = all(abs(isotonic - 0.5) < 1e-9), .by = dplyr::all_of(config_keys))
reversed <- dplyr::left_join(reversed, one_block, by = config_keys)- P1 keeps its direction for both models on every dataset, except Clef-Flash on extrusion, where -0.005 with Platt becomes 0.000 with isotonic. The JEV gap on microstructure grows from -0.031 with Platt to -0.073 with isotonic.
- P2 mostly holds. The JEV gain on extrusion shrinks from +0.130 to +0.050, and the small Clef-Flash gain on extrusion changes sign (+0.035 to -0.030).
- P3 depends on the calibration method on two datasets. Pipe staple: the k = 0 side of JEV has a negative Platt slope. Platt reverses its scores (balanced accuracy 0.730). Isotonic regression cannot, because it fits a non-decreasing function: all its probabilities pool to 0.5, so every image is called defective (0.500). The JEV gain thus looks about twice as large: +0.440 with isotonic against +0.210 with Platt. Pans: the calibration images are the 10 + 10 images of L. For JEV with the generic description at k = 0, the two classes do not overlap on them: the nominal images score 0.55 or less, the defective images 0.57 or more. Isotonic regression puts the cut inside this gap (0.56). Platt puts it higher (0.79), because 9 of the 10 defective images score 0.94 or more. On the test set, Platt thus misses many defective images (sensitivity 0.538, against 0.974 with isotonic), and the pans gain of JEV is +0.231 with Platt but +0.038 with isotonic. Clef-Flash shows the same pattern on pans (+0.167 against +0.051). On microstructure, the small JEV gain changes sign (+0.013 to -0.002).
- CLIP zero-shot with the final descriptions on textiles (decision D89): isotonic regression works on the raw scores with no clamp. It thus separates the 50 scores of C, all between 0.999 and 1.000, and gives a balanced accuracy of 0.650. Platt gives 0.5 to every image (0.500).
- Negative Platt slopes (decision D82): with isotonic regression, 4 of the 5 configurations get one pooled block at 0.5. Every image is then called defective (the rule is 0.5 or more), and the balanced accuracy is 0.500. The other one, Clef-Flash with the generic description at k = 2 on pipe staple, gets 0.520: its raw scores on C are near chance (AUC 0.476), and isotonic regression finds several blocks.
Thus P1 and P2 do not depend on the calibration method: only differences with a Platt interval that includes 0 change sign. The size of P3 on pans and pipe staple does depend on it.
Code
# Readable name of a configuration.
config_label <- function(model, description, k) {
dplyr::case_when(
description == "baseline" ~ "CLIP baseline",
description == "refs" ~ stringr::str_c("CLIP, same references, k = ", k),
description == "zero" ~ "CLIP, zero-shot",
description == "zero_final" ~ "CLIP, zero-shot, final descriptions",
.default = stringr::str_c(model_labels[model], ", ", description,
" description, k = ", k)
)
}
order_configs <- function(data) {
dplyr::arrange(data, match(dataset, dataset_order),
match(model, names(model_labels)), description, k)
}
# Table A1: Platt against isotonic, every configuration.
a1 <- dplyr::bind_rows(
dplyr::mutate(test_metrics("platt"), calibration = "Platt"),
dplyr::mutate(test_metrics("isotonic"), calibration = "isotonic")
) |>
dplyr::select(model, description, k, dataset, calibration, bal_accuracy, mcc,
ece, mn_log_loss) |>
tidyr::pivot_wider(names_from = calibration,
values_from = c(bal_accuracy, mcc, ece, mn_log_loss)) |>
dplyr::left_join(slopes, by = c("model", "description", "k", "dataset")) |>
order_configs() |>
dplyr::transmute(
Dataset = dataset_labels[dataset],
Configuration = stringr::str_c(config_label(model, description, k), slope_mark(platt_slope)),
`BA Platt` = bal_accuracy_Platt, `BA isotonic` = bal_accuracy_isotonic,
`MCC Platt` = mcc_Platt, `MCC isotonic` = mcc_isotonic,
`ECE Platt` = ece_Platt, `ECE isotonic` = ece_isotonic,
`Log loss Platt` = mn_log_loss_Platt, `Log loss isotonic` = mn_log_loss_isotonic
)
save_table(a1, "A1_isotonic",
stringr::str_c("Test results after Platt scaling and after isotonic regression.",
mark_caption(slope_mark(slopes$platt_slope))),
digits = 3, filter = TRUE, group = "Dataset")11.2 Loop candidates
The page Description loops shows the same candidates as word diffs, each against the text that it revised.
Code
# Table A2.
a2 <- loops |>
dplyr::arrange(match(dataset, dataset_order), match(model, names(model_labels)), candidate) |>
dplyr::transmute(
Dataset = dataset_labels[dataset], Model = model_labels[model],
Candidate = candidate, Nominal = normal, Defective = defective,
`Design AUC` = auc, `Mean score by defect type` = mean_score_by_type,
Reason = reason, Kept = dplyr::if_else(kept, "yes", "no")
)
save_table(a2, "A2_loop_candidates", "All candidates of the description loops.",
digits = 3, filter = TRUE,
wide = c("Nominal", "Defective", "Mean score by defect type", "Reason"),
group = "Dataset")11.3 CLIP variants
The CLIP paper rule is the raw score of the CLIP baseline at 0.5. All other rows use Platt scaling on C.
Code
# Numbers for the text below: CLIP zero-shot with the final descriptions on
# textiles, all its scores (C and test).
zero_final_textiles <- dplyr::filter(calibrated, model == "clip", description == "zero_final",
dataset == "textiles")Two marks flag the rows where Platt scaling does not keep the order of the raw scores:
- † CLIP zero-shot on microstructure and on textiles has a negative Platt slope (-6.23 and -1.71; decision D82). Its raw scores run backwards (raw test AUC 0.312 and 0.282), and Platt reverses them. Its calibrated results (balanced accuracy 0.640 and 0.645) thus come from the calibration labels, not from the raw ranking.
- ‡ CLIP zero-shot with the final descriptions on textiles (decision D89) gives a probability of 0.999 or more to every image of C and of the test set. Platt clamps its input to 0.005 to 0.995, so all its inputs are equal, and the slope is not defined. Platt thus gives 0.5 to every image (balanced accuracy 0.500). The raw test AUC (0.685) shows its ranking. The configuration stays in the results as it is, with this mark. It is not part of P1 to P3.
Code
# Table A3: the CLIP rows after Platt, plus the CLIP baseline with the rule of
# the CLIP paper (raw score at 0.5), which has no Platt fit and no mark.
a3 <- dplyr::bind_rows(
dplyr::filter(test_metrics("platt"), model == "clip"),
test_metrics("raw") |>
dplyr::filter(model == "clip", description == "baseline") |>
dplyr::mutate(description = "paper_rule")
) |>
dplyr::left_join(slopes, by = c("model", "description", "k", "dataset")) |>
order_configs() |>
dplyr::transmute(
Dataset = dataset_labels[dataset],
Variant = dplyr::if_else(description == "paper_rule", "CLIP baseline, paper rule",
stringr::str_c(config_label(model, description, k),
slope_mark(platt_slope))),
dplyr::across(dplyr::all_of(names(metric_labels)))
) |>
dplyr::rename_with(\(x) unname(metric_labels[x]), dplyr::all_of(names(metric_labels)))
save_table(a3, "A3_clip_variants",
stringr::str_c("All CLIP variants on the test sets.",
mark_caption(slope_mark(slopes$platt_slope[slopes$model == "clip"]))),
digits = 3, filter = TRUE, group = "Dataset")
# The final JEV descriptions that the CLIP text encoder had to cut at 77
# tokens (scripts/fair_clip.R writes this file with the zero_final runs).
truncation_file <- file.path(scores_dir, "clip_truncation.csv")
has_truncation <- file.exists(truncation_file)
truncation <- if (has_truncation) read_csv_quiet(truncation_file) else NULLThe CLIP text encoder takes at most 77 tokens. It cut 0 of the 8 texts of the final JEV descriptions (Table 17).
Code
knitr::kable(truncation)| dataset | class | truncated |
|---|---|---|
| extrusion | normal | FALSE |
| extrusion | defective | FALSE |
| microstructure | normal | FALSE |
| microstructure | defective | FALSE |
| pipe_staple | normal | FALSE |
| pipe_staple | defective | FALSE |
| textiles | normal | FALSE |
| textiles | defective | FALSE |
12 Re-run steps
These steps make all results of results/fair/ from the images. Each step is a script in scripts/, run from the repository root. Steps marked paid call the TypeSafe API and need TYPESAFE_API_KEY in .Renviron (never commit it) and FAIR_RECORD_ROOT: the folder of calls/README.md with the budget rows (replication_materials in a clone of main). A paid JEV run does not fall back to another folder. It logs each call to <FAIR_RECORD_ROOT>/calls/typesafe-calls.csv and stops when JEV_CALL_LOG names another file. The guards of scripts/fair_score.R stop a JEV run that needs more calls than its budget row has left; each JEV run prints the budget file, the call log, the calls left, and the spent and maximum cost. JEV_CHECK_ONLY=true runs the checks only; any value other than true or false stops the run. The original runs used the calls of the “Fair comparison” row. The re-run switches log their calls with the purpose prefix rerun (FAIR_PURPOSE_PREFIX=rerun), and these calls count against a separate “Re-run” row, which must exist first.
| Step | Script | Cost |
|---|---|---|
| 1. Draw L, C, the references and the design images | Rscript scripts/fair_draw_sets.R |
none |
| 2. Score the CLIP variants | RETICULATE_PYTHON=<env>/python.exe Rscript scripts/fair_clip.R |
local GPU |
| 2b. Time the CLIP variants on the test images | RETICULATE_PYTHON=<env>/python.exe Rscript scripts/fair_clip_timing.R |
local GPU |
| 2c. Measure the size, FLOPs and GPU memory of CLIP; read the size of Clef-Flash (Section 9.4) | RETICULATE_PYTHON=<env>/python.exe Rscript scripts/model_compute.R |
local GPU; Hugging Face API (free) |
| 3. Make the sandbox of a loop | Rscript scripts/fair_make_sandbox.R <model> <dataset> |
none |
| 4. Run the loop | bash scripts/fair_run_loop.sh <model> <dataset> starts one fresh, isolated Claude Code agent in the sandbox. It reads LOOP.md and runs score.sh, which calls scripts/fair_score.R with FAIR_SPLIT=design |
paid for JEV (up to 576 calls per dataset); local GPU for Clef-Flash |
| 5. Close the loop | Rscript scripts/fair_close_loop.R <model> <dataset> <transcript> |
none |
| 6. Calibration and test runs | FAIR_MODEL=<model> FAIR_DATASET=<dataset> FAIR_DESCRIPTION=<final or generic> FAIR_K=<k> FAIR_SPLIT=calibration Rscript scripts/fair_score.R, then the same with FAIR_SPLIT=test |
paid for JEV; local GPU for Clef-Flash |
| 7. Metrics, paired comparisons and k-curve | Rscript scripts/fair_evaluate.R |
none |
Notes on the steps:
- Step 1 rewrites
results/fair/sets/with the same draws (the seeds are fixed). Check withgit diffthat the files do not change. - Step 2 needs a Python 3.12 environment with torch 2.8.0 and OpenAI CLIP (
results/clip/python_environment.txt). After the loops,FAIR_CLIP_TEXT=finaladds the zero-shot variant with the final JEV descriptions. It skips pans and each dataset with no frozen JEV description, with a message. Run it first withFAIR_SPLITS=calibration, and withFAIR_SPLITS=testafter the researchers approve the calibration results; a test run stops when the calibration file of its dataset does not exist. Run CLIP when no other process uses the GPU. - Steps 3 to 5 run once for each model (jev, clef) and dataset (extrusion, textiles, pipe_staple, microstructure): 8 loops, each with one fresh agent. The researchers approve
LOOP.mdbefore step 4. Step 3 for JEV needsFAIR_RECORD_ROOTwith the “Fair comparison” row, becausescore.shkeeps it. Step 4 runs the agent as a separate, isolatedclaude -pprocess with the sandbox as its working folder (Section 3.3 gives the command), so that it gets no project instructions, no project memory and no user settings.--dry-runprints the command and starts nothing. The launcher prints the path of the transcript for step 5. Step 5 refuses to overwrite a frozen description. - Before step 6,
Rscript scripts/fair_check_call.R <model> 4makes one call with 4 references per class (9 images), to check that the model accepts them (purposefair check <model> k4). It writes only its row of the call log.JEV_CHECK_ONLY=trueruns its checks only. - Step 6 runs the configurations of Section 3.6; other configurations stop. Clef-Flash needs its local server:
docker run --gpus all -p 30000:30000 lmsysorg/sglang:dev-clef sglang serve --model-path Cloudflare/clef-flash --host 0.0.0.0 --port 30000. A run of a final description stops when its loop audit flagged a tool call, unlessFAIR_AUDIT_DECISIONnames the decision that accepts the flagged calls. Step 7 also writescalibration_summary.csv(the results on C), which needs no test file. - Step 2b writes
results/fair/timing/clip_timing.csvand one row per variant and dataset toresults/fair/timing/runs.csv. It does not change the CLIP score files. It stops ifclip_timing.csvexists. - Each run of step 6 adds one row to
runs.csvand anelapsed_mscolumn to its score file. JEV calls go to the TypeSafe call log, which the budget counts. Clef-Flash calls go toresults/fair/timing/clef-calls.csv. FAIR_OUT,FAIR_SCORES,FAIR_SUMMARYandFAIR_TIMING_DIRsend the outputs to another folder.
The chunks below run only when their switch in Section 1.1 is TRUE. They write to results/rerun/fair/ only, so the saved results never change:
- The score switches (
run_clip,run_clef,run_jev) write the new score files toresults/rerun/fair/runs/, and their timing files toresults/rerun/fair/timing_runs/. A re-run of a configuration passes the audit decision of its original run (runs.csv, columnaudit_decision) asFAIR_AUDIT_DECISION, when the original run has one. - The evaluation runs after any switch. It first fills
results/rerun/fair/scores/with the saved score files, and puts each re-run file in place of the saved file of the same configuration and split. Thus a partial re-run (for example CLIP only) still gives a full set of scores, and no file mixes the two sources. It makesresults/rerun/fair/timing/in the same way: the saved timing files, with the re-run rows in place of the saved rows of the same run. It then writes the summaries toresults/rerun/fair/summary/. A re-run of a decision model must run both splits of a configuration, asrerun_scores()does. - Set
use_reruntoTRUEin Section 1.1, with the switches back atFALSE, and render again. Every table and figure then comes fromresults/rerun/fair/scores/andresults/rerun/fair/summary/, and the figure and table files go toresults/rerun/fair/figs/andresults/rerun/fair/tables/.
The same steps from the command line: run the scripts with FAIR_OUT=results/rerun/fair/runs and FAIR_TIMING_DIR=results/rerun/fair/timing_runs; make results/rerun/fair/scores/ and results/rerun/fair/timing/ as in item 2; run FAIR_SCORES=results/rerun/fair/scores FAIR_SUMMARY=results/rerun/fair/summary FAIR_TIMING_DIR=results/rerun/fair/timing Rscript scripts/fair_evaluate.R; then render with use_rerun <- TRUE.
Code
# Run one script with environment variables and arguments; the old values
# of the variables come back after the run.
run_script <- function(script, vars = character(), args = character()) {
status <- withr::with_envvar(vars, {
system2(file.path(R.home("bin"), "Rscript"), c(script, args))
})
if (!identical(status, 0L)) {
stop(script, " failed: ", stringr::str_c(names(vars), vars, sep = "=", collapse = " "))
}
}
# The calibration and test runs of one decision model (section Configurations):
# all calibration runs first, then the test runs.
score_plan <- tidyr::expand_grid(dataset = dataset_order,
description = c("final", "generic"),
k = c(0, 1, 2, 4)) |>
dplyr::mutate(description = dplyr::if_else(dataset == "pan_images", "generic",
description)) |>
dplyr::distinct() |>
dplyr::filter(description == "final" | k %in% c(0, 2) | dataset == "pan_images")
# The calls of a re-run have the purpose prefix "rerun" and count against
# the "Re-run" budget row (a paid JEV re-run also needs FAIR_RECORD_ROOT).
# A run of a final description stops when its loop audit flagged a tool
# call, unless FAIR_AUDIT_DECISION names the decision that accepts it. The
# re-run passes the decision of the original run of the same configuration
# (runs.csv, column audit_decision; NA when the audit flagged nothing).
rerun_scores <- function(model) {
saved_runs <- read_csv_quiet(file.path(saved_root, "timing", "runs.csv"),
col_types = readr::cols(.default = "c"))
for (split in c("calibration", "test")) {
purrr::pwalk(score_plan, \(dataset, description, k) {
decision <- saved_runs$audit_decision[
saved_runs$model == model & saved_runs$dataset == dataset &
saved_runs$description == description & saved_runs$k == as.character(k) &
saved_runs$split == split
]
decision <- dplyr::first(stats::na.omit(decision), default = NA_character_)
vars <- c(
FAIR_MODEL = model, FAIR_DATASET = dataset, FAIR_DESCRIPTION = description,
FAIR_K = as.character(k), FAIR_SPLIT = split,
FAIR_OUT = file.path(rerun_root, "runs"),
FAIR_TIMING_DIR = file.path(rerun_root, "timing_runs"),
FAIR_PURPOSE_PREFIX = "rerun"
)
if (!is.na(decision)) vars <- c(vars, FAIR_AUDIT_DECISION = decision)
run_script("scripts/fair_score.R", vars)
})
}
}Code
# Step 2: the CLIP variants, then the zero-shot variant with the final JEV
# descriptions (it skips pans and each dataset with no frozen description).
# CLIP makes no API call; the prefix keeps all re-run steps alike.
rerun_clip_vars <- c(FAIR_OUT = file.path(rerun_root, "runs"), FAIR_PURPOSE_PREFIX = "rerun")
run_script("scripts/fair_clip.R", rerun_clip_vars)
run_script("scripts/fair_clip.R", c(rerun_clip_vars, FAIR_CLIP_TEXT = "final"))
# Step 2b: the timing pass.
run_script("scripts/fair_clip_timing.R",
c(FAIR_TIMING_DIR = file.path(rerun_root, "timing_runs")))Code
# Step 6 for Clef-Flash (local server at localhost:30000).
rerun_scores("clef")Code
# Step 6 for JEV (paid; needs a budget row with enough calls left).
rerun_scores("jev")Code
# Step 7. The scores of the re-run: the saved score files, each replaced by
# the re-run file of the same name (same configuration and split). The
# folder is made again at each evaluation.
rerun_scores_dir <- file.path(rerun_root, "scores")
unlink(rerun_scores_dir, recursive = TRUE)
dir.create(rerun_scores_dir, recursive = TRUE)
invisible(file.copy(list.files(file.path(saved_root, "scores"), full.names = TRUE),
rerun_scores_dir))
invisible(file.copy(list.files(file.path(rerun_root, "runs"), full.names = TRUE),
rerun_scores_dir, overwrite = TRUE))
# The timing files: the saved rows of runs.csv, except the runs that the
# re-run repeated, then the re-run rows; clip_timing.csv from the re-run if
# it has one.
rerun_timing_dir <- file.path(rerun_root, "timing")
unlink(rerun_timing_dir, recursive = TRUE)
dir.create(rerun_timing_dir, recursive = TRUE)
invisible(file.copy(list.files(file.path(saved_root, "timing"), full.names = TRUE),
rerun_timing_dir))
new_runs_file <- file.path(rerun_root, "timing_runs", "runs.csv")
if (file.exists(new_runs_file)) {
run_keys <- c("model", "description", "k", "dataset", "split", "candidate")
new_runs <- read_csv_quiet(new_runs_file)
read_csv_quiet(file.path(rerun_timing_dir, "runs.csv")) |>
dplyr::anti_join(new_runs, by = run_keys) |>
dplyr::bind_rows(new_runs) |>
readr::write_csv(file.path(rerun_timing_dir, "runs.csv"))
}
invisible(file.copy(list.files(file.path(rerun_root, "timing_runs"),
pattern = "^clip_timing", full.names = TRUE),
rerun_timing_dir, overwrite = TRUE))
# The summaries of these scores.
run_script("scripts/fair_evaluate.R", c(
FAIR_SCORES = rerun_scores_dir,
FAIR_SUMMARY = file.path(rerun_root, "summary"),
FAIR_TIMING_DIR = rerun_timing_dir
))13 Session information
Code
sessionInfo()R version 4.6.1 (2026-06-24 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26300)
Matrix products: default
LAPACK version 3.12.1
locale:
[1] LC_COLLATE=English_United States.utf8
[2] LC_CTYPE=English_United States.utf8
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.utf8
time zone: America/New_York
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
loaded via a namespace (and not attached):
[1] gtable_0.3.6 xfun_0.60 bslib_0.12.0 ggplot2_4.0.3
[5] htmlwidgets_1.6.4 tzdb_0.5.0 vctrs_0.7.3 tools_4.6.1
[9] crosstalk_1.2.2 generics_0.1.4 parallel_4.6.1 tibble_3.3.1
[13] pkgconfig_2.0.3 RColorBrewer_1.1-3 S7_0.2.2 lifecycle_1.0.5
[17] compiler_4.6.1 farver_2.1.2 stringr_1.6.0 textshaping_1.0.5
[21] litedown_0.10 htmltools_0.5.9 sass_0.4.10 yaml_2.3.12
[25] pillar_1.11.1 crayon_1.5.3 jquerylib_0.1.4 tidyr_1.3.2
[29] DT_0.34.0 cachem_1.1.0 magick_2.9.0 yardstick_1.4.0
[33] commonmark_2.0.0 tidyselect_1.2.1 digest_0.6.39 stringi_1.8.7
[37] dplyr_1.2.1 purrr_1.2.2 showtextdb_3.0 labeling_0.4.3
[41] fastmap_1.2.0 grid_4.6.1 cli_3.6.6 magrittr_2.0.5
[45] patchwork_1.3.2 dichromat_2.0-0.1 readr_2.2.0 withr_3.0.3
[49] scales_1.4.0 showtext_0.9-8 bit64_4.8.2 rmarkdown_2.31
[53] sysfonts_0.8.9 bit_4.6.0 otel_0.2.0 ggtext_0.1.2
[57] ragg_1.5.2 hms_1.1.4 kableExtra_1.4.1 evaluate_1.0.5
[61] knitr_1.51 viridisLite_0.4.3 markdown_2.0 rlang_1.3.0
[65] gridtext_0.1.6 Rcpp_1.1.2 glue_1.8.1 xml2_1.6.0
[69] svglite_2.2.2 rstudioapi_0.19.0 vroom_1.7.1 jsonlite_2.0.0
[73] R6_2.6.1 systemfonts_1.3.2 References
Carvalho, P., Lafou, M., Durupt, A., Leblanc, A., & Grandvalet, Y. (2024). The automotive visual inspection dataset (AutoVI): A genuine industrial production dataset for unsupervised anomaly detection [Data set]. Zenodo. https://doi.org/10.5281/zenodo.10459003
Cloudflare. (2026). Clef-flash. Hugging Face. https://huggingface.co/Cloudflare/clef-flash
Guo, C., Pleiss, G., Sun, Y., & Weinberger, K. Q. (2017). On calibration of modern neural networks. Proceedings of the 34th International Conference on Machine Learning, Proceedings of Machine Learning Research, 70, 1321–1330.
Hanley, J. A., & McNeil, B. J. (1982). The meaning and use of the area under a receiver operating characteristic (ROC) curve. Radiology, 143(1), 29–36. https://doi.org/10.1148/radiology.143.1.7063747
Kaplan, J., McCandlish, S., Henighan, T., Brown, T. B., Chess, B., Child, R., Gray, S., Radford, A., Wu, J., & Amodei, D. (2020). Scaling laws for neural language models. arXiv. https://doi.org/10.48550/arXiv.2001.08361
Machado, G. M., Oliveira, M. M., & Fernandes, L. A. F. (2009). A physiologically-based model for simulation of color vision deficiency. IEEE Transactions on Visualization and Computer Graphics, 15(6), 1291–1298. https://doi.org/10.1109/TVCG.2009.113
Megahed, F. M., Chen, Y.-J., Colosimo, B. M., Grasso, M., Jones-Farmer, L. A., Knoth, S., Sun, H., & Zwetsloot, I. M. (2026). Adapting OpenAI’s CLIP model for few-shot image inspection in manufacturing quality control: An expository case study with multiple application examples. Journal of Quality Technology, 58(4), 415–441. https://doi.org/10.1080/00224065.2026.2640171
Platt, J. C. (1999). Probabilistic outputs for support vector machines and comparisons to regularized likelihood methods. In A. J. Smola, P. Bartlett, B. Schölkopf, & D. Schuurmans (Eds.), Advances in large margin classifiers (pp. 61–74). MIT Press.
Radford, A., Kim, J. W., Hallacy, C., Ramesh, A., Goh, G., Agarwal, S., Sastry, G., Askell, A., Mishkin, P., Clark, J., Krueger, G., & Sutskever, I. (2021). Learning transferable visual models from natural language supervision. Proceedings of the 38th International Conference on Machine Learning, Proceedings of Machine Learning Research, 139, 8748–8763.
TypeSafe. (2026). Images. https://docs.typesafe.ai/images
Zadrozny, B., & Elkan, C. (2002). Transforming classifier scores into accurate multiclass probability estimates. Proceedings of the Eighth ACM SIGKDD International Conference on Knowledge Discovery and Data Mining, 694–699. https://doi.org/10.1145/775047.775151