E2 — LLM as Annotator + K1 Inter-annotator Agreement (Study 2)

Study 2 (PLAN.md §5 E2): (a) resolves empirically which column of the archived comparison file is the human annotation and which is the LLM prediction, (b) reproduces the LLM–human agreement (manuscript claim: 72.16 %, Cohen’s κ = 0.64), (c) computes K1 inter-annotator agreement on the overlap subset, all with cluster-bootstrap 95% CIs (B = 1000, seed 20260714), and (d) writes the manifest vystupy/tabulky/kap6_kodovani_cisla.csv.

suppressPackageStartupMessages({
  library(dplyr); library(tidyr); library(irr); library(digest)
})
SEED <- 20260714; set.seed(SEED)
H2 <- normalizePath(file.path(getwd(), "../.."))
CAPV <- file.path(H2, "data/raw/k1-kvalitativni-kodovani-2023-24/05-llm-klasifikace-capv")
SROV <- file.path(CAPV, "srovnani.csv")                      # zdroj (autor)
SROV_PUB <- file.path(H2, "data/processed/srovnani_k1_llm.csv")  # veřejná kopie (companion)
CLS7 <- file.path(CAPV, "vysledky_class_7.csv")
S4   <- file.path(H2, "data/raw/korpus/matice/Poslední záloha databáze 4.9.2024/matrix-annotated-22-08-2024 (2).csv")
LONG <- file.path(H2, "data/processed/anotace_long_k1.csv")
sha256 <- function(path) digest::digest(file = path, algo = "sha256")
manifest <- list()
put <- function(metric, value, sha) manifest[[length(manifest) + 1]] <<-
  data.frame(metric = metric, value = round(as.numeric(value), 4), data_sha = sha)

# srovnani.csv = id + kategorie člověka i modelu, BEZ textů a jmen → bezpečné
# zveřejnit. Autor čte zdroj z data/raw a zapisuje veřejnou kopii do
# data/processed; Binder čte veřejnou kopii. Oba stejný obsah = stejná čísla.
srov <- read.csv(SROV_PUB, encoding = "UTF-8")
SROV_SHA <- sha256(SROV_PUB)
# srovnani.csv (id + kategorie člověka i modelu, BEZ textů a jmen) je jediný vstup
# NUTNÝ pro míry shody → je veřejný v companionu a Studie 2 je plně reprodukovatelná
# v Binderu. Soubory class_7 a matice slouží JEN k ověření provenience sloupců
# (že solutions_annotated = člověk, main_category = archivovaný běh gpt-4o); jsou
# neveřejné a když chybí (Binder), provenienční kontrola se přeskočí.
# cls7 i s4 nesou duplicitní id → distinct před joinem (jinak pseudoreplikace,
# oprava 17. 7. 2026: 7 z 334 párů se množilo 5×).
HAVE_PROV <- file.exists(CLS7) && file.exists(S4)
if (HAVE_PROV) {
  cls7 <- read.csv(CLS7, encoding = "UTF-8") |> distinct(id, .keep_all = TRUE)
  s4 <- read.csv(S4, fileEncoding = "UTF-8-BOM")[, c("id", "solutions_annotated")] |>
    distinct(id, .keep_all = TRUE)
}

Source resolution: which column is human, which is LLM?

