Chapter 12
Text and image data

Lectures 24–25 · naive Bayes and shrinkage for words, topic models, calibration, detecting AI-written text, and Bayesian models of pixels

Text and images are the data of modern machine learning, and they look nothing like the tables of the previous chapters. A document is a sequence of words of any length; an image is a grid of thousands of pixel intensities. Yet the Bayesian toolkit carries over with surprisingly little change. Turn a document into counts of words, and classifying it is a regression with many predictors (Chapter 10); discovering its themes is a mixture model (Chapter 11). Turn an image into a vector of pixels, and the same logistic regression applies. What changes is scale, and with it the importance of two old ideas: shrinkage, because most words and most pixels carry little information, and calibration, because a classifier that is confidently wrong does real harm.

• Lecture 24 is about classifying text. We ask whether an answer to a finance question was written by a person or by ChatGPT, using the Human ChatGPT Comparison Corpus. We build naive Bayes as a genuinely Bayesian model, fit a horseshoe logistic regression on word counts, and look hard at what the classifiers actually learn.
• Lecture 25 is about topics, calibration and images. We fit a topic model with a sampler we write ourselves, check whether the detectors' probabilities can be trusted, test them on a different kind of question, and then classify clothing from pixels with a model whose uncertainty you can probe by drawing on a canvas.

Lecture 24 — Classifying text

12.1 Who wrote this answer?

In the weeks after ChatGPT's release in late 2022, Biyang Guo and colleagues collected questions from existing public question-answering data sets, each with one or more answers written by people, and asked ChatGPT to answer the same questions (Guo et al., 2023). The result, the Human ChatGPT Comparison Corpus (HC3), pairs human and machine answers to the same questions in several domains, and it became one of the first benchmarks for detecting AI-generated text. We use the finance subset: 3,933 questions about personal finance and investing, each with a human answer and a ChatGPT answer. A second subset, open-domain questions, will serve in Section 12.7 as a test of what happens when the kind of question changes.

The question is the one behind the AI-text detection project: given an answer, how probable is it that a machine wrote it? It is a prediction question, and we will judge every method on answers it did not see in training.

library(tidyverse)
library(brms)
library(posterior)
library(jsonlite)
library(Rcpp)
options(mc.cores = parallel::detectCores())

harbour <- c(ink = "#10191d", muted = "#4a5f68", grid = "#d5e3e6",
             sky = "#1d5187", amber = "#805907", rose = "#ad3b28",
             moss = "#1d6b54", lilac = "#5b3a94")
theme_harbour <- function(base_size = 11) {
  theme_minimal(base_size = base_size) +
    theme(text = element_text(colour = harbour[["ink"]]),
          axis.text = element_text(colour = harbour[["muted"]]),
          panel.grid.major = element_line(colour = harbour[["grid"]]),
          panel.grid.minor = element_blank(),
          strip.text = element_text(colour = harbour[["ink"]], hjust = 0),
          legend.position = "top")
}
theme_set(theme_harbour())

read_hc3 <- function(subset) {                 # one human and one ChatGPT answer per question
  tmp <- tempfile(fileext = ".jsonl")
  download.file(sprintf("https://huggingface.co/datasets/Hello-SimpleAI/HC3/resolve/main/%s.jsonl", subset), tmp, quiet = TRUE)
  raw <- lapply(readLines(tmp, encoding = "UTF-8"), fromJSON, simplifyVector = FALSE)   # one JSON record per line
  first <- function(x) if (length(x) > 0) x[[1]] else NA_character_
  tibble(q = seq_along(raw), human = map_chr(raw, ~ first(.x$human_answers)),
         chatgpt = map_chr(raw, ~ first(.x$chatgpt_answers))) |>
    pivot_longer(-q, names_to = "author", values_to = "text") |>
    group_by(q) |> filter(all(!is.na(text) & nchar(text) > 0)) |> ungroup() |>      # keep complete pairs only
    mutate(ai = as.integer(author == "chatgpt"))
}
fin <- read_hc3("finance")
fin |> mutate(words = str_count(text, "\\S+"), glued = str_detect(text, "[a-z]\\.[A-Z]")) |>
  group_by(author) |> summarise(answers = n(), median_words = median(words), glued_full_stops = mean(glued))
str_trunc(fin$text[fin$q == 7], 420)          # the two answers to one question, shortened

# A tibble: 2 x 4
  author  answers median_words glued_full_stops
  <chr>     <int>        <int>            <dbl>
1 chatgpt    3933          206          0.902  
2 human      3933          129          0.00534
[1] "—they will pull your credit report and perform a \"hard inquiry\" on your file. This means the inquiry will be noted in your credit report and count against you, slightly. This is perfectly normal. Just don't apply too many times too soon or it can begin to add up. They will want proof of your income by asking for recent pay stubs. With this information, your income and your credit profile, they will determine the m..."
[2] "It's generally a good idea to get preapproved for a car loan before you start shopping for a new vehicle. This will give you a good idea of what you can afford, and it can also help you negotiate a better price with the dealership.To determine how much you should get preapproved for, you'll need to consider a few different factors:Your budget: Make sure you have a clear idea of how much you can afford to pay each ..."  

