x <- as.character(x)
x <- x[!is.na(x) & trimws(x) != ""]
if (length(x) == 0) return(NA_character_)
x[1]
}
assign_age_group_col <- function(age_chr) {
age_num <- suppressWarnings(as.integer(age_chr))
dplyr::case_when(
age_num == 0 ~ "g_0_2024",
age_num >= 1  & age_num <= 4  ~ "g_1_4_2024",
age_num >= 5  & age_num <= 9  ~ "g_5_9_2024",
age_num >= 10 & age_num <= 14 ~ "g_10_14_2024",
age_num >= 15 & age_num <= 18 ~ "g_15_18_2024",
TRUE ~ NA_character_
)
}
sum_numeric_row <- function(df, row_idx) {
vals <- to_num(unlist(df[row_idx, -1, drop = TRUE]))
vals <- vals[is.finite(vals)]
if (length(vals) == 0) return(NA_real_)
sum(vals, na.rm = TRUE)
}
find_row_exact_sum <- function(df, labels_key, target_key) {
idx <- which(labels_key == target_key)
if (length(idx) == 0) return(NA_real_)
sum_numeric_row(df, idx[1])
}
# =========================
# 3) Kontrola vstupů
# =========================
if (!file.exists(pop_file)) stop("Chybí populační soubor: ", pop_file)
if (!file.exists(ordinance_file)) stop("Chybí soubor ordinací: ", ordinance_file)
if (!dir.exists(reg_dir)) stop("Chybí složka registrace: ", reg_dir)
# =========================
# 4) Ordinace 2024
# =========================
ord_sheets <- excel_sheets(ordinance_file)
ord_sheet <- if ("Master - komplet" %in% ord_sheets) "Master - komplet" else ord_sheets[1]
ord_raw <- read_excel(
ordinance_file,
sheet = ord_sheet,
.name_repair = "minimal"
)
required_ord_cols <- c("ZZ_obec", "poskytovatel_ico")
missing_ord_cols <- setdiff(required_ord_cols, names(ord_raw))
if (length(missing_ord_cols) > 0) {
cat("\nNázvy sloupců v XLSX:\n")
print(names(ord_raw))
stop("V XLSX chybí sloupce: ", paste(missing_ord_cols, collapse = ", "))
}
ord_base <- ord_raw %>%
transmute(
row_id = row_number(),
kraj = if ("kraj" %in% names(ord_raw)) as.character(kraj) else NA_character_,
orp_xlsx = as.character(ZZ_obec),
poskytovatel_ico = as.character(poskytovatel_ico),
kraj_clean = str_squish(kraj),
orp_clean = str_squish(ZZ_obec),
orp_key = norm_key(ZZ_obec),
ico_clean = str_squish(poskytovatel_ico)
) %>%
filter(
!is.na(ico_clean),
ico_clean != "",
orp_key != ""
)
if (nrow(ord_base) == 0) {
stop("Po načtení ordinací nezůstal žádný záznam.")
}
ord_orp <- ord_base %>%
group_by(orp_key) %>%
summarise(
kraj_clean = first_nonempty(kraj_clean),
orp_clean = first_nonempty(orp_clean),
pocet_ordinaci = n(),
.groups = "drop"
) %>%
arrange(desc(pocet_ordinaci), orp_clean)
# =========================
# 5) Populační data 2024 – ORP
# =========================
pop_raw <- read_csv(
pop_file,
show_col_types = FALSE,
locale = locale(encoding = "UTF-8")
)
required_pop_cols <- c("hodnota", "pohlavi_txt", "vek_txt", "uzemi_txt", "uzemi_typ", "obdobi")
missing_pop_cols <- setdiff(required_pop_cols, names(pop_raw))
if (length(missing_pop_cols) > 0) {
cat("\nNázvy sloupců v CSV:\n")
print(names(pop_raw))
stop("V CSV chybí sloupce: ", paste(missing_pop_cols, collapse = ", "))
}
pop_prepared <- pop_raw %>%
transmute(
hodnota_num = to_num(hodnota),
pohlavi_txt = as.character(pohlavi_txt),
vek_txt = as.character(vek_txt),
uzemi_txt = as.character(uzemi_txt),
uzemi_typ = as.character(uzemi_typ),
obdobi = as.character(obdobi),
orp_clean = str_squish(uzemi_txt),
orp_key = norm_key(uzemi_txt),
pohlavi_key = norm_key(pohlavi_txt),
vek_clean = str_squish(vek_txt)
) %>%
filter(
uzemi_typ == "správní obvod obce s rozšířenou působností",
obdobi == "2024-12-31",
pohlavi_key %in% c("muz", "zena"),
vek_clean %in% as.character(0:18),
orp_key != ""
)
if (nrow(pop_prepared) == 0) {
stop("Po filtraci populačních dat nezůstal žádný záznam.")
}
pop_orp_age_sex <- pop_prepared %>%
group_by(orp_key, orp_clean, pohlavi_key, vek_clean) %>%
summarise(
osoby = sum(hodnota_num, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(orp_clean, pohlavi_key, suppressWarnings(as.integer(vek_clean)))
pop_orp_age <- pop_orp_age_sex %>%
group_by(orp_key, orp_clean, vek_clean) %>%
summarise(
osoby = sum(osoby, na.rm = TRUE),
.groups = "drop"
)
pop_orp_total <- pop_orp_age %>%
group_by(orp_key) %>%
summarise(
orp_clean = first_nonempty(orp_clean),
deti_0_18_2024 = sum(osoby, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(deti_0_18_2024), orp_clean)
pop_orp_groups <- pop_orp_age %>%
mutate(vekova_skupina = assign_age_group_col(vek_clean)) %>%
filter(!is.na(vekova_skupina)) %>%
group_by(orp_key, orp_clean, vekova_skupina) %>%
summarise(
osoby = sum(osoby, na.rm = TRUE),
.groups = "drop"
) %>%
select(-orp_clean) %>%
tidyr::pivot_wider(
names_from = vekova_skupina,
values_from = osoby,
values_fill = 0
)
for (nm in c("g_0_2024", "g_1_4_2024", "g_5_9_2024", "g_10_14_2024", "g_15_18_2024")) {
if (!nm %in% names(pop_orp_groups)) pop_orp_groups[[nm]] <- 0
}
pop_orp_groups <- pop_orp_groups %>%
select(
orp_key,
g_0_2024, g_1_4_2024, g_5_9_2024, g_10_14_2024, g_15_18_2024
)
# =========================
# 6) A041 – NATVRDO list regiony 24
# =========================
reg_files <- list.files(reg_dir, pattern = "\\.xlsx$", full.names = TRUE)
if (length(reg_files) == 0) {
stop("Ve složce registrace není žádný XLSX soubor.")
}
reg_file <- reg_files[1]
preferred_idx <- which(
str_detect(
norm_text(basename(reg_files)),
"a041|prakticky lekar pro deti a dorost|vykaz a041|vykaz-a041"
)
)
if (length(preferred_idx) > 0) reg_file <- reg_files[preferred_idx[1]]
reg_sheets <- excel_sheets(reg_file)
if (!"regiony 24" %in% reg_sheets) {
cat("\nDostupné listy v A041:\n")
print(reg_sheets)
stop("V A041 chybí list 'regiony 24'.")
}
reg_sheet <- "regiony 24"
reg_raw <- read_excel(
reg_file,
sheet = reg_sheet,
col_names = FALSE,
.name_repair = "minimal"
)
if (nrow(reg_raw) == 0 || ncol(reg_raw) == 0) {
stop("List 'regiony 24' se nepodařilo načíst.")
}
labels_key <- label_key(reg_raw[[1]])
# přesné názvy řádků z listu regiony 24
target_total_contacts <- "pocet kontaktu osetreni vysetreni s pacientem celkem"
target_prev_total     <- "pocet kontaktu osetreni vysetreni s pacientem preventivni celkem"
target_prev_0         <- "pocet kontaktu osetreni vysetreni s pacientem preventivni 0 11 mes"
target_prev_1_4       <- "pocet kontaktu osetreni vysetreni s pacientem preventivni 1 4 roky"
target_prev_5_9       <- "pocet kontaktu osetreni vysetreni s pacientem preventivni 5 9 let"
target_prev_10_14     <- "pocet kontaktu osetreni vysetreni s pacientem preventivni 10 14 let"
target_prev_15p       <- "pocet kontaktu osetreni vysetreni s pacientem preventivni 15 let a vice"
target_reg_0          <- "pocet registrovanych pacientu 0 11 mes"
target_reg_1_4        <- "pocet registrovanych pacientu 1 4 roky"
target_reg_5_9        <- "pocet registrovanych pacientu 5 9 let"
target_reg_10_14      <- "pocet registrovanych pacientu 10 14 let"
target_reg_15p        <- "pocet registrovanych pacientu 15 let a vice"
reg_2024 <- tibble(
vekova_skupina = c("0", "1-4", "5-9", "10-14", "15-18"),
registrovani_2024 = c(
find_row_exact_sum(reg_raw, labels_key, target_reg_0),
find_row_exact_sum(reg_raw, labels_key, target_reg_1_4),
find_row_exact_sum(reg_raw, labels_key, target_reg_5_9),
find_row_exact_sum(reg_raw, labels_key, target_reg_10_14),
find_row_exact_sum(reg_raw, labels_key, target_reg_15p)
)
)
prev_2024 <- tibble(
vekova_skupina = c("0", "1-4", "5-9", "10-14", "15-18"),
preventivni_kontakty_2024 = c(
find_row_exact_sum(reg_raw, labels_key, target_prev_0),
find_row_exact_sum(reg_raw, labels_key, target_prev_1_4),
find_row_exact_sum(reg_raw, labels_key, target_prev_5_9),
find_row_exact_sum(reg_raw, labels_key, target_prev_10_14),
find_row_exact_sum(reg_raw, labels_key, target_prev_15p)
)
)
celkove_kontakty_2024 <- find_row_exact_sum(reg_raw, labels_key, target_total_contacts)
preventivni_kontakty_celkem_2024 <- find_row_exact_sum(reg_raw, labels_key, target_prev_total)
if (any(is.na(reg_2024$registrovani_2024)) ||
any(is.na(prev_2024$preventivni_kontakty_2024)) ||
is.na(celkove_kontakty_2024) ||
is.na(preventivni_kontakty_celkem_2024)) {
cat("\nNepodařilo se najít některé přesné řádky v listu 'regiony 24'.\n")
cat("\nŘádky obsahující 'registrovanych':\n")
print(reg_raw[grepl("registrovanych", labels_key), 1, drop = FALSE])
cat("\nŘádky obsahující 'preventivni':\n")
print(reg_raw[grepl("preventivni", labels_key), 1, drop = FALSE])
stop("A041: nepodařilo se najít požadované řádky v listu 'regiony 24'.")
}
ratio_total_prev <- celkove_kontakty_2024 / preventivni_kontakty_celkem_2024
# =========================
# 7) Národní věkové sazby 2024
# =========================
pop_nat_groups <- pop_prepared %>%
mutate(vekova_skupina = assign_age_group_col(vek_clean)) %>%
filter(!is.na(vekova_skupina)) %>%
mutate(
vekova_skupina = case_when(
vekova_skupina == "g_0_2024" ~ "0",
vekova_skupina == "g_1_4_2024" ~ "1-4",
vekova_skupina == "g_5_9_2024" ~ "5-9",
vekova_skupina == "g_10_14_2024" ~ "10-14",
vekova_skupina == "g_15_18_2024" ~ "15-18",
TRUE ~ NA_character_
)
) %>%
group_by(vekova_skupina) %>%
summarise(
population_2024 = sum(hodnota_num, na.rm = TRUE),
.groups = "drop"
)
age_rates_2024 <- pop_nat_groups %>%
left_join(reg_2024, by = "vekova_skupina") %>%
left_join(prev_2024, by = "vekova_skupina") %>%
mutate(
reg_rate = registrovani_2024 / population_2024,
prev_per_reg = preventivni_kontakty_2024 / registrovani_2024,
total_contacts_per_reg = prev_per_reg * ratio_total_prev,
age_suffix = c("0", "1_4", "5_9", "10_14", "15_18")
)
if (any(is.na(age_rates_2024$reg_rate)) ||
any(is.na(age_rates_2024$total_contacts_per_reg))) {
print(age_rates_2024, n = Inf)
stop("Nepodařilo se spočítat věkové sazby 2024.")
}
min_intensity <- min(
age_rates_2024$total_contacts_per_reg[is.finite(age_rates_2024$total_contacts_per_reg)],
na.rm = TRUE
)
age_rates_2024 <- age_rates_2024 %>%
mutate(
weight_age = total_contacts_per_reg / min_intensity
)
reg_rate_vec <- setNames(age_rates_2024$reg_rate, age_rates_2024$age_suffix)
contacts_vec <- setNames(age_rates_2024$total_contacts_per_reg, age_rates_2024$age_suffix)
weight_vec   <- setNames(age_rates_2024$weight_age, age_rates_2024$age_suffix)
# =========================
# 8) Finální analýza – zátěž
# =========================
analysis_orp <- pop_orp_total %>%
left_join(pop_orp_groups, by = "orp_key") %>%
inner_join(ord_orp, by = "orp_key", suffix = c("_pop", "_ord")) %>%
mutate(
orp = coalesce(orp_clean_pop, orp_clean_ord),
kraj = kraj_clean,
reg_0     = g_0_2024     * reg_rate_vec[["0"]],
reg_1_4   = g_1_4_2024   * reg_rate_vec[["1_4"]],
reg_5_9   = g_5_9_2024   * reg_rate_vec[["5_9"]],
reg_10_14 = g_10_14_2024 * reg_rate_vec[["10_14"]],
reg_15_18 = g_15_18_2024 * reg_rate_vec[["15_18"]],
registrovani_odhad_2024 = reg_0 + reg_1_4 + reg_5_9 + reg_10_14 + reg_15_18,
visits_0     = reg_0     * contacts_vec[["0"]],
visits_1_4   = reg_1_4   * contacts_vec[["1_4"]],
visits_5_9   = reg_5_9   * contacts_vec[["5_9"]],
visits_10_14 = reg_10_14 * contacts_vec[["10_14"]],
visits_15_18 = reg_15_18 * contacts_vec[["15_18"]],
navstevy_odhad_2024 = visits_0 + visits_1_4 + visits_5_9 + visits_10_14 + visits_15_18,
vazena_populace_2024 =
g_0_2024     * weight_vec[["0"]] +
g_1_4_2024   * weight_vec[["1_4"]] +
g_5_9_2024   * weight_vec[["5_9"]] +
g_10_14_2024 * weight_vec[["10_14"]] +
g_15_18_2024 * weight_vec[["15_18"]],
demograficka_zatez = deti_0_18_2024 / pocet_ordinaci,
registracni_zatez = registrovani_odhad_2024 / pocet_ordinaci,
vykonova_zatez = navstevy_odhad_2024 / pocet_ordinaci,
vazena_demograficka_zatez = vazena_populace_2024 / pocet_ordinaci
) %>%
select(
kraj, orp, orp_key,
deti_0_18_2024, pocet_ordinaci,
g_0_2024, g_1_4_2024, g_5_9_2024, g_10_14_2024, g_15_18_2024,
registrovani_odhad_2024, navstevy_odhad_2024, vazena_populace_2024,
demograficka_zatez, registracni_zatez, vykonova_zatez, vazena_demograficka_zatez
) %>%
distinct(orp_key, .keep_all = TRUE) %>%
arrange(desc(vykonova_zatez), desc(registracni_zatez), desc(demograficka_zatez), orp)
if (nrow(analysis_orp) == 0) {
stop("Po spojení dat nezůstal žádný záznam.")
}
dup_check <- analysis_orp %>%
count(orp_key) %>%
filter(n > 1)
if (nrow(dup_check) > 0) {
print(dup_check)
stop("Po finálním joinu zůstaly duplicitní ORP.")
}
# =========================
# 9) Kontrolní jednotky – základ
# =========================
kontrola_zaklad <- analysis_orp %>%
filter(orp %in% c("Černošice", "Šlapanice", "Lysá nad Labem", "Ústí nad Labem", "Broumov", "Děčín")) %>%
select(
orp, deti_0_18_2024, pocet_ordinaci, demograficka_zatez,
registracni_zatez, vykonova_zatez, vazena_demograficka_zatez
) %>%
arrange(desc(demograficka_zatez))
# =========================
# 10) Diagnostika
# =========================
ord_unmatched <- ord_orp %>%
anti_join(pop_orp_total, by = "orp_key") %>%
arrange(kraj_clean, orp_clean)
pop_without_ordinance <- pop_orp_total %>%
anti_join(ord_orp, by = "orp_key") %>%
arrange(desc(deti_0_18_2024), orp_clean)
summary_stats <- tibble(
ukazatel = c(
"ORP v populačních datech",
"ORP s ordinací v NR-01-06",
"ORP v průniku",
"Celkový počet ordinací v analyzovaných ORP"
),
hodnota = c(
nrow(pop_orp_total),
nrow(ord_orp),
nrow(analysis_orp),
sum(analysis_orp$pocet_ordinaci, na.rm = TRUE)
)
)
# =========================
# 11) TOP 15 – výkonová zátěž
# =========================
top_n <- min(15, nrow(analysis_orp))
top15 <- analysis_orp %>%
slice_head(n = top_n) %>%
mutate(
orp = factor(orp, levels = rev(unique(orp))),
label_hodnota = fmt_dec1(vykonova_zatez)
)
tabulka_top15 <- analysis_orp %>%
slice_head(n = top_n) %>%
transmute(
Kraj = kraj,
`Správní obvod ORP` = orp,
`Počet osob 0–18 let` = fmt_int(deti_0_18_2024),
`Počet ordinací` = fmt_int(pocet_ordinaci),
`Odhad registrovaných` = fmt_int(round(registrovani_odhad_2024)),
`Odhad návštěv` = fmt_int(round(navstevy_odhad_2024)),
`Děti 0–18 na 1 ordinaci` = fmt_dec1(demograficka_zatez),
`Registrovaní na 1 ordinaci` = fmt_dec1(registracni_zatez),
`Návštěvy na 1 ordinaci` = fmt_dec1(vykonova_zatez),
`Vážená zátěž na 1 ordinaci` = fmt_dec1(vazena_demograficka_zatez)
)
# =========================
# 12) Graf
# =========================
plot_top15 <- ggplot(top15, aes(x = vykonova_zatez, y = orp)) +
geom_col(fill = "#4F86B7") +
geom_text(
aes(label = label_hodnota),
hjust = -0.1,
size = 4
) +
scale_x_continuous(
labels = label_number(big.mark = " ", decimal.mark = ","),
expand = expansion(mult = c(0, 0.14))
) +
labs(
title = "TOP 15 nejzatíženějších ORP v roce 2024",
subtitle = "Aproximovaný počet návštěv na 1 ordinaci",
x = "Aproximovaný počet návštěv na 1 ordinaci",
y = NULL
) +
theme_minimal(base_size = 13) +
theme(
panel.grid.minor = element_blank(),
plot.title = element_text(face = "bold", size = 19),
plot.subtitle = element_text(size = 11)
)
ggsave(
filename = file.path(output_dir, "6.4.1_top15_orp_vykonova_zatez_graf.png"),
plot = plot_top15,
width = 13,
height = 8.5,
dpi = 300,
bg = "white"
)
# =========================
# 13) Uložení dat
# =========================
write_csv(age_rates_2024, file.path(output_dir, "6.4.1_narodni_vekove_sazby_2024.csv"))
write_csv(pop_orp_age_sex, file.path(output_dir, "6.4.1_orp_populace_detail_vek_pohlavi_2024.csv"))
write_csv(pop_orp_age, file.path(output_dir, "6.4.1_orp_populace_detail_vek_2024.csv"))
write_csv(pop_orp_groups, file.path(output_dir, "6.4.1_orp_populace_skupiny_2024.csv"))
write_csv(pop_orp_total, file.path(output_dir, "6.4.1_orp_populace_2024.csv"))
write_csv(ord_base, file.path(output_dir, "6.4.1_ordinace_vstup_vsechny_radky.csv"))
write_csv(ord_orp, file.path(output_dir, "6.4.1_ordinace_2024.csv"))
write_csv(analysis_orp, file.path(output_dir, "6.4.1_analyza_zateze_2024.csv"))
write_csv(top15 %>% mutate(orp = as.character(orp)), file.path(output_dir, "6.4.1_top15_orp_zatez_2024.csv"))
write_csv(tabulka_top15, file.path(output_dir, "6.4.1_top15_orp_zatez_tabulka.csv"))
write_csv(kontrola_zaklad, file.path(output_dir, "6.4.1_kontrola_zakladnich_hodnot.csv"))
write_csv(summary_stats, file.path(output_dir, "6.4.1_souhrnne_pocty.csv"))
write_csv(ord_unmatched, file.path(output_dir, "6.4.1_ordinace_bez_napojeni_na_populaci.csv"))
write_csv(pop_without_ordinance, file.path(output_dir, "6.4.1_orp_bez_ordinace.csv"))
# =========================
# 14) Excel
# =========================
wb <- createWorkbook()
addWorksheet(wb, "analyza_zateze_2024")
writeData(wb, "analyza_zateze_2024", analysis_orp)
addWorksheet(wb, "top15")
writeData(wb, "top15", top15 %>% mutate(orp = as.character(orp)))
addWorksheet(wb, "tabulka_top15")
writeData(wb, "tabulka_top15", tabulka_top15)
addWorksheet(wb, "vekove_sazby")
writeData(wb, "vekove_sazby", age_rates_2024)
addWorksheet(wb, "populace_skupiny")
writeData(wb, "populace_skupiny", pop_orp_groups)
addWorksheet(wb, "populace_2024")
writeData(wb, "populace_2024", pop_orp_total)
addWorksheet(wb, "ordinace_2024")
writeData(wb, "ordinace_2024", ord_orp)
addWorksheet(wb, "kontrola")
writeData(wb, "kontrola", kontrola_zaklad)
addWorksheet(wb, "souhrn")
writeData(wb, "souhrn", summary_stats)
saveWorkbook(
wb,
file = file.path(output_dir, "6.4.1_analyza_zateze_2024.xlsx"),
overwrite = TRUE
)
# =========================
# 15) Textový souhrn
# =========================
writeLines(
c(
"6.4.1 – Demografická poptávka a nabídka + aproximace zátěže",
"",
"Základní logika:",
"- populace ORP: muž + žena, věk 0 až 18, uzemi_typ = správní obvod obce s rozšířenou působností",
"- ordinace: validní řádky podle poskytovatel_ico, join přes ZZ_obec",
"- A041: použit NATVRDO list regiony 24, hodnoty za ČR = součet přes krajské sloupce",
"",
"Ukazatele:",
"- demografická zátěž = děti 0–18 / ordinace",
"- registrační zátěž = odhad registrovaných / ordinace",
"- výkonová zátěž = odhad návštěv / ordinace",
"- vážená demografická zátěž = vážená dětská populace / ordinace"
),
con = file.path(output_dir, "6.4.1_metodika_zatez.txt")
)
# =========================
# 16) Konzole
# =========================
cat("\n=====================================================\n")
cat("ANALÝZA HOTOVO\n")
cat("Výstupní složka:", output_dir, "\n")
cat("Použitý list A041:", reg_sheet, "\n")
cat("=====================================================\n\n")
cat("Souhrnné počty:\n")
print(summary_stats, n = Inf)
cat("\nPoužité národní sazby podle věku:\n")
print(age_rates_2024, n = Inf)
cat("\nKONTROLA ZÁKLADNÍCH HODNOT:\n")
print(kontrola_zaklad, n = Inf)
cat("\nTOP 15 ORP podle výkonové zátěže:\n")
print(tabulka_top15, n = Inf)
cat("\nVytvořené soubory:\n")
cat("- 6.4.1_top15_orp_vykonova_zatez_graf.png\n")
cat("- 6.4.1_narodni_vekove_sazby_2024.csv\n")
cat("- 6.4.1_analyza_zateze_2024.csv\n")
cat("- 6.4.1_analyza_zateze_2024.xlsx\n")
cat("- 6.4.1_metodika_zatez.txt\n")