first_label <- function(x) trimws(sub("[;,].*$", "", x))
if (HAVE_PROV) {
  j <- srov |>
    left_join(cls7, by = "id") |>
    left_join(s4, by = "id", suffix = c("", "_s4"))
  stopifnot(nrow(j) == nrow(srov))   # 1 řádek = 1 kazuistika; žádná duplikace joinem
  # vysledky_class_7 ukládá verbózní odpověď modelu — hlavní kategorii je nutné
  # vyparsovat z řádku „Hlavní kategorie řešení: X" (naivní first_label na celém
  # textu dává falešnou 0% shodu — dřívější artefakt, opraveno 15. 7. 2026)
  parse_c7_main <- function(x) {
    m <- regexpr("Hlavní kategorie řešení:\\s*[^\n•]+", x, perl = TRUE)
    out <- rep(NA_character_, length(x))
    out[m > 0] <- trimws(sub("Hlavní kategorie řešení:\\s*", "", regmatches(x, m)))
    out
  }
  agree_main_class7 <- mean(trimws(j$main_category) == parse_c7_main(j$AI_class_sol), na.rm = TRUE)
  agree_hum_sol     <- mean(first_label(j$solutions_annotated) ==
                            first_label(j$solutions_annotated_s4), na.rm = TRUE)
  agree_hum_main    <- mean(first_label(j$main_category) ==
                            first_label(j$solutions_annotated_s4), na.rm = TRUE)
  res <- data.frame(hypoteza = c("main_category = class_7 (parsovaná hlavní kategorie)",
                                 "solutions = HUMAN (vs S4 matice)",
                                 "main_category vs S4 matice (= human×LLM agreement)"),
                    shoda = round(c(agree_main_class7, agree_hum_sol, agree_hum_main), 3))
  knitr::kable(res)
  # EMPIRICKÉ ROZŘEŠENÍ (revize 15. 7. 2026):
  # - main_category ≡ class_7 (100 % po korektním parsování verbózního výstupu)
  #   → modelový sloupec = archivovaný běh gpt-4o vysledky_class_7. ❓ VYŘEŠENO.
  # - solutions_annotated ≈ sloupec S4 matice (0.97 first-label) → ČLOVĚK
  #   (matice S4 nese sloučené lidské K1 kódy, viz skript 16 a DATA_README §2)
  # - shoda main×solutions (0.71) odpovídá publikovaným 72,16 % (ČAPV kód:
  #   match = main_category == solutions_annotated)
  stopifnot(agree_main_class7 == 1,        # main = doložený LLM běh class_7
            agree_hum_sol > 0.9)           # solutions = člověk, tvrdý assert
  put("overeni_solutions_je_clovek", agree_hum_sol, SROV_SHA)
  put("overeni_main_je_class7", agree_main_class7, SROV_SHA)
  put("overeni_main_vs_matice", agree_hum_main, SROV_SHA)
} else {
  # Binder / veřejný běh: provenienční soubory nejsou; míry shody se počítají
  # přímo ze sloupců srovnani.csv (člověk = solutions_annotated, model = main_category).
  j <- srov
  provenance <- read.csv(file.path(H2, "data/processed/kap6_provenience_souhrn.csv"))
  for (row_index in seq_len(nrow(provenance)))
    put(provenance$metric[row_index], provenance$value[row_index], provenance$data_sha[row_index])
  cat("Provenienční soubory (class_7, matice) nejsou přítomny — běh z veřejného",
      "srovnani.csv. Ověření provenience sloupců bylo provedeno autorem (viz kap. 6.2);",
      "míry shody níže se počítají přímo z kategorií.\n")
}

Provenienční soubory (class_7, matice) nejsou přítomny — běh z veřejného srovnani.csv. Ověření provenience sloupců bylo provedeno autorem (viz kap. 6.2); míry shody níže se počítají přímo z kategorií.

HUMAN <- "solutions_annotated"; LLM <- "main_category"; SECONDARY <- "secondary_categories"
cat("HUMAN =", HUMAN, "| LLM =", LLM, "| secondary = další štítky LLM\n")

HUMAN = solutions_annotated | LLM = main_category | secondary = další štítky LLM

put("n_archivnich_radku", nrow(srov), SROV_SHA)

LLM–human agreement: complete labels and historical reproduction

Exact match on the primary category; extended match (per the original CAPV code) counts agreement when the HUMAN label appears among the LLM’s main + secondary labels. Cohen’s κ on primary categories. Empty labels are not categories. The historical calculation is retained under separate keys; the main calculation requires a nonempty human and model label.

h <- first_label(j[[HUMAN]])
l <- first_label(j[[LLM]])
sec <- ifelse(is.na(j[[SECONDARY]]) | j[[SECONDARY]] %in% c("", "N/A"),
              "", j[[SECONDARY]])
put("historicka_shoda_presna", mean(h == l, na.rm = TRUE), SROV_SHA)
put("historicka_kappa", irr::kappa2(cbind(h, l))$value, SROV_SHA)
valid_pairs <- !is.na(h) & h != "" & !is.na(l) & l != ""
put("n_neuplnych_stitku", sum(!valid_pairs), SROV_SHA)
h <- h[valid_pairs]; l <- l[valid_pairs]; sec <- sec[valid_pairs]
put("n_paru_llm_clovek", length(h), SROV_SHA)
exact <- mean(h == l, na.rm = TRUE)
extended <- mean(mapply(function(hh, ll, ss) {
  hh %in% trimws(unlist(strsplit(paste(ll, ss, sep = ","), "[;,]")))
}, h, l, sec), na.rm = TRUE)
kap <- irr::kappa2(cbind(h, l))$value
# bootstrap CI přes páry
B <- 1000
set.seed(SEED)   # path-independentní bootstrap (viz níže K1)
n <- length(h)
bt <- replicate(B, {
  i <- sample.int(n, replace = TRUE)
  c(mean(h[i] == l[i], na.rm = TRUE), irr::kappa2(cbind(h[i], l[i]))$value)
})
ci_ex <- quantile(bt[1, ], c(.025, .975)); ci_k <- quantile(bt[2, ], c(.025, .975))
put("shoda_presna_llm", exact, SROV_SHA)
put("shoda_presna_ci_lo", ci_ex[1], SROV_SHA); put("shoda_presna_ci_hi", ci_ex[2], SROV_SHA)
put("shoda_rozsirena_llm", extended, SROV_SHA)
put("kappa_llm_clovek", kap, SROV_SHA)
put("kappa_ci_lo", ci_k[1], SROV_SHA); put("kappa_ci_hi", ci_k[2], SROV_SHA)
knitr::kable(data.frame(
  mira = c("přesná shoda", "rozšířená shoda (vč. sekundárních)", "Cohenovo κ"),
  hodnota = round(c(exact, extended, kap), 4),
  CI95 = c(sprintf("[%.3f; %.3f]", ci_ex[1], ci_ex[2]), "—",
           sprintf("[%.3f; %.3f]", ci_k[1], ci_k[2]))))

