suppressPackageStartupMessages({
library(dplyr); library(tidyr); library(irr); library(irrCAC); library(digest)
})
SEED <- 20260714
set.seed(SEED)
B <- 1000
ROOT <- normalizePath(file.path(getwd(), "..")) # analyzy/
H2 <- normalizePath(file.path(ROOT, "..")) # habilitace-2/
PROC <- file.path(H2, "data/processed")
W <- read.csv(file.path(PROC, "k3_wide.csv"), encoding = "UTF-8", stringsAsFactors = FALSE)
PK <- read.csv(file.path(PROC, "k1_k3_pary.csv"), encoding = "UTF-8", stringsAsFactors = FALSE)
input_names <- c("k3_wide.csv", "k1_k3_pary.csv", "k3_segmenty.csv",
"k3_monitoring_log.csv", "k3_cervenec_souhrn.csv", "k3_adjudikace_souhrn.csv")
input_hashes <- vapply(file.path(PROC, input_names), function(path) digest(file = path, algo = "sha256"), character(1))
DATA_SHA <- digest(paste(input_names, input_hashes, collapse = "\n"), algo = "sha256", serialize = FALSE)
W$case_uid[is.na(W$case_uid)] <- ""
W$kvalita[W$kvalita == ""] <- NA; W$dopad[W$dopad == ""] <- NA
stopifnot(all(W$anotator %in% c("A12", "A2")))
manifest <- list()
put <- function(metric, value) manifest[[length(manifest) + 1]] <<-
data.frame(metric = metric, value = round(as.numeric(value), 4))
pct <- function(x) round(100 * x, 1)
# ── agreement helpers (two raters, one row per unit) ──────────────────────
exact <- function(a, b) mean(a == b)
kappa_nom <- function(a, b) irr::kappa2(cbind(a, b))$value
kappa_w <- function(a, b) irr::kappa2(cbind(a, b), weight = "squared")$value
alpha_nom <- function(a, b) irr::kripp.alpha(rbind(as.integer(factor(c(a, b)))[seq_along(a)],
as.integer(factor(c(a, b)))[-seq_along(a)]),
method = "nominal")$value
alpha_ord <- function(a, b) irr::kripp.alpha(rbind(a, b), method = "ordinal")$value
ac1 <- function(a, b) irrCAC::gwet.ac1.raw(data.frame(a, b))$est$coeff.val
ac2 <- function(a, b) irrCAC::gwet.ac1.raw(data.frame(a, b), weights = "quadratic")$est$coeff.val
boot_ci <- function(a, b, f, B = 1000) {
# Seed per call: an interval must not depend on how many bootstraps ran earlier in
# the notebook, otherwise adding a section silently changes every later interval.
set.seed(SEED)
n <- length(a); v <- replicate(B, { i <- sample.int(n, n, TRUE); f(a[i], b[i]) })
quantile(v, c(.025, .975), na.rm = TRUE, names = FALSE)
}E4 — Quality of case studies, reliability and K1 × K3 (Study 4, K3 campaign)
Frozen analysis of the third annotation campaign (K3) on the slice K3_freeze_2026-09-08 (PLAN.md §5 E4). Inputs are derived tables without case texts (data/processed/): k3_wide.csv (one row = case × annotator, A12 / A2), k1_k3_pary.csv (cases coded in K1 (2024) and K3 (2026)), anotace_pokryti.csv, the July monitoring point (k3_monitoring_log.csv), historical July and adjudication summaries (k3_cervenec_souhrn.csv, k3_adjudikace_souhrn.csv) and reconstructed segments (k3_segmenty.csv). These historical summaries are supplied inputs, not a newly repeated annotation or source-text audit. Pre-specified protocol: Gwet AC1 next to κ/α; primary reliability excludes adjudicated cases (cases listed in the July recalibration briefing), the full overlap is reported as sensitivity; appropriateness K2 (1–5) and K3 (1–4) are never merged. Writes vystupy/tabulky/kap8_kvalita_cisla.csv (+ kap8_matice_zamen.csv, kap8_reseni_dopad.csv, kap8_kvartily.csv, kap8_segmenty.csv).
1 Scope and coverage
for (a in c("A12", "A2")) {
wa <- W[W$anotator == a, ]
put(paste0("n_radku_", a), nrow(wa))
put(paste0("pokryti_kvalita_", a), mean(!is.na(wa$kvalita)))
put(paste0("pokryti_dopad_", a), mean(!is.na(wa$dopad)))
put(paste0("pokryti_vhodnost_", a), mean(!is.na(wa$vhodnost)))
put(paste0("adjudikovano_radku_", a), sum(wa$adjudikovano))
}
uids <- unique(W$case_uid[W$case_uid != ""])
put("n_kazuistik_k3_unikat", length(uids))
put("n_kazuistik_k3_horni_mez", length(uids) + sum(W$case_uid == ""))
put("n_radku_bez_uid", sum(W$case_uid == ""))
ov <- W %>% filter(case_uid != "") %>% count(case_uid) %>% filter(n == 2)
put("n_prekryv", nrow(ov))
adj_uid <- unique(W$case_uid[W$adjudikovano == 1 & W$case_uid != ""])
put("n_prekryv_adjudikovano", sum(ov$case_uid %in% adj_uid))
knitr::kable(bind_rows(manifest))| metric | value |
|---|---|
| n_radku_A12 | 1947.0000 |
| pokryti_kvalita_A12 | 1.0000 |
| pokryti_dopad_A12 | 0.9671 |
| pokryti_vhodnost_A12 | 0.9692 |
| adjudikovano_radku_A12 | 64.0000 |
| n_radku_A2 | 1938.0000 |
| pokryti_kvalita_A2 | 1.0000 |
| pokryti_dopad_A2 | 0.9639 |
| pokryti_vhodnost_A2 | 0.9644 |
| adjudikovano_radku_A2 | 64.0000 |
| n_kazuistik_k3_unikat | 3185.0000 |
| n_kazuistik_k3_horni_mez | 3192.0000 |
| n_radku_bez_uid | 7.0000 |
| n_prekryv | 693.0000 |
| n_prekryv_adjudikovano | 64.0000 |
2 Distributions per annotator
for (a in c("A12", "A2")) {
wa <- W[W$anotator == a, ]
tk <- table(wa$kvalita); td <- table(wa$dopad); tv <- table(wa$vhodnost)
put(paste0("kvalita_plocha_n_", a), sum(wa$kvalita == "Plochá", na.rm = TRUE))
put(paste0("kvalita_plocha_podil_", a), sum(wa$kvalita == "Plochá", na.rm = TRUE) / sum(!is.na(wa$kvalita)))
put(paste0("kvalita_plna_n_", a), sum(wa$kvalita == "Plná", na.rm = TRUE))
for (k in c("Neúspěch", "Krátkodobý úspěch", "Dlouhodobý úspěch")) {
key <- c("Neúspěch" = "NEU", "Krátkodobý úspěch" = "KU", "Dlouhodobý úspěch" = "DU")[[k]]
put(paste0("dopad_", key, "_n_", a), sum(wa$dopad == k, na.rm = TRUE))
put(paste0("dopad_", key, "_podil_", a), sum(wa$dopad == k, na.rm = TRUE) / sum(!is.na(wa$dopad)))
}
for (v in 1:4) {
put(paste0("vhodnost_", v, "_n_", a), sum(wa$vhodnost == v, na.rm = TRUE))
put(paste0("vhodnost_", v, "_podil_", a), sum(wa$vhodnost == v, na.rm = TRUE) / sum(!is.na(wa$vhodnost)))
}
put(paste0("vhodnost_prumer_", a), mean(wa$vhodnost, na.rm = TRUE))
pl <- wa[wa$kvalita %in% "Plochá", ]; pn <- wa[wa$kvalita %in% "Plná", ]
put(paste0("plocha_bez_dopadu_", a), sum(is.na(pl$dopad)))
put(paste0("plocha_bez_vhodnosti_", a), sum(is.na(pl$vhodnost)))
put(paste0("plna_bez_dopadu_", a), sum(is.na(pn$dopad)))
put(paste0("chybi_dopad_", a), sum(is.na(wa$dopad)))
# comments and text lengths
put(paste0("komentar_jazykovy_n_", a), sum(wa$komentar_jazykovy))
put(paste0("komentar_plocha_n_", a), sum(wa$komentar_plocha))
put(paste0("komentar_dalsi_n_", a), sum(wa$komentar_dalsi))
put(paste0("otazniky_n_", a), sum(wa$otazniky))
put(paste0("tema_strojovy_preklad_n_", a), sum(wa$tema_strojovy_preklad))
put(paste0("plocha_s_komentarem_", a), sum(pl$komentar_plocha))
}
w12 <- W[W$anotator == "A12", ]
for (p in c("popis", "anamneza", "reseni", "vystup"))
put(paste0("median_znaku_", p), median(w12[[paste0("n_znaku_", p)]]))3 Reliability on the double-coded overlap
Primary set = overlap without cases discussed at the July recalibration meeting (they are not independent double measurements); sensitivity = full overlap. Bootstrap over cases, B = 1000, seed 2.0260714^{7}.
P <- W %>% filter(case_uid %in% ov$case_uid) %>%
select(case_uid, anotator, kvalita, dopad, vhodnost, adjudikovano) %>%
pivot_wider(id_cols = case_uid, names_from = anotator,
values_from = c(kvalita, dopad, vhodnost, adjudikovano))
P$adj <- pmax(P$adjudikovano_A12, P$adjudikovano_A2)
P$poradi <- W$poradi[match(P$case_uid, W$case_uid[W$anotator == "A12"])]
prim <- P[P$adj == 0, ]
rel <- function(D, prefix, dimensions = c("kvalita", "dopad", "vhodnost")) {
# kvalita, dopad: nominal; vhodnost: ordinal
for (dim in dimensions) {
a <- D[[paste0(dim, "_A12")]]; b <- D[[paste0(dim, "_A2")]]
ok <- !is.na(a) & !is.na(b); a <- a[ok]; b <- b[ok]
key <- paste0(prefix, dim)
put(paste0(key, "_n"), length(a))
put(paste0(key, "_presna"), exact(a, b))
ci <- boot_ci(a, b, exact, B); put(paste0(key, "_presna_ci_lo"), ci[1]); put(paste0(key, "_presna_ci_hi"), ci[2])
if (dim == "vhodnost") {
put(paste0(key, "_pm1"), mean(abs(a - b) <= 1))
put(paste0(key, "_wkappa"), kappa_w(a, b))
ci <- boot_ci(a, b, kappa_w, B); put(paste0(key, "_wkappa_ci_lo"), ci[1]); put(paste0(key, "_wkappa_ci_hi"), ci[2])
put(paste0(key, "_alpha_ord"), alpha_ord(a, b))
ci <- boot_ci(a, b, alpha_ord, B); put(paste0(key, "_alpha_ord_ci_lo"), ci[1]); put(paste0(key, "_alpha_ord_ci_hi"), ci[2])
put(paste0(key, "_ac1"), ac1(a, b)); put(paste0(key, "_ac2"), ac2(a, b))
ci <- boot_ci(a, b, ac1, B); put(paste0(key, "_ac1_ci_lo"), ci[1]); put(paste0(key, "_ac1_ci_hi"), ci[2])
put(paste0(key, "_A2_vyssi"), sum(b > a)); put(paste0(key, "_A12_vyssi"), sum(a > b))
put(paste0(key, "_prumer_A12"), mean(a)); put(paste0(key, "_prumer_A2"), mean(b))
put(paste0(key, "_rozdil_prumer"), mean(b - a))
ci <- boot_ci(a, b, function(x, y) mean(y - x), B)
put(paste0(key, "_rozdil_ci_lo"), ci[1]); put(paste0(key, "_rozdil_ci_hi"), ci[2])
} else {
put(paste0(key, "_kappa"), kappa_nom(a, b))
ci <- boot_ci(a, b, kappa_nom, B); put(paste0(key, "_kappa_ci_lo"), ci[1]); put(paste0(key, "_kappa_ci_hi"), ci[2])
put(paste0(key, "_alpha"), alpha_nom(a, b))
ci <- boot_ci(a, b, alpha_nom, B); put(paste0(key, "_alpha_ci_lo"), ci[1]); put(paste0(key, "_alpha_ci_hi"), ci[2])
put(paste0(key, "_ac1"), ac1(a, b))
ci <- boot_ci(a, b, ac1, B); put(paste0(key, "_ac1_ci_lo"), ci[1]); put(paste0(key, "_ac1_ci_hi"), ci[2])
}
}
}
rel(prim, "shoda_") # primary (without adjudicated)
rel(P, "plny_") # sensitivity (full overlap)
complete_quality <- prim[prim$kvalita_A12 == "Plná" & prim$kvalita_A2 == "Plná", ]
rel(complete_quality, "obe_plne_", dimensions = c("dopad", "vhodnost"))
for (annotator in c("A12", "A2")) {
flat_records <- W[W$anotator == annotator & W$kvalita %in% "Plochá", ]
put(paste0("plocha_s_dopadem_", annotator), sum(!is.na(flat_records$dopad)))
put(paste0("plocha_s_vhodnosti_", annotator), sum(!is.na(flat_records$vhodnost)))
}
# confusion matrices (full overlap; A12 rows, A2 columns)
mz <- bind_rows(lapply(c("kvalita", "dopad", "vhodnost"), function(dim) {
a <- P[[paste0(dim, "_A12")]]; b <- P[[paste0(dim, "_A2")]]
ok <- !is.na(a) & !is.na(b)
as.data.frame(table(A12 = a[ok], A2 = b[ok])) %>% mutate(dimenze = dim) %>%
rename(n = Freq) %>% select(dimenze, A12, A2, n)
}))
write.csv(mz, file.path(H2, "vystupy/tabulky/kap8_matice_zamen.csv"), row.names = FALSE)
rec <- bind_rows(manifest); knitr::kable(rec[grepl("^shoda_|^plny_", rec$metric), ])| metric | value | |
|---|---|---|
| 76 | shoda_kvalita_n | 629.0000 |
| 77 | shoda_kvalita_presna | 0.9793 |
| 78 | shoda_kvalita_presna_ci_lo | 0.9682 |
| 79 | shoda_kvalita_presna_ci_hi | 0.9905 |
| 80 | shoda_kvalita_kappa | 0.7689 |
| 81 | shoda_kvalita_kappa_ci_lo | 0.6378 |
| 82 | shoda_kvalita_kappa_ci_hi | 0.8794 |
| 83 | shoda_kvalita_alpha | 0.7690 |
| 84 | shoda_kvalita_alpha_ci_lo | 0.6375 |
| 85 | shoda_kvalita_alpha_ci_hi | 0.8795 |
| 86 | shoda_kvalita_ac1 | 0.9773 |
| 87 | shoda_kvalita_ac1_ci_lo | 0.9638 |
| 88 | shoda_kvalita_ac1_ci_hi | 0.9896 |
| 89 | shoda_dopad_n | 603.0000 |
| 90 | shoda_dopad_presna | 0.8109 |
| 91 | shoda_dopad_presna_ci_lo | 0.7778 |
| 92 | shoda_dopad_presna_ci_hi | 0.8408 |
| 93 | shoda_dopad_kappa | 0.6875 |
| 94 | shoda_dopad_kappa_ci_lo | 0.6349 |
| 95 | shoda_dopad_kappa_ci_hi | 0.7368 |
| 96 | shoda_dopad_alpha | 0.6874 |
| 97 | shoda_dopad_alpha_ci_lo | 0.6344 |
| 98 | shoda_dopad_alpha_ci_hi | 0.7367 |
| 99 | shoda_dopad_ac1 | 0.7291 |
| 100 | shoda_dopad_ac1_ci_lo | 0.6799 |
| 101 | shoda_dopad_ac1_ci_hi | 0.7738 |
| 102 | shoda_vhodnost_n | 603.0000 |
| 103 | shoda_vhodnost_presna | 0.5788 |
| 104 | shoda_vhodnost_presna_ci_lo | 0.5423 |
| 105 | shoda_vhodnost_presna_ci_hi | 0.6202 |
| 106 | shoda_vhodnost_pm1 | 0.9801 |
| 107 | shoda_vhodnost_wkappa | 0.5188 |
| 108 | shoda_vhodnost_wkappa_ci_lo | 0.4550 |
| 109 | shoda_vhodnost_wkappa_ci_hi | 0.5826 |
| 110 | shoda_vhodnost_alpha_ord | 0.5009 |
| 111 | shoda_vhodnost_alpha_ord_ci_lo | 0.4409 |
| 112 | shoda_vhodnost_alpha_ord_ci_hi | 0.5651 |
| 113 | shoda_vhodnost_ac1 | 0.4729 |
| 114 | shoda_vhodnost_ac2 | 0.8705 |
| 115 | shoda_vhodnost_ac1_ci_lo | 0.4253 |
| 116 | shoda_vhodnost_ac1_ci_hi | 0.5243 |
| 117 | shoda_vhodnost_A2_vyssi | 149.0000 |
| 118 | shoda_vhodnost_A12_vyssi | 105.0000 |
| 119 | shoda_vhodnost_prumer_A12 | 3.3035 |
| 120 | shoda_vhodnost_prumer_A2 | 3.3715 |
| 121 | shoda_vhodnost_rozdil_prumer | 0.0680 |
| 122 | shoda_vhodnost_rozdil_ci_lo | 0.0100 |
| 123 | shoda_vhodnost_rozdil_ci_hi | 0.1227 |
| 124 | plny_kvalita_n | 693.0000 |
| 125 | plny_kvalita_presna | 0.9683 |
| 126 | plny_kvalita_presna_ci_lo | 0.9553 |
| 127 | plny_kvalita_presna_ci_hi | 0.9812 |
| 128 | plny_kvalita_kappa | 0.6695 |
| 129 | plny_kvalita_kappa_ci_lo | 0.5273 |
| 130 | plny_kvalita_kappa_ci_hi | 0.7898 |
| 131 | plny_kvalita_alpha | 0.6692 |
| 132 | plny_kvalita_alpha_ci_lo | 0.5261 |
| 133 | plny_kvalita_alpha_ci_hi | 0.7896 |
| 134 | plny_kvalita_ac1 | 0.9649 |
| 135 | plny_kvalita_ac1_ci_lo | 0.9502 |
| 136 | plny_kvalita_ac1_ci_hi | 0.9793 |
| 137 | plny_dopad_n | 663.0000 |
| 138 | plny_dopad_presna | 0.8009 |
| 139 | plny_dopad_presna_ci_lo | 0.7692 |
| 140 | plny_dopad_presna_ci_hi | 0.8296 |
| 141 | plny_dopad_kappa | 0.6739 |
| 142 | plny_dopad_kappa_ci_lo | 0.6236 |
| 143 | plny_dopad_kappa_ci_hi | 0.7211 |
| 144 | plny_dopad_alpha | 0.6735 |
| 145 | plny_dopad_alpha_ci_lo | 0.6229 |
| 146 | plny_dopad_alpha_ci_hi | 0.7208 |
| 147 | plny_dopad_ac1 | 0.7137 |
| 148 | plny_dopad_ac1_ci_lo | 0.6680 |
| 149 | plny_dopad_ac1_ci_hi | 0.7554 |
| 150 | plny_vhodnost_n | 664.0000 |
| 151 | plny_vhodnost_presna | 0.5813 |
| 152 | plny_vhodnost_presna_ci_lo | 0.5437 |
| 153 | plny_vhodnost_presna_ci_hi | 0.6175 |
| 154 | plny_vhodnost_pm1 | 0.9789 |
| 155 | plny_vhodnost_wkappa | 0.5314 |
| 156 | plny_vhodnost_wkappa_ci_lo | 0.4695 |
| 157 | plny_vhodnost_wkappa_ci_hi | 0.5808 |
| 158 | plny_vhodnost_alpha_ord | 0.5101 |
| 159 | plny_vhodnost_alpha_ord_ci_lo | 0.4469 |
| 160 | plny_vhodnost_alpha_ord_ci_hi | 0.5611 |
| 161 | plny_vhodnost_ac1 | 0.4753 |
| 162 | plny_vhodnost_ac2 | 0.8694 |
| 163 | plny_vhodnost_ac1_ci_lo | 0.4275 |
| 164 | plny_vhodnost_ac1_ci_hi | 0.5223 |
| 165 | plny_vhodnost_A2_vyssi | 171.0000 |
| 166 | plny_vhodnost_A12_vyssi | 107.0000 |
| 167 | plny_vhodnost_prumer_A12 | 3.2801 |
| 168 | plny_vhodnost_prumer_A2 | 3.3750 |
| 169 | plny_vhodnost_rozdil_prumer | 0.0949 |
| 170 | plny_vhodnost_rozdil_ci_lo | 0.0452 |
| 171 | plny_vhodnost_rozdil_ci_hi | 0.1446 |
4 Recalibration: July monitoring point and order quartiles
log <- file.path(PROC, "k3_monitoring_log.csv")
stopifnot(file.exists(log))
if (file.exists(log)) {
m <- read.csv(log, encoding = "UTF-8"); m <- m[m$datum == "2026-07-16", ]
put("cervenec_prekryv_n", m$prekryv_hotovo)
put("cervenec_vhodnost_n", m$vhodnost_n); put("cervenec_vhodnost_presna", m$vhodnost_shoda)
put("cervenec_vhodnost_wkappa", m$vhodnost_koef); put("cervenec_vhodnost_ac1", m$vhodnost_ac1)
put("cervenec_dopad_n", m$dopad_n); put("cervenec_dopad_presna", m$dopad_shoda); put("cervenec_dopad_kappa", m$dopad_koef)
put("cervenec_kvalita_n", m$kvalita_n); put("cervenec_kvalita_presna", m$kvalita_shoda); put("cervenec_kvalita_ac1", m$kvalita_ac1)
}
# direction of the July drift from the recalibration briefing (text parsed, no case texts)
july_summary <- read.csv(file.path(PROC, "k3_cervenec_souhrn.csv"))
for (summary_row in seq_len(nrow(july_summary)))
put(july_summary$metric[summary_row], july_summary$value[summary_row])
# quartiles of the full overlap by A12 processing order (exploratory)
Q <- P %>% arrange(poradi) %>% mutate(kvartil = ntile(poradi, 4))
kv <- bind_rows(lapply(1:4, function(q) {
d <- Q[Q$kvartil == q, ]; out <- data.frame(kvartil = q, n = nrow(d))
for (dim in c("kvalita", "dopad", "vhodnost")) {
a <- d[[paste0(dim, "_A12")]]; b <- d[[paste0(dim, "_A2")]]; ok <- !is.na(a) & !is.na(b)
out[[paste0(dim, "_presna")]] <- exact(a[ok], b[ok])
put(paste0("kvartil", q, "_", dim, "_presna"), exact(a[ok], b[ok]))
}
out
}))
write.csv(kv, file.path(H2, "vystupy/tabulky/kap8_kvartily.csv"), row.names = FALSE)
# Segments before/after the recalibration, reconstructed by 28_k3_segmenty.py from the
# July snapshot of both tables (backup of 2026-07-22 = state before the meeting; the
# script verifies it reproduces the July monitoring point exactly).
# beze_zmeny = rated by 22 July and unchanged since -> BEFORE the recalibration
# jen_finale = rated only after 22 July -> AFTER the recalibration
# zmeneno = rated in July and rewritten afterwards (retroactive revision)
seg_f <- file.path(PROC, "k3_segmenty.csv")
if (file.exists(seg_f)) {
SG <- read.csv(seg_f, encoding = "UTF-8")
put("segmenty_dostupne", 1)
put("seg_beze_zmeny_n", sum(SG$segment == "beze_zmeny"))
put("seg_jen_finale_n", sum(SG$segment == "jen_finale"))
put("seg_zmeneno_n", sum(SG$segment == "zmeneno"))
put("seg_zmeneno_A12", sum(SG$segment == "zmeneno" & SG$anotator == "A12"))
put("seg_zmeneno_A2", sum(SG$segment == "zmeneno" & SG$anotator == "A2"))
for (dim in c("kvalita", "dopad", "vhodnost"))
put(paste0("seg_zmeneno_", dim), sum(SG[[paste0("zmena_", dim)]], na.rm = TRUE))
put("seg_zmeneno_projednano", sum(SG$segment == "zmeneno" & SG$adjudikovano == 1))
put("seg_cervenec_radku_A12", sum(SG$anotator == "A12" & SG$segment != "jen_finale"))
put("seg_cervenec_radku_A2", sum(SG$anotator == "A2" & SG$segment != "jen_finale"))
s12 <- SG[SG$anotator == "A12", c("case_uid", "segment")]; names(s12)[2] <- "seg_A12"
s2 <- SG[SG$anotator == "A2", c("case_uid", "segment")]; names(s2)[2] <- "seg_A2"
PS <- P %>% left_join(s12, by = "case_uid") %>% left_join(s2, by = "case_uid")
put("seg_prekryv_A2_cervenec", sum(PS$seg_A2 %in% c("beze_zmeny", "zmeneno"), na.rm = TRUE))
put("seg_prekryv_A2_po", sum(PS$seg_A2 == "jen_finale", na.rm = TRUE))
put("seg_prekryv_A12_po", sum(PS$seg_A12 == "jen_finale", na.rm = TRUE))
put("seg_prekryv_A12_zmeneno", sum(PS$seg_A12 == "zmeneno", na.rm = TRUE))
ok <- !is.na(PS$seg_A12) & !is.na(PS$seg_A2)
PRED <- PS[ok & PS$seg_A12 == "beze_zmeny" & PS$seg_A2 == "beze_zmeny", ]
PO <- PS[ok & PS$seg_A12 == "jen_finale" & PS$seg_A2 == "beze_zmeny", ]
put("seg_pred_n", nrow(PRED)); put("seg_po_n", nrow(PO))
if (nrow(PRED) > 20) rel(PRED, "segpred_")
if (nrow(PO) > 20) rel(PO, "segpo_")
write.csv(SG %>% count(anotator, segment),
file.path(H2, "vystupy/tabulky/kap8_segmenty.csv"), row.names = FALSE)
}
# adjudication summary (counts only; produced by 27_k3_freeze.py from the briefing sheet)
adjs <- file.path(PROC, "k3_adjudikace_souhrn.csv")
stopifnot(file.exists(adjs))
adjudication_summary <- read.csv(adjs)
for (summary_row in seq_len(nrow(adjudication_summary)))
put(adjudication_summary$metric[summary_row], adjudication_summary$value[summary_row])
knitr::kable(kv, digits = 3)| kvartil | n | kvalita_presna | dopad_presna | vhodnost_presna |
|---|---|---|---|---|
| 1 | 174 | 0.966 | 0.807 | 0.485 |
| 2 | 173 | 0.960 | 0.763 | 0.618 |
| 3 | 173 | 0.948 | 0.781 | 0.682 |
| 4 | 173 | 1.000 | 0.849 | 0.552 |
5 K1 × K3: replication of outcome and solution type vs outcome
put("k1k3_n_par", nrow(PK))
put("k1k3_kvalita_flat_k1", sum(PK$k1_flat == "flat", na.rm = TRUE))
# outcome K1 (merged to 3 categories) vs K3, unit = case × K3 annotator
long <- bind_rows(lapply(c("A12", "A2"), function(a)
data.frame(case_uid = PK$case_uid, k1 = PK$k1_dopad3, k3 = PK[[paste0("k3_dopad_", a)]],
vh = PK[[paste0("k3_vhodnost_", a)]], res = PK$k1_reseni_primarni, stringsAsFactors = FALSE)))
d <- long[!is.na(long$k1) & long$k1 != "" & !is.na(long$k3) & long$k3 != "", ]
put("k1k3_neuplny_k1_n", sum((is.na(long$k1) | long$k1 == "") & !is.na(long$k3) & long$k3 != ""))
put("k1k3_dopad_n", nrow(d)); put("k1k3_dopad_presna", exact(d$k1, d$k3))
put("k1k3_dopad_kappa", kappa_nom(d$k1, d$k3)); put("k1k3_dopad_ac1", ac1(d$k1, d$k3))
# cluster bootstrap over cases
cb <- function(f) { set.seed(SEED); u <- unique(d$case_uid); v <- replicate(B, {
s <- sample(u, length(u), TRUE); dd <- d[unlist(lapply(s, function(x) which(d$case_uid == x))), ]
f(dd$k1, dd$k3) }); quantile(v, c(.025, .975), names = FALSE) }
ci <- cb(exact); put("k1k3_dopad_presna_ci_lo", ci[1]); put("k1k3_dopad_presna_ci_hi", ci[2])
ci <- cb(kappa_nom); put("k1k3_dopad_kappa_ci_lo", ci[1]); put("k1k3_dopad_kappa_ci_hi", ci[2])
mz2 <- as.data.frame(table(K1 = d$k1, K3 = d$k3)) %>% rename(n = Freq)
write.csv(mz2, file.path(H2, "vystupy/tabulky/kap8_matice_k1k3.csv"), row.names = FALSE)
# solution type (K1 primary) × K3 outcome / appropriateness
r <- long[!is.na(long$res) & long$res != "", ]
r$pair_complete <- !is.na(r$k1) & r$k1 != "" & !is.na(r$k3) & r$k3 != ""
r$du <- as.integer(r$k3 == "Dlouhodobý úspěch")
r$du[!r$pair_complete] <- NA
tab <- r %>% group_by(res) %>% summarise(n_kazuistik = n_distinct(case_uid), n = sum(!is.na(du)),
du_podil = mean(du, na.rm = TRUE), vhodnost_prumer = mean(vh, na.rm = TRUE), .groups = "drop") %>%
arrange(desc(n_kazuistik))
put("k1k3_reseni_n", n_distinct(r$case_uid))
cbres <- function(cat, f) { set.seed(SEED); u <- unique(r$case_uid[r$res == cat]); v <- replicate(B, {
s <- sample(u, length(u), TRUE); dd <- r[r$res == cat, ][unlist(lapply(s, function(x) which(r$case_uid[r$res == cat] == x))), ]
f(dd) }); quantile(v, c(.025, .975), names = FALSE, na.rm = TRUE) }
tab$du_ci_lo <- NA; tab$du_ci_hi <- NA; tab$vh_ci_lo <- NA; tab$vh_ci_hi <- NA
tab$du_podil_k1 <- NA; tab$n_k1 <- NA
slug <- function(x) { x <- tolower(iconv(x, to = "ASCII//TRANSLIT")); gsub("^_+|_+$", "", gsub("[^a-z0-9]+", "_", x)) }
for (i in seq_len(nrow(tab))) {
cat_ <- tab$res[i]; s <- slug(cat_)
ci <- cbres(cat_, function(dd) mean(dd$du, na.rm = TRUE)); tab$du_ci_lo[i] <- ci[1]; tab$du_ci_hi[i] <- ci[2]
ci <- cbres(cat_, function(dd) mean(dd$vh, na.rm = TRUE)); tab$vh_ci_lo[i] <- ci[1]; tab$vh_ci_hi[i] <- ci[2]
put(paste0("reseni_", s, "_n"), tab$n_kazuistik[i])
put(paste0("reseni_", s, "_du_podil"), tab$du_podil[i])
put(paste0("reseni_", s, "_du_ci_lo"), tab$du_ci_lo[i]); put(paste0("reseni_", s, "_du_ci_hi"), tab$du_ci_hi[i])
put(paste0("reseni_", s, "_vhodnost_prumer"), tab$vhodnost_prumer[i])
put(paste0("reseni_", s, "_vh_ci_lo"), tab$vh_ci_lo[i]); put(paste0("reseni_", s, "_vh_ci_hi"), tab$vh_ci_hi[i])
# same cases, outcome as coded by the FIRST campaign: makes the two teams comparable
k1sub <- r[r$res == cat_ & r$pair_complete, ]
tab$du_podil_k1[i] <- mean(k1sub$k1 == "Dlouhodobý úspěch")
tab$n_k1[i] <- nrow(k1sub)
put(paste0("reseni_", s, "_du_podil_k1"), tab$du_podil_k1[i])
put(paste0("reseni_", s, "_n_k1"), tab$n_k1[i])
}
ct <- table(r$res[r$pair_complete], r$k3[r$pair_complete])
chi <- suppressWarnings(chisq.test(ct))
put("k1k3_reseni_dopad_cramer_v", sqrt(chi$statistic / (sum(ct) * (min(dim(ct)) - 1))))
write.csv(tab, file.path(H2, "vystupy/tabulky/kap8_reseni_dopad.csv"), row.names = FALSE)
knitr::kable(tab, digits = 3)| res | n_kazuistik | n | du_podil | vhodnost_prumer | du_ci_lo | du_ci_hi | vh_ci_lo | vh_ci_hi | du_podil_k1 | n_k1 |
|---|---|---|---|---|---|---|---|---|---|---|
| Rozhovor | 463 | 449 | 0.421 | 3.254 | 0.375 | 0.467 | 3.172 | 3.332 | 0.499 | 449 |
| Upozornění | 97 | 91 | 0.297 | 2.750 | 0.205 | 0.391 | 2.564 | 2.935 | 0.385 | 91 |
| Spolupráce s odborníky | 93 | 89 | 0.382 | 3.315 | 0.286 | 0.489 | 3.122 | 3.495 | 0.483 | 89 |
| Podpora | 66 | 63 | 0.349 | 3.429 | 0.234 | 0.467 | 3.210 | 3.619 | 0.429 | 63 |
| Nerespektující komunikace | 45 | 39 | 0.231 | 2.098 | 0.105 | 0.381 | 1.810 | 2.400 | 0.179 | 39 |
| Práce s kolektivem | 38 | 37 | 0.514 | 3.378 | 0.351 | 0.667 | 3.132 | 3.622 | 0.703 | 37 |
| Přemístění žáka | 35 | 35 | 0.486 | 3.200 | 0.314 | 0.657 | 2.857 | 3.514 | 0.543 | 35 |
| Důsledky | 28 | 27 | 0.296 | 2.778 | 0.125 | 0.480 | 2.407 | 3.143 | 0.333 | 27 |
| (Kázeňské) Tresty | 20 | 20 | 0.350 | 2.750 | 0.150 | 0.550 | 2.350 | 3.100 | 0.400 | 20 |
| Dohoda | 16 | 16 | 0.312 | 3.375 | 0.125 | 0.562 | 3.062 | 3.688 | 0.562 | 16 |
| Fyzické zakročení | 15 | 10 | 0.400 | 3.400 | 0.091 | 0.714 | 2.699 | 4.000 | 0.400 | 10 |
| Proaktivní řešení | 1 | 1 | 1.000 | 4.000 | 1.000 | 1.000 | 4.000 | 4.000 | 1.000 | 1 |
6 Regression checks against the descriptive scripts (22/23) and freeze
v <- function(k) rec$value[rec$metric == k]
rec <- bind_rows(manifest)
stopifnot(abs(v("plny_dopad_kappa") - 0.674) < 0.01,
abs(v("plny_dopad_presna") - 0.801) < 0.01,
abs(v("plny_vhodnost_wkappa") - 0.531) < 0.01,
abs(v("plny_kvalita_presna") - 0.967) < 0.01,
v("n_prekryv") >= 690)
stopifnot(!any(duplicated(rec$metric)))
out <- rec %>% mutate(skript = "analyzy/notebooks/40_kvalita.qmd", data_sha = DATA_SHA,
seed = SEED, datum = format(Sys.Date()))
write.csv(out, file.path(H2, "vystupy/tabulky/kap8_kvalita_cisla.csv"), row.names = FALSE)
cat("manifest:", nrow(out), "metrics →", "vystupy/tabulky/kap8_kvalita_cisla.csv\n")manifest: 478 metrics → vystupy/tabulky/kap8_kvalita_cisla.csv7 Stored predictions: offline recalculation
These tables are recalculated by 29_predikce_offline.py without API calls. Invalid responses remain in the denominator as failed predictions. Intervals are retrospective case bootstraps; paired differences do not establish model equivalence. Human reading of the reported outcome is a different task.
predictions <- read.csv(file.path(H2, "vystupy/tabulky/kap8_predikce_vysledky.csv"))
knitr::kable(predictions[, c("model", "varianta", "reference", "n", "n_invalid",
"coverage", "bal_acc", "bal_acc_ci_lo", "bal_acc_ci_hi",
"macro_f1", "kappa", "kappa_valid")], digits = 3)| model | varianta | reference | n | n_invalid | coverage | bal_acc | bal_acc_ci_lo | bal_acc_ci_hi | macro_f1 | kappa | kappa_valid |
|---|---|---|---|---|---|---|---|---|---|---|---|
| glm-5.3 | few_shot | A12 | 601 | 7 | 0.988 | 0.603 | 0.557 | 0.642 | 0.569 | 0.322 | 0.328 |
| glm-5.3 | few_shot | A2 | 601 | 7 | 0.988 | 0.592 | 0.551 | 0.631 | 0.549 | 0.294 | 0.299 |
| glm-5.3 | few_shot | konsenzus | 487 | 6 | 0.988 | 0.633 | 0.589 | 0.674 | 0.584 | 0.344 | 0.350 |
| glm-5.3 | zero_shot | A12 | 601 | 7 | 0.988 | 0.582 | 0.539 | 0.623 | 0.541 | 0.285 | 0.292 |
| glm-5.3 | zero_shot | A2 | 601 | 7 | 0.988 | 0.569 | 0.526 | 0.609 | 0.517 | 0.253 | 0.258 |
| glm-5.3 | zero_shot | konsenzus | 487 | 6 | 0.988 | 0.604 | 0.561 | 0.648 | 0.551 | 0.296 | 0.302 |
| kimi-k3 | zero_shot | A12 | 601 | 13 | 0.978 | 0.589 | 0.551 | 0.628 | 0.542 | 0.290 | 0.300 |
| kimi-k3 | zero_shot | A2 | 601 | 13 | 0.978 | 0.567 | 0.527 | 0.605 | 0.513 | 0.254 | 0.262 |
| kimi-k3 | zero_shot | konsenzus | 487 | 11 | 0.977 | 0.600 | 0.557 | 0.645 | 0.546 | 0.298 | 0.309 |
differences <- read.csv(file.path(H2, "vystupy/tabulky/kap8_predikce_rozdily.csv"))
knitr::kable(differences, digits = 4)| comparison | n | difference | ci_lo | ci_hi |
|---|---|---|---|---|
| glm_vs_kimi | 487 | 0.0037 | -0.0387 | 0.0482 |
| few_vs_zero | 487 | 0.0288 | -0.0111 | 0.0651 |
knitr::kable(rec[grepl("^obe_plne_.*(n$|kappa$|presna$)", rec$metric), ])| metric | value | |
|---|---|---|
| 172 | obe_plne_dopad_n | 593.0000 |
| 173 | obe_plne_dopad_presna | 0.8145 |
| 176 | obe_plne_dopad_kappa | 0.6923 |
| 185 | obe_plne_vhodnost_n | 593.0000 |
| 186 | obe_plne_vhodnost_presna | 0.5784 |
| 190 | obe_plne_vhodnost_wkappa | 0.5039 |
sessionInfo()R version 4.6.1 (2026-06-24 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 10 x64 (build 19045)
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: Europe/Prague
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] digest_0.6.39 irrCAC_1.4 irr_0.85 lpSolve_5.6.23 tidyr_1.3.2
[6] dplyr_1.2.1
loaded via a namespace (and not attached):
[1] vctrs_0.7.3 cli_3.6.6 knitr_1.52 rlang_1.3.0
[5] xfun_0.60 stringi_1.8.9 purrr_1.2.2 generics_0.1.4
[9] jsonlite_2.0.0 glue_1.8.1 htmltools_0.5.9 rmarkdown_2.32
[13] evaluate_1.0.5 tibble_3.3.1 fastmap_1.2.0 yaml_2.3.12
[17] lifecycle_1.0.5 stringr_1.6.0 compiler_4.6.1 pkgconfig_2.0.3
[21] R6_2.6.1 tidyselect_1.2.1 pillar_1.11.1 magrittr_2.0.5
[25] withr_3.0.3 tools_4.6.1