suppressPackageStartupMessages({
library(dplyr); library(tidyr); library(readr); library(stringr); library(digest)
})
SEED <- 20260714; set.seed(SEED)
H2 <- normalizePath(file.path(getwd(), "../.."))
S6 <- file.path(H2, "data/raw/korpus/export-2026-05/Edustories_export_may26_svabik_v2.csv")
S6B <- file.path(H2, "data/raw/korpus/export-2026-05/Edustories_export_may26_svabik.xlsx")
REZ <- file.path(H2, "data/processed/k1_rez_ids.csv")
TRUNC <- file.path(H2, "data/processed/truncated_uids.csv")
sha256 <- function(p) {
if (!file.exists(p)) return("public-derived") # veřejný běh: raw není, otisk se neuvádí
digest::digest(file = p, algo = "sha256")
}
S6_SHA <- sha256(S6); REZ_SHA <- sha256(REZ)
manifest <- list()
put <- function(metric, value, sha = S6_SHA) manifest[[length(manifest) + 1]] <<-
data.frame(metric = metric, value = round(as.numeric(value), 4), data_sha = sha)E1 — Corpus Descriptives (Study 1)
Study 1 (PLAN.md §5 E1): descriptive profile of the full corpus snapshot S6 (May 2026), corpus growth across named snapshots, publication drift (S6b), and the human-coded K1 descriptives (behaviours / solutions / outcomes) on the reproducible K1_rez slice — with the pre-specified DUAL counts (cases with category vs total assignments). Text-length statistics conservatively exclude all 52 cases ever affected by extraction truncation (8 of them were later repaired but stay excluded; D4). Writes vystupy/tabulky/kap5_korpus_cisla.csv.
Full corpus S6 (May 2026)
# Studie 1 potřebuje z plného exportu jen ODVOZENÉ hodnoty (počty slov, věk,
# publikační status), NE texty kazuistik. Je-li plný export přítomen (stroj
# autora), spočítáme je a zároveň zapíšeme veřejnou tabulku BEZ TEXTŮ; když
# chybí (Binder / veřejný běh), načteme tuto tabulku. Čísla jsou identická
# (táž definice počtu slov wc()). Kategorie a ko-výskyt níže stojí na veřejném
# k1_rez_ids.csv, takže celá Studie 1 je reprodukovatelná bez textů korpusu.
PER <- file.path(H2, "data/processed/kap5_perkazuistika.csv")
wc <- function(x) str_count(x, "\\S+")
if (file.exists(S6)) {
s6 <- read_csv(S6, col_types = cols(.default = col_character()))
ai_cols <- grep("^ai_solution_.*_cs$", names(s6), value = TRUE)
per <- tibble(
uid = paste0("exp", s6$id),
is_published = s6$is_published,
age = suppressWarnings(as.numeric(s6$age)),
wc_description = wc(s6$description_cs),
wc_anamnesis = wc(s6$anamnesis_cs),
wc_solution = wc(s6$solution_cs),
wc_outcome = wc(s6$outcome_cs),
ai_complete = rowSums(!is.na(s6[ai_cols]) & s6[ai_cols] != "") == 6L)
write.csv(per, PER, row.names = FALSE) # veřejná odvozená tabulka (bez textů)
PER_SHA <- S6_SHA
} else {
per <- read_csv(PER, col_types = cols(.default = col_character()))
per$age <- suppressWarnings(as.numeric(per$age))
for (c in grep("^wc_", names(per), value = TRUE)) per[[c]] <- as.integer(per[[c]])
per$ai_complete <- per$ai_complete %in% c("TRUE", "true", "1")
PER_SHA <- sha256(PER)
cat("Plný export S6 není přítomen — Studie 1 běží z veřejné odvozené tabulky",
"kap5_perkazuistika.csv (počty slov, věk, publikační status; bez textů korpusu).\n")
}Plný export S6 není přítomen — Studie 1 běží z veřejné odvozené tabulky kap5_perkazuistika.csv (počty slov, věk, publikační status; bez textů korpusu).put("n_korpus_s6", nrow(per))
put("n_zverejneno_s6", sum(per$is_published == "true", na.rm = TRUE))
trunc <- read_csv(TRUNC, show_col_types = FALSE)
per_len <- per |> filter(!(uid %in% trunc$case_uid))
put("n_vyrazeno_delky_trunc", nrow(per) - nrow(per_len))
len_rows <- lapply(c("description", "anamnesis", "solution", "outcome"), function(part) {
w <- per_len[[paste0("wc_", part)]]
put(paste0(part, "_slov_median"), median(w, na.rm = TRUE))
put(paste0(part, "_slov_q1"), quantile(w, .25, na.rm = TRUE))
put(paste0(part, "_slov_q3"), quantile(w, .75, na.rm = TRUE))
data.frame(cast = part, median = median(w, na.rm = TRUE),
q1 = quantile(w, .25, na.rm = TRUE), q3 = quantile(w, .75, na.rm = TRUE))
})
knitr::kable(bind_rows(len_rows), digits = 0, row.names = FALSE,
caption = "Word counts (Czech text; all 52 truncation-affected cases excluded)")| cast | median | q1 | q3 |
|---|---|---|---|
| description | 102 | 76 | 148 |
| anamnesis | 79 | 66 | 109 |
| solution | 102 | 74 | 154 |
| outcome | 68 | 43 | 102 |
age <- per$age
# hygiena: věk 0 = nevyplněno (kód formuláře), ne skutečný věk → NA;
# horní mez neořezáváme (žák SŠ může být 20+), počet implauzibilních dokládáme
put("vek_n_nula_vyrazeno", sum(age == 0, na.rm = TRUE))
age[age == 0] <- NA
put("vek_median", median(age, na.rm = TRUE)); put("vek_n", sum(!is.na(age)))
put("n_ai_reseni_kompletni", sum(per$ai_complete, na.rm = TRUE))Corpus growth and publication drift
Named snapshots (documented in DATA_README §1); S6b is the older export cut — its cases missing from S6 were unpublished in the meantime.
snap <- data.frame(
rez = c("S1 (2023)", "S3 (04/2024)", "S4 (08/2024)", "S5 HF (release)", "S6 (05/2026)"),
n = c(757, 1507, 1695, 1492, nrow(per)))
knitr::kable(snap, row.names = FALSE)| rez | n |
|---|---|
| S1 (2023) | 757 |
| S3 (04/2024) | 1507 |
| S4 (08/2024) | 1695 |
| S5 HF (release) | 1492 |
| S6 (05/2026) | 3202 |
for (i in seq_len(nrow(snap))) put(paste0("rust_", gsub("[^A-Za-z0-9]", "", snap$rez[i])), snap$n[i])
# Drift potřebuje jen SEZNAM ID staršího i aktuálního exportu (žádné texty).
# Při běhu autora je materializujeme jako veřejné tabulky, jinak je načteme.
S6B_IDS <- file.path(H2, "data/processed/kap5_s6b_ids.csv")
S6_IDS <- file.path(H2, "data/processed/kap5_s6_ids.csv")
if (file.exists(S6B)) {
s6b_ids <- as.integer(na.omit(suppressMessages(readxl::read_excel(S6B, sheet = "out"))$id))
s6_ids <- as.integer(sub("^exp", "", per$uid))
write.csv(data.frame(id = s6b_ids), S6B_IDS, row.names = FALSE)
write.csv(data.frame(id = s6_ids), S6_IDS, row.names = FALSE)
S6B_SHA <- sha256(S6B)
} else {
s6b_ids <- read_csv(S6B_IDS, show_col_types = FALSE)$id
s6_ids <- read_csv(S6_IDS, show_col_types = FALSE)$id
S6B_SHA <- sha256(S6B_IDS)
}
drift <- sum(!(s6b_ids %in% s6_ids))
put("n_s6b", length(s6b_ids), S6B_SHA)
put("n_odpublikovano_s6b_vs_s6", drift, S6B_SHA)
cat("S6b:", length(s6b_ids), "případů; z nich", drift, "už není v S6 (odpublikováno).\n")S6b: 1984 případů; z nich 395 už není v S6 (odpublikováno).K1 human coding on the K1_rez slice — DUAL counts
Multi-label: a case may carry several categories. We therefore report BOTH „cases with category” and „assignments” (PLAN §5 ⊕); their ratio explains why assignment totals exceed the number of cases.
rez <- read_csv(REZ, show_col_types = FALSE)
put("n_k1_rez", nrow(rez), REZ_SHA)
# normalizace štítků: sjednotit velikost písmen a známé překlepy na kanonickou formu
canon_label <- function(p) {
p <- gsub("Částěčný", "Částečný", p)
p <- gsub("odbonríky", "odborníky", p) # překlep v datech
substr(p, 1, 1) <- toupper(substr(p, 1, 1)) # „rozhovor" → „Rozhovor"
p
}
# vyřazené štítky: placeholdery + mimo-kodbook u řešení. „Proaktivní řešení"
# (kategorie z V1, ve V2 zrušená) a „Humor" zaznamenala v lidském K1 jediná
# anotátorka kvůli chybně sestavenému výběrovému seznamu (viz příloha A / kap. 5);
# do lidské korpusové deskriptivy nepatří. V LLM srovnání (kap. 6) zůstávají.
#
# „Diagnóza" je JINÝ případ (rozhodnutí 27. 7. 2026): NEJDE o artefakt výběrového
# seznamu — kategorie č. 14 stromu V2 (kód DIA) byla v nabídce u všech pěti
# anotátorek. Vyřazena je z věcného důvodu: její definice („Žák/žákyně má
# diagnostikovanou některou z diagnóz SVP.") popisuje STAV ŽÁKA, ne chování,
# takže do dimenze problémového chování nepatří. Data to potvrzují: 94,4 %
# výskytů je co-kód k jinému chování, užití mezi anotátorkami kolísá 3,7-21,7 %,
# shoda na kategorii je 40,9 % a její vyřazení zvedne α dimenze z 0,474 na 0,509.
# Diagnóza se v knize reportuje zvlášť jako kontextová proměnná z pole
# diagnoses_unified (metriky `dia_*` níže). Doklad: příloha A + kap. 5.
EXCLUDE_LABELS <- c("-", "?", "(zvolit)", "Proaktivní řešení", "Humor", "Diagnóza")
split_cats <- function(x) {
x <- x[!is.na(x)]
unlist(lapply(x, function(v) {
p <- trimws(unlist(strsplit(v, "[;,]")))
p <- canon_label(p)
p[p != "" & !(p %in% EXCLUDE_LABELS)]
}))
}
dual <- lapply(c(chovani = "problems_annotated", reseni = "solutions_annotated",
dopad = "implications_annotated"), function(col) NULL)
for (nm in names(c(chovani = 1, reseni = 1, dopad = 1))) {
col <- c(chovani = "problems_annotated", reseni = "solutions_annotated",
dopad = "implications_annotated")[[nm]]
cats_per_case <- lapply(rez[[col]], function(v) unique(split_cats(v)))
assignments <- unlist(cats_per_case)
n_cases_with <- table(assignments) # případů s kategorií
n_assign <- length(assignments)
put(paste0("k1_", nm, "_prirazeni_celkem"), n_assign, REZ_SHA)
put(paste0("k1_", nm, "_pripadu_s_udajem"), sum(lengths(cats_per_case) > 0), REZ_SHA)
put(paste0("k1_", nm, "_pomer_prirazeni_na_pripad"),
n_assign / sum(lengths(cats_per_case) > 0), REZ_SHA)
top <- sort(n_cases_with, decreasing = TRUE)[1:min(8, length(n_cases_with))]
for (k in names(top))
put(paste0("k1_", nm, "_pripadu:", substr(k, 1, 38)), top[[k]], REZ_SHA)
# (dříve zde byla explicitní metrika „Proaktivní řešení" pro tvrzení o řídkosti
# v kap. 5; kategorie je artefaktem jednoho výběrového seznamu, proto vyřazena
# z lidské deskriptivy — viz EXCLUDE_LABELS výše a příloha A.)
print(knitr::kable(data.frame(kategorie = names(top), pripadu = as.integer(top)),
caption = paste0(nm, " — top kategorie (počet PŘÍPADŮ)")))
}
Table: chovani — top kategorie (počet PŘÍPADŮ)
|kategorie | pripadu|
|:----------------------------------------------------|-------:|
|Verbální agrese | 330|
|Verbální narušování výuky | 328|
|Fyzická agrese | 299|
|Nevěnování se výuce/Nepozornost při výuce | 293|
|Porušování třídních/školních pravidel | 255|
|Neplnění školních povinností/nepřipravenost na výuku | 201|
|Neverbální narušování výuky | 174|
|Emoční výbuchy | 143|
Table: reseni — top kategorie (počet PŘÍPADŮ)
|kategorie | pripadu|
|:-------------------------|-------:|
|Rozhovor | 922|
|Spolupráce s odborníky | 461|
|Podpora | 342|
|Důsledky | 245|
|Upozornění | 229|
|Přemístění žáka | 205|
|Práce s kolektivem | 184|
|Nerespektující komunikace | 154|
Table: dopad — top kategorie (počet PŘÍPADŮ)
|kategorie | pripadu|
|:-----------------|-------:|
|Dlouhodobý úspěch | 598|
|Neúspěch | 483|
|Částečný úspěch | 158|
|Krátkodobý úspěch | 84|Diagnosis as a CONTEXT variable (not a behaviour category)
Since the Diagnóza label was removed from the behaviour dimension (see EXCLUDE_LABELS), the substantive question „do cases involving a pupil with a recorded diagnosis differ?” is answered from the curated corpus field diagnoses_unified (column ma_diagnozu in K1_rez), which is a property of the case, not an annotator judgement about behaviour.
dia <- rez$ma_diagnozu == 1
put("dia_pripadu", sum(dia), REZ_SHA)
put("dia_podil", mean(dia), REZ_SHA)
cat("K1_rez s vyplněnou diagnózou:", sum(dia), sprintf("(%.1f %%)\n", 100 * mean(dia)))K1_rez s vyplněnou diagnózou: 530 (39.0 %)Distributions for book figures (word lengths, age)
Case-level aggregates for fig_05_*.R (no case texts — safe to publish).
TABDIR <- file.path(H2, "vystupy/tabulky")
delky <- bind_rows(lapply(c("description", "anamnesis", "solution", "outcome"),
function(part) data.frame(cast = part, slova = per_len[[paste0("wc_", part)]])))
delky <- delky[!is.na(delky$slova) & delky$slova > 0, ]
write.csv(delky, file.path(TABDIR, "kap5_delky_rozdeleni.csv"), row.names = FALSE)
put("delka_p90_description",
quantile(delky$slova[delky$cast == "description"], .9, na.rm = TRUE))
vek_tab <- as.data.frame(table(vek = round(age)), responseName = "n")
write.csv(vek_tab, file.path(TABDIR, "kap5_vek_rozdeleni.csv"), row.names = FALSE)
put("vek_q1", quantile(age, .25, na.rm = TRUE))
put("vek_q3", quantile(age, .75, na.rm = TRUE))
cat("rozdělení: délky", nrow(delky), "řádků; věk", nrow(vek_tab), "hodnot\n")rozdělení: délky 12481 řádků; věk 21 hodnotK1 full category tables, co-occurrence and outcome-by-solution
All categories per dimension (figures), conditional co-occurrence P(solution | behaviour) on K1_rez cases, and share of long-term success by solution type. Unit = CASE (multi-label: a case counts once per category it carries). Descriptive only — no causal claims.
cats_of <- function(col) lapply(rez[[col]], function(v) unique(split_cats(v)))
CH <- cats_of("problems_annotated")
RE <- cats_of("solutions_annotated")
DO <- cats_of("implications_annotated")
# (a) úplné tabulky kategorií pro figury
plne <- bind_rows(
data.frame(dimenze = "chovani", kategorie = unlist(CH)),
data.frame(dimenze = "reseni", kategorie = unlist(RE)),
data.frame(dimenze = "dopad", kategorie = unlist(DO))) |>
count(dimenze, kategorie, name = "pripadu") |>
arrange(dimenze, desc(pripadu))
write.csv(plne, file.path(TABDIR, "kap5_k1_kategorie.csv"), row.names = FALSE)
# (b) ko-výskyt: P(řešení | chování), jen buňky s n_chování >= 50
beh_n <- table(unlist(lapply(CH, unique)))
kov <- do.call(rbind, lapply(names(beh_n)[beh_n >= 50], function(b) {
idx <- vapply(CH, function(s) b %in% s, logical(1))
res_tab <- table(unlist(RE[idx]))
data.frame(chovani = b, reseni = names(res_tab),
n_spolu = as.integer(res_tab),
n_chovani = sum(idx),
podil = as.numeric(res_tab) / sum(idx))
}))
write.csv(kov, file.path(TABDIR, "kap5_kovyskyt.csv"), row.names = FALSE)
for (i in seq_len(nrow(kov)))
put(paste0("kov_podil:", substr(kov$chovani[i], 1, 24), "|",
substr(kov$reseni[i], 1, 24)), kov$podil[i], REZ_SHA)
# (b2) totéž pro KONTEXTOVOU proměnnou diagnózy: P(řešení | žák má diagnózu).
# Nahrazuje dřívější řádek `kov_podil:Diagnóza|*`, který stál na anotační
# kategorii vyřazené z dimenze chování; opora je nyní v poli diagnoses_unified.
# POZOR na jmenovatele: srovnávací podíl `*_ref` počítáme na CELÉM řezu
# (n = nrow(rez)), tedy na téže definici jako podíl u kazuistik s diagnózou
# (n = sum(dia)). Jinak by se srovnávaly dvě různé základny.
dia_res <- table(unlist(RE[dia]))
ref_res <- table(unlist(RE))
for (r in names(dia_res)) {
put(paste0("dia_podil_reseni:", substr(r, 1, 24)),
as.numeric(dia_res[[r]]) / sum(dia), REZ_SHA)
put(paste0("dia_podil_reseni_ref:", substr(r, 1, 24)),
as.numeric(ref_res[[r]]) / nrow(rez), REZ_SHA)
}
write.csv(data.frame(reseni = names(dia_res),
n_s_diagnozou = as.integer(dia_res), n_diagnoza = sum(dia),
podil_s_diagnozou = as.numeric(dia_res) / sum(dia),
n_cely_rez = as.integer(ref_res[names(dia_res)]),
n_rez = nrow(rez),
podil_cely_rez = as.numeric(ref_res[names(dia_res)]) / nrow(rez)),
file.path(TABDIR, "kap5_diagnoza_reseni.csv"), row.names = FALSE)
# (c) dopad podle typu řešení: podíl dlouhodobého úspěchu (jen n >= 30)
dop <- do.call(rbind, lapply(names(table(unlist(RE))), function(r) {
idx <- vapply(RE, function(s) r %in% s, logical(1)) &
vapply(DO, length, integer(1)) > 0
if (sum(idx) < 30) return(NULL)
du <- mean(vapply(DO[idx], function(s) "Dlouhodobý úspěch" %in% s, logical(1)))
neu <- mean(vapply(DO[idx], function(s) "Neúspěch" %in% s, logical(1)))
data.frame(reseni = r, n = sum(idx), podil_DU = du, podil_NEU = neu)
}))
dop <- dop[order(-dop$podil_DU), ]
write.csv(dop, file.path(TABDIR, "kap5_dopad_podle_reseni.csv"), row.names = FALSE)
for (i in seq_len(nrow(dop))) {
put(paste0("dopadDU:", substr(dop$reseni[i], 1, 30)), dop$podil_DU[i], REZ_SHA)
put(paste0("dopadN:", substr(dop$reseni[i], 1, 30)), dop$n[i], REZ_SHA)
}
knitr::kable(dop, digits = 3,
caption = "Podíl dlouhodobého úspěchu podle typu řešení (deskriptivně)")| reseni | n | podil_DU | podil_NEU | |
|---|---|---|---|---|
| 7 | Práce s kolektivem | 178 | 0.669 | 0.213 |
| 2 | Dohoda | 129 | 0.628 | 0.233 |
| 6 | Podpora | 334 | 0.503 | 0.287 |
| 9 | Rozhovor | 894 | 0.493 | 0.343 |
| 10 | Spolupráce s odborníky | 449 | 0.443 | 0.376 |
| 1 | (Kázeňské) Tresty | 102 | 0.392 | 0.431 |
| 3 | Důsledky | 240 | 0.392 | 0.442 |
| 11 | Upozornění | 220 | 0.391 | 0.391 |
| 8 | Přemístění žáka | 201 | 0.368 | 0.438 |
| 4 | Fyzické zakročení | 41 | 0.268 | 0.439 |
| 5 | Nerespektující komunikace | 144 | 0.215 | 0.590 |
Freeze: write manifest
out <- bind_rows(manifest) |>
mutate(skript = "analyzy/notebooks/10_korpus.qmd", seed = SEED,
datum = format(Sys.Date())) |>
select(metric, value, skript, data_sha, seed, datum)
write.csv(out, file.path(H2, "vystupy/tabulky/kap5_korpus_cisla.csv"), row.names = FALSE)
cat("Manifest:", nrow(out), "metrik → vystupy/tabulky/kap5_korpus_cisla.csv\n")Manifest: 236 metrik → vystupy/tabulky/kap5_korpus_cisla.csv