mira	hodnota	CI95
přesná shoda	0.7237	[0.676; 0.772]
rozšířená shoda (vč. sekundárních)	0.9339	—
Cohenovo κ	0.6445	[0.582; 0.703]

Schema note: the complete-label comparison uses 12 distinct human solution categories (the core K1 codebook set, see appendix A). The incomplete pair is excluded from the main analysis, not treated as a further class. The public HF release uses a different label set — documented drift, categories are never merged silently.

put("n_kategorii_reseni_srovnani", length(setdiff(unique(na.omit(h)), "")), SROV_SHA)

Per-category agreement and confusion matrix (book figures, ch. 6)

Per-category: among pairs where the HUMAN label is category c, how often does the model’s primary label match (model recall per human category). Confusion matrix: row = human, column = model, row-normalised. Both written as CSVs for fig_06_*.R; headline numbers into the manifest.

TABDIR <- file.path(H2, "vystupy/tabulky")
ok <- !is.na(h) & h != "" & !is.na(l) & l != ""
hh <- h[ok]; ll <- l[ok]
kat <- sort(unique(hh))
perkat <- data.frame(
  kategorie = kat,
  n_clovek = as.integer(table(factor(hh, levels = kat))),
  shoda = vapply(kat, function(c) mean(ll[hh == c] == c), numeric(1)))
perkat <- perkat[order(-perkat$n_clovek), ]
write.csv(perkat, file.path(TABDIR, "kap6_shoda_kategorie.csv"), row.names = FALSE)
for (i in seq_len(nrow(perkat))) {
  put(paste0("shoda_kat:", substr(perkat$kategorie[i], 1, 30)), perkat$shoda[i], SROV_SHA)
  put(paste0("n_kat:",     substr(perkat$kategorie[i], 1, 30)), perkat$n_clovek[i], SROV_SHA)
}
konf <- as.data.frame(prop.table(table(clovek = hh, model = ll), margin = 1))
names(konf)[3] <- "podil"
konf$n_radku <- as.integer(table(hh)[konf$clovek])
write.csv(konf, file.path(TABDIR, "kap6_konfuzni_matice.csv"), row.names = FALSE)
knitr::kable(perkat, digits = 3, caption = "Shoda modelu s člověkem po kategoriích")

Shoda modelu s člověkem po kategoriích

	kategorie	n_clovek	shoda
Rozhovor	Rozhovor	155	0.774
Podpora	Podpora	43	0.558
Nerespektující komunikace	Nerespektující komunikace	28	0.643
Spolupráce s odborníky	Spolupráce s odborníky	22	0.682
Upozornění	Upozornění	17	0.765
Důsledky	Důsledky	16	0.750
Práce s kolektivem	Práce s kolektivem	16	0.688
Přemístění žáka	Přemístění žáka	10	1.000
Dohoda	Dohoda	9	0.556
(Kázeňské) Tresty	(Kázeňské) Tresty	8	0.750
Fyzické zakročení	Fyzické zakročení	7	0.714
Proaktivní řešení	Proaktivní řešení	2	1.000

Post-audit sensitivity: exact overlap with archived prompt examples

The public flags contain identifiers and exact-overlap indicators, never case texts. Matching used the full solution after NFC, case and whitespace normalisation against the examples in archived notebook cell 108 (zero-based). This is a retrospective sensitivity analysis of stored predictions, not a new held-out experiment. Independently verifying the flags requires the private source texts; the reported sensitivity statistics can be reproduced publicly.