All 3,933 finance questions have a usable answer of each kind, so we have 7,866 answers, half of them ChatGPT's. Two differences between the classes are visible before any modelling. ChatGPT's answers are longer: a median of 206 words against 129. And 90.2% of ChatGPT's answers contain a full stop followed directly by a capital letter with no space, as in "dealership.To determine" in the second answer above, against 0.5% of the human answers. The human answers have quirks of their own: the first one above is stitched together from fragments that begin with dashes, which is how it was stored in the source data set the authors used.

We split by question, not by answer: 1,000 questions, with both their answers, form the training set, and the other questions the test set. Splitting answers at random would put the human answer to a question in the training set and the ChatGPT answer to the same question in the test set, and a classifier could then score points by recognising the topic rather than the author. Any grouping in the data (patients, schools, questions) must be respected by the split.

To give a classifier something to work with, we reduce each answer to a bag of words: lower-case it, split it at anything that is not a letter or apostrophe, and count how often each word in a fixed vocabulary occurs. Word order is thrown away. The vocabulary is the 2,000 words that occur in the most training answers, chosen without looking at the labels (Chapter 10's lesson about outcome-based filtering).

set.seed(12)
train_q <- sample(unique(fin$q), 1000)                       # split by question, not by answer
train <- filter(fin, q %in% train_q); test <- filter(fin, !q %in% train_q)
tokenize <- function(x) str_split(str_to_lower(x), "[^a-z']+")
tok_train <- tokenize(train$text)
doc_freq <- table(unlist(map(tok_train, unique))); doc_freq <- doc_freq[names(doc_freq) != ""]
vocab <- names(sort(doc_freq, decreasing = TRUE))[1:2000]      # chosen without the labels
count_words <- function(tokens, v = vocab) {            # documents x words matrix of counts
  X <- t(sapply(tokens, function(w) tabulate(match(w, v), length(v)))); colnames(X) <- v; X
}
X_train <- count_words(tok_train); X_test <- count_words(tokenize(test$text))
c(train_answers = nrow(X_train), test_answers = nrow(X_test), vocabulary = ncol(X_train),
  share_of_tokens_covered = round(sum(X_train) / sum(lengths(tok_train)), 3))

          train_answers            test_answers              vocabulary 
               2000.000                5866.000                2000.000 
share_of_tokens_covered 
                  0.919 

The training set has 2,000 answers and the test set 5,866. The 2,000-word vocabulary covers 91.9% of all the words in the training answers; the rest are rare words, numbers broken into pieces, and web addresses.

12.2 What a detector can learn

The causal sketch for a detection problem is short, and it is the most important part of the analysis. The author (person or ChatGPT) shapes the answer in many ways: word choice, tone, length, structure. The question shapes it too, through its topic. And the pipeline that collected, cleaned and stored the answers can leave its own marks, which differ between the two sources because the two kinds of answer were collected differently.

A classifier does not know which path a feature came through. Style is what we hope it learns. Length is a real difference between the authors in this data set (ChatGPT's answers are longer), but it would vanish if someone asked ChatGPT to be brief. The glued full stops are pure pipeline: in HC3, the line breaks in ChatGPT's answers were removed when the answers were stored, so sentences that began on a new line now follow the previous full stop with no space. A detector that learns this has learned how a data set was scraped, not how a model writes. A bag of words splits text at punctuation, so our classifiers cannot see the seams directly, but Exercise 1 shows how far a one-feature "detector" gets with them.

There is a second, more uncomfortable lesson. Liang et al. (2023) showed that several commercial GPT detectors classified more than half of a set of essays written by non-native English speakers as AI-generated, while classifying essays by native speakers almost perfectly. Simpler vocabulary and more formulaic phrasing, common in writing in a second language, look like machine text to a model trained on fluent native writing. Whatever a detector learns, it learns relative to the people in its training data.

12.3 Naive Bayes is Bayesian

The oldest statistical text classifier is a direct application of Bayes' rule. Suppose each class $c$ (human or ChatGPT) has its own probability distribution over the vocabulary, ${\theta }_c=({\theta }_{c1},\dots ,{\theta }_{cV})$, and that the words of a document are drawn independently from the distribution of its class. Then a document with word counts $x=(x_1,\dots ,x_V)$ has likelihood ${\prod }_v{\theta }_{cv}^{x_v}$ under class $c$, and Bayes' rule gives the posterior log-odds that it is ChatGPT's:

where $\pi$ is the prior probability of ChatGPT (one half here, by design). Each word contributes a weight, its log probability ratio, once for each time it appears. The independence assumption is plainly false (the word "credit" makes "card" more likely), which is why the method is called naive Bayes. It nonetheless classifies well, for reasons explained by Domingos and Pazzani (1997): classification needs only the sign of the log-odds to be right, not its size.

The $\theta$'s must be estimated. The naive estimate, each word's share of the tokens in its class, fails badly for rare words: a word seen twice in ChatGPT's training answers and never in the human ones gets ${\widehat{\theta }}_{0v}=0$ and a weight of $+\infty$, and any document containing it is declared ChatGPT's with certainty. The Bayesian fix is a prior. With a symmetric Dirichlet prior, ${\theta }_c\sim \text{Dirichlet}(\alpha ,\dots ,\alpha )$, which is conjugate to the multinomial, the posterior is Dirichlet too, with posterior mean

where $n_{cv}$ is the count of word $v$ in class $c$ and $n_c$ the total number of tokens in class $c$. This is additive smoothing, invented as a fix ("add one to every count") and revealed by Bayes as a posterior mean; $\alpha =1$ is Laplace's rule of succession, from the eighteenth century. Rare words are pulled toward equal probability in the two classes, so their weights shrink toward zero, while common words, whose counts swamp $\alpha$, barely move. The widget shows it for words from our training set.

metrics <- function(p, y) {                   # accuracy, log loss, and share of near-certain predictions
  p <- pmin(pmax(p, 1e-12), 1 - 1e-12)        # floating point: probabilities can round to exactly 0 or 1
  c(accuracy = mean((p > 0.5) == y), log_loss = -mean(y * log(p) + (1 - y) * log(1 - p)),
    near_certain = mean(p < 0.001 | p > 0.999))
}
nb_weights <- function(alpha, X = X_train, y = train$ai) {
  n1 <- colSums(X[y == 1, ]); n0 <- colSums(X[y == 0, ])
  log((n1 + alpha) / (sum(n1) + alpha * ncol(X))) - log((n0 + alpha) / (sum(n0) + alpha * ncol(X)))
}
nb_logit <- function(alpha, X = X_test) as.vector(X %*% nb_weights(alpha))   # prior odds 1:1
nb_table <- t(sapply(c(0.01, 1, 10, 100), function(a) c(alpha = a, metrics(plogis(nb_logit(a)), test$ai))))
round(nb_table, 3)
w1 <- nb_weights(1); round(c(head(sort(w1, decreasing = TRUE), 8), head(sort(w1), 8)), 2)

     alpha accuracy log_loss near_certain
[1,] 1e-02    0.958    0.283        0.920
[2,] 1e+00    0.957    0.287        0.912
[3,] 1e+01    0.954    0.276        0.882
[4,] 1e+02    0.853    0.795        0.709
creditworthiness        carefully            goals     personalized 
            3.20             3.14             2.87             2.86 
     preferences          variety           noting           widely 
            2.86             2.81             2.78             2.76 
           isn't               my         probably             http 
           -4.59            -4.53            -4.37            -4.29 
            i've           really           pretty            you'd 
           -4.26            -4.24            -4.22            -4.22 

With almost any reasonable prior, naive Bayes classifies about 95.5% of the test answers correctly: 95.8% with $\alpha =0.01$, 95.7% with $\alpha =1$ and 95.4% with $\alpha =10$. Only a very strong prior ($\alpha =100$, which adds 200,000 pseudo-tokens to each class) hurts, bringing accuracy down to 85.3%. But look at the last column: with $\alpha =1$, 91.2% of the test answers get a probability below 0.001 or above 0.999. The classifier is nearly certain about nine answers in ten, and wrong about roughly one answer in twenty-five. Section 12.6 shows what that means. The words with the largest weights for ChatGPT are "creditworthiness", "carefully", "goals", "personalized", "preferences" and "variety"; for people, "isn't", "my", "probably", "http", "i've", "really" and "pretty". Hedged, personal and informal language points to a human; careful, generic advice points to ChatGPT.

12.4 Shrinkage on words

Naive Bayes models how documents are generated from classes. The alternative is to model the class given the document directly: a logistic regression of the label on the word counts. This drops the independence assumption, since correlated words now share their weight instead of each adding a full vote, but with a full vocabulary it has thousands of coefficients and only a few thousand documents, which is Chapter 10's problem exactly. We use the regularised horseshoe on the 300 most widespread words (again chosen without labels), each entered as $\log (1+\text{count})$ and standardised, with a prior guess of 30 relevant words. On one core the fit takes about nine minutes.

v300 <- vocab[1:300]
feat <- function(X) log1p(X[, v300])                     # log(1 + count) of the 300 commonest words
centre <- colMeans(feat(X_train)); spread <- apply(feat(X_train), 2, sd)
mk <- function(X, y) as_tibble(scale(feat(X), centre, spread), .name_repair = ~ paste0("w_", make.names(v300))) |> mutate(ai = y)
d_train <- mk(X_train, train$ai); d_test <- mk(X_test, test$ai)
m_text <- brm(ai ~ ., data = d_train, family = bernoulli(), seed = 12, refresh = 0,
              prior = c(prior(normal(0, 1.5), class = Intercept), prior(horseshoe(par_ratio = 30 / 270), class = b)),
              control = list(adapt_delta = 0.95), file = "fits/ch12_text")
p_hs <- colMeans(posterior_epred(m_text, newdata = d_test))
rbind(naive_bayes = metrics(plogis(nb_logit(1)), test$ai), horseshoe_logistic = metrics(p_hs, test$ai)) |> round(3)
c(divergences = rstan::get_num_divergent(m_text$fit), max_rhat = round(max(rhat(m_text), na.rm = TRUE), 3))

                   accuracy log_loss near_certain
naive_bayes           0.957    0.287        0.912
horseshoe_logistic    0.955    0.114        0.503
divergences    max_rhat 
      0.000       1.004 

The horseshoe model is as accurate as naive Bayes (95.5% against 95.7%), but its log loss is 0.114 against 0.287, two and a half times smaller, and it is near-certain about 50% of the test answers rather than 91%. The sampler ran cleanly: no divergent transitions and $\widehat{R}\le 1.004$. The two models rank answers almost equally well; they differ in how much they claim to know.

fx <- as_draws_df(m_text) |> select(starts_with("b_w_")) |> pivot_longer(everything(), names_to = "word") |>
  group_by(word) |> summarise(mean = mean(value), lo = quantile(value, 0.05), hi = quantile(value, 0.95)) |>
  mutate(word = str_remove(word, "^b_w_"))
top <- bind_rows(slice_max(fx, mean, n = 15), slice_min(fx, mean, n = 15)) |>
  mutate(side = if_else(mean > 0, "points to ChatGPT", "points to a human"), word = fct_reorder(word, mean))
ggplot(top, aes(y = word, colour = side)) + geom_vline(xintercept = 0, colour = harbour[["grid"]]) +
  geom_errorbarh(aes(xmin = lo, xmax = hi), height = 0) + geom_point(aes(x = mean), size = 1.6) +
  scale_colour_manual(values = c(`points to ChatGPT` = harbour[["rose"]], `points to a human` = harbour[["sky"]])) +
  labs(x = "coefficient (log-odds)", y = NULL, colour = NULL)

The strongest single marker of ChatGPT is "important" (posterior mean 3.95 on the log-odds scale per standard deviation; 90% interval roughly 2.5 to 5.9), followed by "may", "help", "overall", "typically" and "financial". The strongest marker of a person is "i", followed by "but", "very", "so", "just", "like" and "now". These are function words and hedges, not finance vocabulary: exactly the kind of feature Mosteller and Wallace used, and exactly the kind that a change of prompt ("answer casually, in the first person") would change.

Lecture 25 — Topics, calibration and images

12.5 Topic models

Classification needs labels. Often we have only documents and want to know what they are about. Latent Dirichlet allocation (LDA; Blei, Ng and Jordan, 2003) answers with a generative story that is a mixture model with one twist. There are $K$ topics, each a probability distribution ${\varphi }_k$ over the vocabulary. Each document $d$ has its own topic proportions ${\theta }_d$. Each word of the document is generated by first choosing a topic $z\sim \text{Categorical}({\theta }_d)$ and then a word $w\sim \text{Categorical}({\varphi }_z)$, with Dirichlet priors on both:

The twist is that the group label belongs to each word, not to each document. The penguins of Chapter 11 each belonged to one species; a document is a mixed-membership object, partly about mortgages and partly about taxes. Population geneticists had found the same model three years earlier: Pritchard, Stephens and Donnelly (2000) described each person's genome as a mixture of ancestral populations, with each stretch of DNA drawn from one of them. Documents are people, words are genetic markers and topics are populations.

The posterior is usually computed by collapsed Gibbs sampling (Griffiths and Steyvers, 2004). The Dirichlet priors are conjugate, so $\theta$ and $\varphi$ can be integrated out, leaving only the topic assignments $z$. Each word's assignment is then resampled in turn from

where the counts exclude the current word: $n_{k,w}$ is how often word $w$ is assigned to topic $k$ across the corpus, $n_k$ the total assigned to topic $k$, and $n_{d,k}$ the number of words in document $d$ assigned to topic $k$. The first factor says "this word is common in topic $k$"; the second says "this document already uses topic $k$". The widget runs this sampler on a toy corpus.

After a few sweeps the topics usually separate into the three themes, and documents that mix themes get mixed proportions. Small $\alpha$ pushes each document toward one dominant topic; large $\alpha$ spreads documents across topics. Restart a few times and the topics come out in a different order: the label switching of Chapter 11 again, harmless as long as we never average topic numbers across runs.

For the HC3 answers we write the same sampler in C++ through Rcpp, about twenty lines, and run it on all the finance answers (topic models use no labels, so the test answers can be included). We drop words of two letters or fewer, words in fewer than ten answers, and the very common words that appear in more than 15% of answers, and fit eight topics with $\alpha =0.5$ and $\beta =0.05$ for 300 sweeps. It takes a few seconds.

cppFunction('
List lda_gibbs(IntegerVector w, IntegerVector d, int K, int V, int D, double alpha, double beta, int iters) {
  // collapsed Gibbs sampler for LDA; w and d are 0-based word and document ids, one entry per token
  int N = w.size(); IntegerVector z(N); IntegerMatrix nwk(V, K), ndk(D, K); IntegerVector nk(K);
  for (int i = 0; i < N; i++) { int k = (int)(R::runif(0.0, 1.0) * K); z[i] = k; nwk(w[i], k)++; ndk(d[i], k)++; nk[k]++; }
  std::vector<double> p(K);
  for (int it = 0; it < iters; it++) for (int i = 0; i < N; i++) {
    int k = z[i]; nwk(w[i], k)--; ndk(d[i], k)--; nk[k]--;          // remove the current word
    double tot = 0;
    for (int j = 0; j < K; j++) { p[j] = (nwk(w[i], j) + beta) / (nk[j] + V * beta) * (ndk(d[i], j) + alpha); tot += p[j]; }
    double u = R::runif(0.0, 1.0) * tot; int kn = 0; double c = p[0];
    while (u > c && kn < K - 1) { kn++; c += p[kn]; }
    z[i] = kn; nwk(w[i], kn)++; ndk(d[i], kn)++; nk[kn]++;          // add it back with its new topic
  }
  return List::create(_["nwk"] = nwk, _["ndk"] = ndk);
}')
tok_all <- map(tokenize(fin$text), ~ .x[nchar(.x) > 2])
df_all <- table(unlist(map(tok_all, unique)))
lda_vocab <- names(df_all)[df_all >= 10 & df_all <= 0.15 * nrow(fin)]
ids <- map(tok_all, ~ { m <- match(.x, lda_vocab); m[!is.na(m)] })
set.seed(12)
lda <- lda_gibbs(unlist(ids) - 1L, rep(seq_along(ids), lengths(ids)) - 1L, K = 8L,
                 V = length(lda_vocab), D = length(ids), alpha = 0.5, beta = 0.05, iters = 300L)
phi <- sweep(lda$nwk + 0.05, 2, colSums(lda$nwk) + 0.05 * length(lda_vocab), "/")
theta <- (lda$ndk + 0.5) / rowSums(lda$ndk + 0.5)
c(vocabulary = length(lda_vocab), tokens = length(unlist(ids)))
tibble(topic = 1:8, top_words = map_chr(1:8, ~ paste(lda_vocab[order(-phi[, .x])][1:8], collapse = " ")))

vocabulary     tokens 
      4509     643607 
# A tibble: 8 x 2
  topic top_words                                                     
  <int> <chr>                                                         
1     1 credit card bank check information accounts fees online       
2     2 shares company's data its share dividend dividends companies  
3     3 funds fund investing investments portfolio stocks goals invest
4     4 loan credit mortgage car debt home off payments               
5     5 taxes expenses return year irs form state professional        
6     6 don't was much even years you're year now                     
7     7 currency rate rates prices exchange bond its bonds            
8     8 sell option capital trading order options shares trade        

After dropping very rare and very common words, 4,509 words remain, and the 7,866 answers contain 643,607 tokens of them. The eight topics are recognisably about different things: credit cards and banking; shares and dividends; investment funds and portfolios; loans and mortgages; taxes and the IRS; exchange rates and bonds; options trading; and one topic whose top words, "don't", "was", "much", "even", "years", "you're" and "now", are not about any subject at all. That last one is a style topic: the conversational filler of informal writing.

lab <- map_chr(1:8, ~ paste(lda_vocab[order(-phi[, .x])][1:3], collapse = " "))
as_tibble(theta, .name_repair = ~ lab) |> mutate(author = fin$author) |>
  pivot_longer(-author, names_to = "topic", values_to = "share") |>
  group_by(author, topic) |> summarise(share = mean(share), .groups = "drop") |>
  ggplot(aes(share, fct_reorder(topic, share), fill = author)) + geom_col(position = "dodge", width = 0.7) +
  scale_fill_manual(values = c(chatgpt = harbour[["rose"]], human = harbour[["sky"]]), labels = c(chatgpt = "ChatGPT", human = "human")) +
  labs(x = "average topic share", y = NULL, fill = NULL)

The model never saw the labels, yet one topic separates the authors almost by itself. The conversational topic makes up on average 35% of a human answer and 4% of a ChatGPT answer. Every subject topic is somewhat more prominent in ChatGPT's answers, which stay on the subject; human answers mix in asides, anecdotes and opinion. Exercise 4 shows that the eight topic proportions alone classify 92% of the test answers correctly. Reading topics this way needs care: Chang et al. (2009) found that the models that score best by held-out likelihood do not always produce the topics people find most coherent, and Wallach, Mimno and McCallum (2009) showed that the choice of $\alpha$ and $\beta$ matters more than is usually admitted. Topics are a lens chosen by the analyst, not a discovery of the true themes.

12.6 Can we trust the probabilities?

A classifier's probabilities are calibrated if, among all the documents it rates 80% likely to be ChatGPT's, about 80% are. Accuracy cannot reveal miscalibration, because it only uses which side of 50% a probability falls on. The reliability diagram does: group the test predictions into bins of predicted probability and plot the observed share of ChatGPT answers in each bin against the bin's average prediction. A calibrated classifier lies on the diagonal.

calib <- bind_rows(tibble(model = "naive Bayes", p = plogis(nb_logit(1)), y = test$ai),
                   tibble(model = "horseshoe logistic", p = p_hs, y = test$ai)) |>
  mutate(bin = cut(p, seq(0, 1, 0.1), include.lowest = TRUE)) |>
  group_by(model, bin) |> summarise(predicted = mean(p), observed = mean(y), n = n(), .groups = "drop")
ggplot(calib, aes(predicted, observed)) + geom_abline(colour = harbour[["muted"]], linetype = 2) +
  geom_line(colour = harbour[["sky"]]) + geom_point(aes(size = n), colour = harbour[["sky"]]) +
  facet_wrap(~ model) + coord_equal() + scale_size_area(max_size = 6) + scale_x_continuous(breaks = c(0, 0.5, 1)) +
  labs(x = "predicted probability of ChatGPT", y = "observed share ChatGPT", size = "answers")
calib |> select(-bin) |> mutate(across(c(predicted, observed), ~ round(.x, 3))) |> print(n = 20)

# A tibble: 20 x 4
   model              predicted observed     n
   <chr>                  <dbl>    <dbl> <int>
 1 horseshoe logistic     0.011    0.012  2472
 2 horseshoe logistic     0.146    0.095   190
 3 horseshoe logistic     0.246    0.288   125
 4 horseshoe logistic     0.346    0.37     92
 5 horseshoe logistic     0.45     0.333    75
 6 horseshoe logistic     0.551    0.511    88
 7 horseshoe logistic     0.65     0.582    67
 8 horseshoe logistic     0.75     0.83     88
 9 horseshoe logistic     0.855    0.876   161
10 horseshoe logistic     0.993    0.994  2508
11 naive Bayes            0.002    0.037  2860
12 naive Bayes            0.14     0.319    47
13 naive Bayes            0.25     0.238    21
14 naive Bayes            0.348    0.238    21
15 naive Bayes            0.448    0.667    18
16 naive Bayes            0.556    0.333    12
17 naive Bayes            0.654    0.292    24
18 naive Bayes            0.765    0.353    17
19 naive Bayes            0.856    0.292    24
20 naive Bayes            0.999    0.98   2822

The horseshoe model is close to calibrated: in its bins, the observed share of ChatGPT answers is within about 0.1 of the average prediction, and its two largest bins, near 0 and near 1, match almost exactly (0.011 predicted against 0.012 observed; 0.993 against 0.994). Naive Bayes is not. Its lowest bin holds 2,860 answers with an average predicted probability of 0.002, of which 3.7% are in fact ChatGPT's, eighteen times as many as claimed; its highest bin holds 2,822 answers with average prediction 0.999, of which 2.0% are human, twenty times as many as claimed. The few answers in between are scattered almost at random around the diagonal. This is the independence assumption at work: a ChatGPT answer that uses "important", "overall", "typically" and "may" is counted as four independent pieces of evidence, when in fact they are one piece of evidence (the style) seen four times.

The usual repair for an overconfident classifier is temperature scaling (Guo et al., 2017): divide every log-odds by a constant $T>1$ chosen to minimise the log loss on a held-out calibration set, which leaves the ranking (and the accuracy) unchanged and softens every probability. For naive Bayes, the right temperature has a meaning: if words were in effect redundant copies of each other, $T$ is roughly how many times each piece of evidence was counted. The widget applies temperature scaling to 1,000 of naive Bayes' test predictions.

12.7 A different kind of question

The real test of a detector is text unlike its training data. HC3's open-domain subset has general-knowledge questions ("What is a pulsar?"), each with a human answer from an existing question-answering set and ChatGPT answers. We take the first answer of each kind and apply the classifiers trained on finance answers, unchanged.

oqa <- read_hc3("open_qa")
X_oqa <- count_words(tokenize(oqa$text))
p_oqa_nb <- plogis(nb_logit(1, X_oqa)); p_oqa_hs <- colMeans(posterior_epred(m_text, newdata = mk(X_oqa, oqa$ai)))
rbind(naive_bayes = metrics(p_oqa_nb, oqa$ai), horseshoe_logistic = metrics(p_oqa_hs, oqa$ai)) |> round(3)
c(questions = n_distinct(oqa$q),
  median_words_human = median(str_count(oqa$text[oqa$ai == 0], "\\S+")),
  median_words_chatgpt = median(str_count(oqa$text[oqa$ai == 1], "\\S+")),
  human_flagged_nb = round(mean(p_oqa_nb[oqa$ai == 0] > 0.5), 3), chatgpt_caught_nb = round(mean(p_oqa_nb[oqa$ai == 1] > 0.5), 3),
  human_flagged_hs = round(mean(p_oqa_hs[oqa$ai == 0] > 0.5), 3), chatgpt_caught_hs = round(mean(p_oqa_hs[oqa$ai == 1] > 0.5), 3))

                   accuracy log_loss near_certain
naive_bayes           0.577    2.767        0.348
horseshoe_logistic    0.736    0.665        0.056
           questions   median_words_human median_words_chatgpt 
            1187.000               27.000              104.000 
    human_flagged_nb    chatgpt_caught_nb     human_flagged_hs 
               0.362                0.516                0.095 
   chatgpt_caught_hs 
               0.567 

Both detectors do much worse on open-domain answers. Naive Bayes falls from 95.7% to 57.7% accuracy, barely better than a coin, with a log loss of 2.77, far worse than the 0.69 of always saying 50%: it is confidently wrong. It flags 36.2% of the human answers as ChatGPT's and catches only 51.6% of ChatGPT's. The horseshoe model holds up better, at 73.6% accuracy and a log loss of 0.665, wrongly flagging 9.5% of the human answers but catching only 56.7% of ChatGPT's. The cause is visible in the answers themselves. The open-domain human answers are short (a median of 27 words, against 129 in finance) and encyclopaedic, not conversational, so the human "style" learned from finance answers is missing. And the formatting artefact reverses: only 0.2% of the open-domain ChatGPT answers contain a glued full stop, against 7.1% of the human answers. A detector is a description of its training data; the further the new text is from that data, the less its accuracy, and its probabilities, mean.

12.8 From words to pixels

An image is another bag of numbers. Fashion-MNIST (Xiao, Rasul and Vollgraf, 2017) is a drop-in replacement for the handwritten digits of MNIST (LeCun et al., 1998): 70,000 greyscale photographs of clothing from the online retailer Zalando, 28 by 28 pixels, in ten classes. Digits have become too easy; clothing is harder, and two of its classes, T-shirts and shirts, are genuinely confusable even for people. We take 1,000 training images and 2,000 test images of those two classes, average each 2 × 2 block of pixels to get 14 × 14 = 196 predictors, and fit a Bayesian logistic regression with a normal prior whose scale is learned from the data (the learned-scale ridge of Chapter 10).

fm <- "https://raw.githubusercontent.com/zalandoresearch/fashion-mnist/master/data/fashion/"
read_idx <- function(file, images = TRUE) {        # the IDX binary format of MNIST and Fashion-MNIST
  tmp <- tempfile(); download.file(paste0(fm, file), tmp, quiet = TRUE, mode = "wb")
  con <- gzfile(tmp, "rb"); on.exit(close(con))
  readBin(con, "integer", n = 1, endian = "big"); n <- readBin(con, "integer", n = 1, endian = "big")
  if (!images) return(as.integer(readBin(con, "raw", n = n)))
  dims <- readBin(con, "integer", n = 2, endian = "big")
  matrix(as.integer(readBin(con, "raw", n = n * prod(dims))), n, prod(dims), byrow = TRUE)
}
img_a <- read_idx("train-images-idx3-ubyte.gz"); lab_a <- read_idx("train-labels-idx1-ubyte.gz", FALSE)
img_b <- read_idx("t10k-images-idx3-ubyte.gz"); lab_b <- read_idx("t10k-labels-idx1-ubyte.gz", FALSE)
pool <- function(X) {                              # 28 x 28 -> 14 x 14 by averaging 2 x 2 blocks, scaled to 0-1
  cells <- expand.grid(col = 0:13, row = 0:13)
  sapply(seq_len(nrow(cells)), function(j) { r <- 2 * cells$row[j]; c0 <- 2 * cells$col[j]
    rowMeans(X[, c(r * 28 + c0, r * 28 + c0 + 1, (r + 1) * 28 + c0, (r + 1) * 28 + c0 + 1) + 1]) / 255 })
}
set.seed(12)
ia <- sample(which(lab_a %in% c(0, 6)), 1000); ib <- sample(which(lab_b %in% c(0, 6)), 2000)   # 0 = T-shirt/top, 6 = shirt
px_names <- sprintf("p%02d_%02d", rep(1:14, each = 14), rep(1:14, 14))
img_train <- as_tibble(pool(img_a[ia, ]), .name_repair = ~ px_names) |> mutate(shirt = as.integer(lab_a[ia] == 6))
img_test <- as_tibble(pool(img_b[ib, ]), .name_repair = ~ px_names) |> mutate(shirt = as.integer(lab_b[ib] == 6))
sb <- stanvar(scode = "real<lower=0> s_b;", block = "parameters") +
      stanvar(scode = "target += normal_lpdf(s_b | 0, 1);", block = "model")
m_img <- brm(shirt ~ ., data = img_train, family = bernoulli(), seed = 12, refresh = 0, stanvars = sb,
             prior = c(prior(normal(0, 2), class = Intercept), prior(normal(0, s_b), class = b)), file = "fits/ch12_img")
p_img <- colMeans(posterior_epred(m_img, newdata = img_test))
round(c(metrics(p_img, img_test$shirt), uncertain_0.2_0.8 = mean(p_img > 0.2 & p_img < 0.8)), 3)
round(posterior_summary(m_img, variable = "s_b"), 3)
c(divergences = rstan::get_num_divergent(m_img$fit), max_rhat = round(max(rhat(m_img), na.rm = TRUE), 3),
  min_bulk_ess = round(min(summarise_draws(as_draws_df(m_img), "ess_bulk")$ess_bulk, na.rm = TRUE)))

         accuracy          log_loss      near_certain uncertain_0.2_0.8 
            0.826             0.380             0.002             0.356 
    Estimate Est.Error  Q2.5 Q97.5
s_b    0.957     0.147 0.691 1.278
 divergences     max_rhat min_bulk_ess 
       0.000        1.006      390.000 

The model classifies 82.6% of the 2,000 test images correctly, with a log loss of 0.380, and it is appropriately unsure: 35.6% of its predictions fall between 0.2 and 0.8, and only 0.2% beyond 0.001 or 0.999. The learned prior scale $s_b$ is 0.96 (95% interval 0.69 to 1.28). The sampler had no divergent transitions, the largest $\widehat{R}$ was 1.006, and the smallest bulk effective sample size was 390, adequate for these summaries though lower than we would like for a paper.

draws_img <- as_draws_matrix(m_img, variable = paste0("b_", px_names))
cells <- tibble(name = px_names, row = rep(1:14, each = 14), col = rep(1:14, 14),
                mean = colMeans(draws_img), sd = apply(draws_img, 2, sd))
p1 <- ggplot(cells, aes(col, -row, fill = mean)) + geom_tile() +
  scale_fill_gradient2(low = harbour[["sky"]], mid = harbour[["grid"]], high = harbour[["rose"]], name = "mean") +
  coord_equal() + theme_void() + labs(title = "posterior mean")
p2 <- ggplot(cells, aes(col, -row, fill = sd)) + geom_tile() +
  scale_fill_gradient(low = harbour[["grid"]], high = harbour[["ink"]], name = "sd") +
  coord_equal() + theme_void() + labs(title = "posterior sd")
patchwork::wrap_plots(p1, p2)
cells |> arrange(desc(mean)) |> head(4); cells |> arrange(mean) |> head(4)
cor(abs(cells$mean), cells$sd)

# A tibble: 4 x 5
  name     row   col  mean    sd
  <chr>  <int> <int> <dbl> <dbl>
1 p07_04     7     4  1.35 0.713
2 p03_04     3     4  1.27 0.766
3 p11_11    11    11  1.14 0.799
4 p01_04     1     4  1.07 0.812
# A tibble: 4 x 5
  name     row   col  mean    sd
  <chr>  <int> <int> <dbl> <dbl>
1 p01_09     1     9 -1.92 0.644
2 p14_05    14     5 -1.60 0.751
3 p14_11    14    11 -1.34 0.718
4 p05_12     5    12 -1.19 0.724
[1] -0.1983

The coefficient map is not the picture of a shirt that one might hope for. The posterior means look like noise, and the posterior standard deviations (0.61 to 1.00) are larger than the means almost everywhere: only 1% of the 196 coefficients have a posterior mean more than two standard deviations from zero. The average size of a coefficient is 0.40. The model predicts reasonably well, but no single pixel carries much information, and with 196 predictors and 1,000 images the posterior cannot say which pixels matter. Prediction is good; interpretation of individual coefficients is not possible, the same lesson as the correlated house measurements of Chapter 10. The standard deviations are largest along the border of the image (0.87 on average, against 0.78 inside): border pixels are almost always empty, so their coefficients are determined by the prior, whose scale is about 0.96.

Draw a garment in the widget and the model computes a posterior predictive probability from 200 posterior draws of the coefficients, with an interval that shows how much the 1,000 training images pin it down.

Start from the blank canvas: with no ink, the probability is set by the intercept alone, and it is about 0.64 for "shirt", with a 90% interval from 0.53 to 0.76. Load the test images: most are classified sensibly, and some of the mistakes are understandable even to a person. Then paint along the outer border, where the coefficients are most uncertain, and watch the interval widen. The lesson is the one from the coefficient map: a model can predict tolerably while knowing very little about any one of its inputs. Convolutional neural networks do far better on this pair of classes, because they build in the fact that a feature is the same feature wherever it appears; Bayesian versions of them face the computational limits discussed in Section 10.9.

12.9 Exercises

Each exercise has a hint and an answer button.

Further reading and references

1. Blei, D. M., Ng, A. Y. and Jordan, M. I. (2003). Latent Dirichlet allocation. Journal of Machine Learning Research, 3, 993–1022.
2. Chang, J., Boyd-Graber, J., Gerrish, S., Wang, C. and Blei, D. M. (2009). Reading tea leaves: how humans interpret topic models. Advances in Neural Information Processing Systems, 22, 288–296.
3. Domingos, P. and Pazzani, M. (1997). On the optimality of the simple Bayesian classifier under zero-one loss. Machine Learning, 29, 103–130.
4. Graham, P. (2002). A plan for spam. paulgraham.com/spam.html.
5. Griffiths, T. L. and Steyvers, M. (2004). Finding scientific topics. Proceedings of the National Academy of Sciences, 101(suppl. 1), 5228–5235.
6. Guo, B., Zhang, X., Wang, Z., Jiang, M., Nie, J., Ding, Y., Yue, J. and Wu, Y. (2023). How close is ChatGPT to human experts? Comparison corpus, evaluation, and detection. arXiv:2301.07597.
7. Guo, C., Pleiss, G., Sun, Y. and Weinberger, K. Q. (2017). On calibration of modern neural networks. Proceedings of the 34th International Conference on Machine Learning, PMLR 70, 1321–1330.
8. LeCun, Y., Bottou, L., Bengio, Y. and Haffner, P. (1998). Gradient-based learning applied to document recognition. Proceedings of the IEEE, 86(11), 2278–2324.
9. Liang, W., Yuksekgonul, M., Mao, Y., Wu, E. and Zou, J. (2023). GPT detectors are biased against non-native English writers. Patterns, 4(7), 100779.
10. McCallum, A. and Nigam, K. (1998). A comparison of event models for naive Bayes text classification. AAAI-98 Workshop on Learning for Text Categorization, 41–48.
11. Mosteller, F. and Wallace, D. L. (1963). Inference in an authorship problem. Journal of the American Statistical Association, 58(302), 275–309.
12. Mosteller, F. and Wallace, D. L. (1964). Inference and Disputed Authorship: The Federalist. Addison-Wesley.
13. Pritchard, J. K., Stephens, M. and Donnelly, P. (2000). Inference of population structure using multilocus genotype data. Genetics, 155(2), 945–959.
14. Sahami, M., Dumais, S., Heckerman, D. and Horvitz, E. (1998). A Bayesian approach to filtering junk e-mail. AAAI-98 Workshop on Learning for Text Categorization, Technical Report WS-98-05.
15. Wallach, H. M., Mimno, D. and McCallum, A. (2009). Rethinking LDA: why priors matter. Advances in Neural Information Processing Systems, 22, 1973–1981.
16. Xiao, H., Rasul, K. and Vollgraf, R. (2017). Fashion-MNIST: a novel image dataset for benchmarking machine learning algorithms. arXiv:1708.07747.