overlap_path <- file.path(H2, "data/processed/kap6_overlap_flags.csv")
overlap_flags <- read.csv(overlap_path, encoding = "UTF-8")
stopifnot(!anyDuplicated(overlap_flags$id), setequal(overlap_flags$id, srov$id))
overlap_pairs <- left_join(srov, overlap_flags, by = "id")
stopifnot(nrow(overlap_pairs) == nrow(srov), !anyNA(overlap_pairs$exact_overlap))
overlap_sha <- digest::digest(paste(SROV_SHA, sha256(overlap_path)), algo = "sha256")
put("n_vstupnich_prekryvu", sum(overlap_pairs$exact_overlap == 1), overlap_sha)
clean_pairs <- overlap_pairs[overlap_pairs$exact_overlap == 0, ]
clean_human <- first_label(clean_pairs[[HUMAN]])
clean_model <- first_label(clean_pairs[[LLM]])
complete_labels <- !is.na(clean_human) & clean_human != "" & !is.na(clean_model) & clean_model != ""
clean_human <- clean_human[complete_labels]; clean_model <- clean_model[complete_labels]
put("bez_prekryvu_n", length(clean_human), overlap_sha)
put("bez_prekryvu_shoda", mean(clean_human == clean_model), overlap_sha)
put("bez_prekryvu_kappa", irr::kappa2(cbind(clean_human, clean_model))$value, overlap_sha)
set.seed(SEED)
clean_bootstrap <- replicate(B, {
  selected_pairs <- sample.int(length(clean_human), replace = TRUE)
  c(mean(clean_human[selected_pairs] == clean_model[selected_pairs]),
    irr::kappa2(cbind(clean_human[selected_pairs], clean_model[selected_pairs]))$value)
})
clean_accuracy_ci <- quantile(clean_bootstrap[1, ], c(.025, .975))
clean_kappa_ci <- quantile(clean_bootstrap[2, ], c(.025, .975))
put("bez_prekryvu_shoda_ci_lo", clean_accuracy_ci[1], overlap_sha)
put("bez_prekryvu_shoda_ci_hi", clean_accuracy_ci[2], overlap_sha)
put("bez_prekryvu_kappa_ci_lo", clean_kappa_ci[1], overlap_sha)
put("bez_prekryvu_kappa_ci_hi", clean_kappa_ci[2], overlap_sha)
knitr::kable(bind_rows(manifest) |> filter(grepl("^bez_prekryvu|^n_vstupnich|^historicka", metric)))

metric	value	data_sha
historicka_shoda_presna	0.7216	b9a3b31763a2a74bd9d628c8d95271addeaf7000c584036eafbfc3178b1f0f50
historicka_kappa	0.6423	b9a3b31763a2a74bd9d628c8d95271addeaf7000c584036eafbfc3178b1f0f50
n_vstupnich_prekryvu	36.0000	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_n	297.0000	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_shoda	0.7138	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_kappa	0.6143	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_shoda_ci_lo	0.6599	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_shoda_ci_hi	0.7677	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_kappa_ci_lo	0.5492	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c
bez_prekryvu_kappa_ci_hi	0.6821	24fd3562e68c10643b7e387db7d1614b637a35e3cb61d7308a9dad52798ab86c

K1 inter-annotator agreement (overlap subset, human coding)

From the tidy table (primary category per case × annotator × dimension); units rated by ≥2 of the 5 annotators. Krippendorff’s alpha (nominal) with cluster bootstrap over cases; multi-label Jaccard over all assigned categories.

LONG_SHA <- sha256(LONG)
k1 <- read.csv(LONG, encoding = "UTF-8") |>
  filter(!is.na(case_uid), case_uid != "") |>
  # „Diagnóza" byla položkou stromu V2, ale nepopisuje chování; shodu
  # dimenze proto počítáme nad stejnými 13 behaviorálními kategoriemi jako
  # deskriptivu Studie 1. Po vyřazení případně povýšíme další přiřazený
  # behaviorální kód na primární, místo abychom celou anotaci zahodili.
  filter(!(dimenze == "chovani" & hodnota == "Diagnóza"))
K1_DIMS <- unique(k1$dimenze)  # zachovat původní pořadí i proud RNG bootstrapu
prim <- k1 |>
  group_by(case_uid, anotator, dimenze) |>
  # `filter()` zachová původní pořadí řádků, a tím i přesně stejný
  # bootstrapový proud pro nezměněné dimenze řešení a dopadu.
  filter(poradi == min(poradi)) |>
  ungroup() |>
  distinct(case_uid, anotator, dimenze, .keep_all = TRUE) |>
  select(case_uid, anotator, dimenze, hodnota)
alpha_nom <- function(d) {
  w <- d |> distinct(anotator, case_uid, .keep_all = TRUE) |>
    pivot_wider(names_from = case_uid, values_from = hodnota,
                id_cols = anotator)
  m <- as.matrix(w[, -1])
  m <- m[, colSums(!is.na(m)) >= 2, drop = FALSE]
  if (ncol(m) < 2) return(c(a = NA, n = ncol(m)))
  c(a = suppressWarnings(irr::kripp.alpha(m, method = "nominal")$value), n = ncol(m))
}
B <- 1000
set.seed(SEED)   # přeseedovat: bootstrap nesmí záviset na spotřebě RNG dřívějšími
                 # (podmíněnými) bloky — jinak se CI liší mezi během autora a Binderem
k1_rows <- lapply(K1_DIMS, function(dm) {
  d <- prim |> filter(dimenze == dm)
  base <- alpha_nom(d)
  # Stabilní pořadí jednotek + vlastní seed pro každou dimenzi: změna jedné
  # dimenze nesmí posunout bootstrapové intervaly ostatních dimenzí.
  cases <- sort(unique(d$case_uid))
  wide <- d |> pivot_wider(names_from = case_uid, values_from = hodnota, id_cols = anotator)
  ratings <- as.matrix(wide[, -1, drop = FALSE])[, cases, drop = FALSE]
  set.seed(SEED + match(dm, K1_DIMS))
  boots <- vapply(seq_len(B), function(b) {
    samp <- sample(cases, replace = TRUE)
    sampled_ratings <- ratings[, samp, drop = FALSE]
    sampled_ratings <- sampled_ratings[, colSums(!is.na(sampled_ratings)) >= 2, drop = FALSE]
    if (ncol(sampled_ratings) < 2) return(NA_real_)
    suppressWarnings(irr::kripp.alpha(sampled_ratings, method = "nominal")$value)
  }, numeric(1))
  ci <- quantile(boots, c(.025, .975), na.rm = TRUE)
  put(paste0("k1_alpha_nom_", dm), base["a"], LONG_SHA)
  put(paste0("k1_alpha_ci_lo_", dm), ci[1], LONG_SHA)
  put(paste0("k1_alpha_ci_hi_", dm), ci[2], LONG_SHA)
  put(paste0("k1_n_prekryv_", dm), base["n"], LONG_SHA)
  data.frame(dimenze = dm, alpha = base["a"], ci_lo = ci[1], ci_hi = ci[2],
             n_jednotek = base["n"])
})
knitr::kable(bind_rows(k1_rows), digits = 3, row.names = FALSE)

dimenze	alpha	ci_lo	ci_hi	n_jednotek
chovani	0.495	0.414	0.578	85
reseni	0.287	0.191	0.376	89
dopad	0.725	0.626	0.811	85

# multi-label Jaccard (všechny přiřazené kategorie)
jac_rows <- lapply(K1_DIMS, function(dm) {
  d <- k1 |> filter(dimenze == dm) |>
    group_by(case_uid, anotator) |>
    summarise(s = list(unique(hodnota)), .groups = "drop")
  by_case <- split(d, d$case_uid)
  js <- unlist(lapply(by_case, function(g) {
    if (nrow(g) < 2) return(NULL)
    out <- c()
    for (i in 1:(nrow(g) - 1)) for (jj in (i + 1):nrow(g)) {
      u <- union(g$s[[i]], g$s[[jj]])
      out <- c(out, length(intersect(g$s[[i]], g$s[[jj]])) / length(u))
    }
    out
  }))
  put(paste0("k1_jaccard_", dm), mean(js), LONG_SHA)
  data.frame(dimenze = dm, jaccard = mean(js), n_paru = length(js))
})
knitr::kable(bind_rows(jac_rows), digits = 3, row.names = FALSE)

dimenze	jaccard	n_paru
chovani	0.610	469
reseni	0.557	486
dopad	0.859	459

Freeze: write manifest

out <- bind_rows(manifest) |>
  mutate(skript = "analyzy/notebooks/20_kodovani_llm.qmd", seed = SEED,
         datum = format(Sys.Date())) |>
  select(metric, value, skript, data_sha, seed, datum)
write.csv(out, file.path(H2, "vystupy/tabulky/kap6_kodovani_cisla.csv"), row.names = FALSE)
cat("Manifest:", nrow(out), "metrik → vystupy/tabulky/kap6_kodovani_cisla.csv\n")

Manifest: 63 metrik → vystupy/tabulky/kap6_kodovani_cisla.csv