) %>%
filter(!is.na(vek_group))
# -------------------------
# 7) Načtení pediatrických ordinací
# -------------------------
ped_raw <- read_excel(ordinace_file, sheet = ordinace_sheet)
names(ped_raw) <- names(ped_raw) %>%
as.character() %>%
str_squish() %>%
str_replace_all("\\.", "_") %>%
str_replace_all("\\s+", "_")
kraj_col  <- find_first_existing_col(ped_raw, c("kraj", "Kraj"))
okres_col <- find_first_existing_col(ped_raw, c("okres_nazev", "okres", "Okres"))
if (is.na(kraj_col) || is.na(okres_col)) {
stop("V souboru ordinací nebyly nalezeny sloupce kraj / okres.")
}
ped_base <- ped_raw %>%
transmute(
kraj = normalize_kraj(.data[[kraj_col]]),
okres = normalize_okres(.data[[okres_col]])
) %>%
filter(!is.na(kraj), kraj != "") %>%
filter(!is.na(okres), okres != "") %>%
filter(kraj %in% valid_kraje)
pediatri_kraje <- ped_base %>%
count(kraj, name = "pocet_pediatru")
ped_uzemi <- ped_base %>%
mutate(
uzemi_txt = sjednot_uzemi(okres)
) %>%
group_by(kraj, uzemi_txt) %>%
summarise(
pocet_pediatru_hlavy = n(),
.groups = "drop"
) %>%
arrange(kraj, uzemi_txt)
# -------------------------
# 8) Načtení úvazků - opravené
# -------------------------
uvazky_kraje_raw  <- read_uvazky_sheet(file_uvazky, sheet_kraje_uvazky)
uvazky_okresy_raw <- read_uvazky_sheet(file_uvazky, sheet_okresy_uvazky)
cat("\n=== NÁZVY SLOUPCŮ: kraje_clean ===\n")
print(names(uvazky_kraje_raw))
cat("\n=== NÁZVY SLOUPCŮ: okresy_clean ===\n")
print(names(uvazky_okresy_raw))
uv_kraj_col       <- find_first_existing_col(uvazky_kraje_raw, c("Kraj", "kraj"))
uv_kraj_total_col <- find_first_existing_col(uvazky_kraje_raw, c("Celkem...7", "Celkem...8", "Celkem"))
uv_kraj_60_64_col <- find_first_existing_col(uvazky_kraje_raw, c("60-64", "60–64"))
uv_kraj_65_69_col <- find_first_existing_col(uvazky_kraje_raw, c("65-69", "65–69"))
uv_kraj_70_74_col <- find_first_existing_col(uvazky_kraje_raw, c("70-74", "70–74"))
uv_kraj_75_79_col <- find_first_existing_col(uvazky_kraje_raw, c("75-79", "75–79"))
uv_kraj_80_col    <- find_first_existing_col(uvazky_kraje_raw, c("80 a více", "80 a vice", "80+"))
if (is.na(uv_kraj_col))       uv_kraj_col       <- pick_col_by_pos(uvazky_kraje_raw, 1)
if (is.na(uv_kraj_total_col)) uv_kraj_total_col <- pick_col_by_pos(uvazky_kraje_raw, 7)
if (is.na(uv_kraj_60_64_col)) uv_kraj_60_64_col <- pick_col_by_pos(uvazky_kraje_raw, 18)
if (is.na(uv_kraj_65_69_col)) uv_kraj_65_69_col <- pick_col_by_pos(uvazky_kraje_raw, 19)
if (is.na(uv_kraj_70_74_col)) uv_kraj_70_74_col <- pick_col_by_pos(uvazky_kraje_raw, 20)
if (is.na(uv_kraj_75_79_col)) uv_kraj_75_79_col <- pick_col_by_pos(uvazky_kraje_raw, 21)
if (is.na(uv_kraj_80_col))    uv_kraj_80_col    <- pick_col_by_pos(uvazky_kraje_raw, 22)
if (any(is.na(c(
uv_kraj_col, uv_kraj_total_col,
uv_kraj_60_64_col, uv_kraj_65_69_col, uv_kraj_70_74_col, uv_kraj_75_79_col, uv_kraj_80_col
)))) {
stop("Na listu kraje_clean nebyly nalezeny všechny potřebné sloupce ani po fallbacku na pozice.")
}
uvazky_kraje <- uvazky_kraje_raw %>%
transmute(
kraj = normalize_kraj(.data[[uv_kraj_col]]),
uvazky_celkem = to_num(.data[[uv_kraj_total_col]]),
`60-64` = to_num(.data[[uv_kraj_60_64_col]]),
`65-69` = to_num(.data[[uv_kraj_65_69_col]]),
`70-74` = to_num(.data[[uv_kraj_70_74_col]]),
`75-79` = to_num(.data[[uv_kraj_75_79_col]]),
`80+`   = to_num(.data[[uv_kraj_80_col]])
) %>%
filter(!is.na(kraj), kraj != "") %>%
filter(kraj %in% valid_kraje) %>%
mutate(
uvazky_60_plus = coalesce(`60-64`, 0) + coalesce(`65-69`, 0) +
coalesce(`70-74`, 0) + coalesce(`75-79`, 0) + coalesce(`80+`, 0),
podil_60_plus = ifelse(uvazky_celkem > 0, uvazky_60_plus / uvazky_celkem, NA_real_)
) %>%
select(kraj, uvazky_celkem, uvazky_60_plus, podil_60_plus)
uv_okr_kraj_col  <- find_first_existing_col(uvazky_okresy_raw, c("Kraj", "kraj"))
uv_okr_okres_col <- find_first_existing_col(uvazky_okresy_raw, c("Okres", "okres"))
uv_okr_total_col <- find_first_existing_col(uvazky_okresy_raw, c("Celkem...7", "Celkem...8", "Celkem"))
uv_okr_60_64_col <- find_first_existing_col(uvazky_okresy_raw, c("60-64", "60–64"))
uv_okr_65_69_col <- find_first_existing_col(uvazky_okresy_raw, c("65-69", "65–69"))
uv_okr_70_74_col <- find_first_existing_col(uvazky_okresy_raw, c("70-74", "70–74"))
uv_okr_75_79_col <- find_first_existing_col(uvazky_okresy_raw, c("75-79", "75–79"))
uv_okr_80_col    <- find_first_existing_col(uvazky_okresy_raw, c("80 a více", "80 a vice", "80+"))
if (is.na(uv_okr_kraj_col))  uv_okr_kraj_col  <- pick_col_by_pos(uvazky_okresy_raw, 1)
if (is.na(uv_okr_okres_col)) uv_okr_okres_col <- pick_col_by_pos(uvazky_okresy_raw, 2)
if (is.na(uv_okr_total_col)) uv_okr_total_col <- pick_col_by_pos(uvazky_okresy_raw, 7)
if (is.na(uv_okr_60_64_col)) uv_okr_60_64_col <- pick_col_by_pos(uvazky_okresy_raw, 18)
if (is.na(uv_okr_65_69_col)) uv_okr_65_69_col <- pick_col_by_pos(uvazky_okresy_raw, 19)
if (is.na(uv_okr_70_74_col)) uv_okr_70_74_col <- pick_col_by_pos(uvazky_okresy_raw, 20)
if (is.na(uv_okr_75_79_col)) uv_okr_75_79_col <- pick_col_by_pos(uvazky_okresy_raw, 21)
if (is.na(uv_okr_80_col))    uv_okr_80_col    <- pick_col_by_pos(uvazky_okresy_raw, 22)
if (any(is.na(c(
uv_okr_kraj_col, uv_okr_okres_col, uv_okr_total_col,
uv_okr_60_64_col, uv_okr_65_69_col, uv_okr_70_74_col, uv_okr_75_79_col, uv_okr_80_col
)))) {
stop("Na listu okresy_clean nebyly nalezeny všechny potřebné sloupce ani po fallbacku na pozice.")
}
uvazky_okresy <- uvazky_okresy_raw %>%
transmute(
kraj = normalize_kraj(.data[[uv_okr_kraj_col]]),
okres = normalize_okres(.data[[uv_okr_okres_col]]),
uvazky_celkem = to_num(.data[[uv_okr_total_col]]),
`60-64` = to_num(.data[[uv_okr_60_64_col]]),
`65-69` = to_num(.data[[uv_okr_65_69_col]]),
`70-74` = to_num(.data[[uv_okr_70_74_col]]),
`75-79` = to_num(.data[[uv_okr_75_79_col]]),
`80+`   = to_num(.data[[uv_okr_80_col]])
) %>%
filter(!is.na(kraj), kraj != "", !is.na(okres), okres != "") %>%
filter(kraj %in% valid_kraje) %>%
mutate(
uzemi_txt = sjednot_uzemi(okres),
uvazky_60_plus = coalesce(`60-64`, 0) + coalesce(`65-69`, 0) +
coalesce(`70-74`, 0) + coalesce(`75-79`, 0) + coalesce(`80+`, 0)
) %>%
group_by(kraj, uzemi_txt) %>%
summarise(
uvazky_celkem = sum(uvazky_celkem, na.rm = TRUE),
uvazky_60_plus = sum(uvazky_60_plus, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
podil_60_plus = ifelse(uvazky_celkem > 0, uvazky_60_plus / uvazky_celkem, NA_real_)
) %>%
arrange(kraj, uzemi_txt)
cat("\n=== ÚVAZKY PODLE KRAJŮ ===\n")
print(uvazky_kraje)
cat("\n=== ÚVAZKY PODLE OKRESŮ / SJEDNOCENÝCH ÚZEMÍ ===\n")
print(head(uvazky_okresy, 30))
# -------------------------
# 9) Populace 0-18 a vážená zátěž – kraje
# -------------------------
deti_kraje <- pop_clean %>%
filter(str_detect(str_to_lower(uzemi_typ), "kraj")) %>%
mutate(kraj = normalize_kraj(uzemi_txt)) %>%
group_by(kraj) %>%
summarise(
deti_0_18 = sum(hodnota, na.rm = TRUE),
.groups = "drop"
) %>%
filter(kraj %in% valid_kraje) %>%
arrange(kraj)
pop_weighted_kraje <- pop_clean %>%
filter(str_detect(str_to_lower(uzemi_typ), "kraj")) %>%
mutate(kraj = normalize_kraj(uzemi_txt)) %>%
group_by(kraj, vek_group) %>%
summarise(
deti = sum(hodnota, na.rm = TRUE),
.groups = "drop"
) %>%
left_join(weights_age, by = c("vek_group" = "group")) %>%
mutate(weighted_children = deti * vaha) %>%
group_by(kraj) %>%
summarise(
weighted_children = sum(weighted_children, na.rm = TRUE),
.groups = "drop"
) %>%
filter(kraj %in% valid_kraje) %>%
arrange(kraj)
# -------------------------
# 10) Populace 0-18 a vážená zátěž – okresy / sjednocená území
# -------------------------
uzemi_0_18_2024 <- pop_clean %>%
filter(str_detect(str_to_lower(uzemi_typ), "okres|obec")) %>%
mutate(uzemi_txt = sjednot_uzemi(uzemi_txt)) %>%
group_by(uzemi_txt) %>%
summarise(
deti_0_18 = sum(hodnota, na.rm = TRUE),
.groups = "drop"
) %>%
left_join(
ped_uzemi %>% select(kraj, uzemi_txt) %>% distinct(),
by = "uzemi_txt"
) %>%
filter(!is.na(kraj)) %>%
arrange(kraj, uzemi_txt)
uzemi_weighted_2024 <- pop_clean %>%
filter(str_detect(str_to_lower(uzemi_typ), "okres|obec")) %>%
mutate(uzemi_txt = sjednot_uzemi(uzemi_txt)) %>%
group_by(uzemi_txt, vek_group) %>%
summarise(
deti = sum(hodnota, na.rm = TRUE),
.groups = "drop"
) %>%
left_join(
ped_uzemi %>% select(kraj, uzemi_txt) %>% distinct(),
by = "uzemi_txt"
) %>%
filter(!is.na(kraj)) %>%
left_join(weights_age, by = c("vek_group" = "group")) %>%
mutate(weighted_children = deti * vaha) %>%
group_by(kraj, uzemi_txt) %>%
summarise(
weighted_children = sum(weighted_children, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(kraj, uzemi_txt)
# -------------------------
# 11) Základní kapacitní tabulky
# -------------------------
kapacita_kraje <- deti_kraje %>%
left_join(pop_weighted_kraje, by = "kraj") %>%
left_join(pediatri_kraje, by = "kraj") %>%
left_join(uvazky_kraje, by = "kraj") %>%
mutate(
weighted_children = coalesce(weighted_children, 0),
pocet_pediatru = coalesce(pocet_pediatru, 0),
uvazky_celkem = coalesce(uvazky_celkem, 0),
uvazky_60_plus = coalesce(uvazky_60_plus, 0)
) %>%
mutate(
deti_na_pediatra = ifelse(pocet_pediatru > 0, deti_0_18 / pocet_pediatru, NA_real_),
weighted_children_na_fte = ifelse(uvazky_celkem > 0, weighted_children / uvazky_celkem, NA_real_),
podil_60_plus = ifelse(uvazky_celkem > 0, uvazky_60_plus / uvazky_celkem, NA_real_)
) %>%
arrange(kraj)
kapacita_okresy <- uzemi_0_18_2024 %>%
left_join(uzemi_weighted_2024, by = c("kraj", "uzemi_txt")) %>%
left_join(ped_uzemi, by = c("kraj", "uzemi_txt")) %>%
left_join(uvazky_okresy, by = c("kraj", "uzemi_txt")) %>%
mutate(
weighted_children = coalesce(weighted_children, 0),
pocet_pediatru_hlavy = coalesce(pocet_pediatru_hlavy, 0),
uvazky_celkem = coalesce(uvazky_celkem, 0),
uvazky_60_plus = coalesce(uvazky_60_plus, 0)
) %>%
mutate(
deti_na_pediatra = ifelse(pocet_pediatru_hlavy > 0, deti_0_18 / pocet_pediatru_hlavy, NA_real_),
weighted_children_na_fte = ifelse(uvazky_celkem > 0, weighted_children / uvazky_celkem, NA_real_),
podil_60_plus = ifelse(uvazky_celkem > 0, uvazky_60_plus / uvazky_celkem, NA_real_)
) %>%
arrange(kraj, uzemi_txt)
# -------------------------
# 12) Referenční norma weighted children / FTE
# -------------------------
L_star_fte <- if (norma_mode_fte == "manual") {
manual_norma_fte
} else {
sum(kapacita_kraje$weighted_children, na.rm = TRUE) /
sum(kapacita_kraje$uvazky_celkem, na.rm = TRUE)
}
cat("\n=== REFERENČNÍ NORMA ===\n")
cat("L*_F (vážená zátěž na FTE): ", round(L_star_fte, 2), "\n", sep = "")
# -------------------------
# 13) Konstrukce indexu
# -------------------------
build_index <- function(df) {
df %>%
mutate(
x1_deti_na_pediatra = deti_na_pediatra,
x2_weighted_na_fte = weighted_children_na_fte,
x3_rel_tlak_fte = ifelse(
!is.na(weighted_children_na_fte) & !is.na(L_star_fte) & L_star_fte > 0,
pmax(0, weighted_children_na_fte / L_star_fte - 1),
NA_real_
),
x4_podil_60_plus = podil_60_plus
) %>%
mutate(
z1 = safe_z(x1_deti_na_pediatra),
z2 = safe_z(x2_weighted_na_fte),
z3 = safe_z(x3_rel_tlak_fte),
z4 = safe_z(x4_podil_60_plus)
) %>%
mutate(
index_raw = rowMeans(cbind(z1, z2, z3, z4), na.rm = TRUE),
index_0_100 = scale_0_100(index_raw)
) %>%
arrange(desc(index_0_100), desc(index_raw))
}
index_kraje <- build_index(kapacita_kraje)
index_okresy <- build_index(kapacita_okresy)
# -------------------------
# 14) Výstupní tabulky
# -------------------------
kraje_out <- index_kraje %>%
transmute(
kraj,
deti_0_18 = round(deti_0_18, 0),
weighted_children = round(weighted_children, 1),
pocet_pediatru = round(pocet_pediatru, 0),
uvazky_celkem = round(uvazky_celkem, 2),
uvazky_60_plus = round(uvazky_60_plus, 2),
deti_na_pediatra = round(deti_na_pediatra, 1),
weighted_children_na_fte = round(weighted_children_na_fte, 1),
relativni_tlak_nad_normu_fte = round(x3_rel_tlak_fte, 3),
podil_60_plus = round(podil_60_plus * 100, 1),
z_deti_na_pediatra = round(z1, 3),
z_weighted_na_fte = round(z2, 3),
z_rel_tlak_fte = round(z3, 3),
z_podil_60_plus = round(z4, 3),
index_raw = round(index_raw, 3),
index_0_100 = round(index_0_100, 1)
) %>%
arrange(desc(index_0_100))
okresy_out <- index_okresy %>%
transmute(
kraj,
uzemi_txt,
deti_0_18 = round(deti_0_18, 0),
weighted_children = round(weighted_children, 1),
pocet_pediatru_hlavy = round(pocet_pediatru_hlavy, 0),
uvazky_celkem = round(uvazky_celkem, 2),
uvazky_60_plus = round(uvazky_60_plus, 2),
deti_na_pediatra = round(deti_na_pediatra, 1),
weighted_children_na_fte = round(weighted_children_na_fte, 1),
relativni_tlak_nad_normu_fte = round(x3_rel_tlak_fte, 3),
podil_60_plus = round(podil_60_plus * 100, 1),
z_deti_na_pediatra = round(z1, 3),
z_weighted_na_fte = round(z2, 3),
z_rel_tlak_fte = round(z3, 3),
z_podil_60_plus = round(z4, 3),
index_raw = round(index_raw, 3),
index_0_100 = round(index_0_100, 1)
) %>%
arrange(desc(index_0_100), kraj, uzemi_txt)
# -------------------------
# 15) Souhrn
# -------------------------
souhrn_kraje <- kraje_out %>%
summarise(
pocet_regionu = n(),
prumer_index = round(mean(index_0_100, na.rm = TRUE), 2),
median_index = round(median(index_0_100, na.rm = TRUE), 2),
min_index = round(min(index_0_100, na.rm = TRUE), 2),
max_index = round(max(index_0_100, na.rm = TRUE), 2)
)
souhrn_okresy <- okresy_out %>%
summarise(
pocet_regionu = n(),
prumer_index = round(mean(index_0_100, na.rm = TRUE), 2),
median_index = round(median(index_0_100, na.rm = TRUE), 2),
min_index = round(min(index_0_100, na.rm = TRUE), 2),
max_index = round(max(index_0_100, na.rm = TRUE), 2)
)
cat("\n=== INDEX – KRAJE ===\n")
print(kraje_out)
cat("\n=== INDEX – OKRESY / SJEDNOCENÁ ÚZEMÍ ===\n")
print(okresy_out, n = 100)
# -------------------------
# 16) Text do práce
# -------------------------
text_odstavec_1 <- paste0(
"Souhrnný index zatížení a rizikovosti byl konstruován jako průměr čtyř standardizovaných ukazatelů: ",
"počtu dětí ve věku 0–18 let na 1 pediatra, vážené dětské zátěže na 1 pracovní úvazek, ",
"relativního tlaku nad referenční úroveň vážené zátěže na FTE a podílu úvazků pediatrů ve věku 60 a více let."
)
text_odstavec_2 <- paste0(
"Vyšší hodnota indexu znamená méně příznivou situaci regionu, tedy kombinaci vyššího současného zatížení ",
"a vyššího budoucího personálního rizika. Pro interpretační přehlednost byl index převeden také na škálu 0–100, ",
"kde vyšší hodnota označuje relativně rizikovější postavení regionu."
)
text_odstavec_3 <- paste0(
"Na úrovni krajů se index pohyboval od ",
round(min(kraje_out$index_0_100, na.rm = TRUE), 1),
" do ",
round(max(kraje_out$index_0_100, na.rm = TRUE), 1),
" bodu. Na úrovni okresů a sjednocených území se pohyboval od ",
round(min(okresy_out$index_0_100, na.rm = TRUE), 1),
" do ",
round(max(okresy_out$index_0_100, na.rm = TRUE), 1),
" bodu."
)
writeLines(
c(
"5.5 Index zatížení a rizikovosti regionu",
"",
text_odstavec_1,
"",
text_odstavec_2,
"",
text_odstavec_3
),
con = file.path(out_dir, "5_5_text_do_prace.txt"),
useBytes = TRUE
)
# -------------------------
# 17) Grafy - modrý gradient
# pevná osa indexu 0-100
# -------------------------
p_kraje <- ggplot(
kraje_out %>% mutate(kraj = reorder(kraj, index_0_100)),
aes(x = kraj, y = index_0_100, fill = index_0_100)
) +
geom_col() +
coord_flip() +
geom_text(
aes(label = round(index_0_100, 1)),
hjust = -0.1,
size = 3.5
) +
scale_fill_gradient(
low = "#cfe8ff",
high = "#0057b8",
guide = "none"
) +
scale_y_continuous(
limits = c(0, 100),
breaks = seq(0, 100, 10),
labels = label_number(accuracy = 1),
expand = expansion(mult = c(0, 0.06))
) +
labs(
title = "Index zatížení a rizikovosti regionu – kraje",
subtitle = "Vyšší hodnota značí méně příznivou kombinaci zatížení a budoucího personálního rizika",
x = NULL,
y = "Index (0–100)"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
axis.text.y = element_text(size = 10)
)
p_okresy <- ggplot(
okresy_out %>%
slice(1:20) %>%
mutate(uzemi_txt = reorder(uzemi_txt, index_0_100)),
aes(x = uzemi_txt, y = index_0_100, fill = index_0_100)
) +
geom_col() +
coord_flip() +
geom_text(
aes(label = round(index_0_100, 1)),
hjust = -0.1,
size = 3.3
) +
scale_fill_gradient(
low = "#cfe8ff",
high = "#0057b8",
guide = "none"
) +
scale_y_continuous(
limits = c(0, 100),
breaks = seq(0, 100, 10),
labels = label_number(accuracy = 1),
expand = expansion(mult = c(0, 0.06))
) +
labs(
title = "Top 20 území podle indexu zatížení a rizikovosti",
subtitle = "Okresy / sjednocená území s nejméně příznivou relativní situací",
x = NULL,
y = "Index (0–100)"
) +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold"),
axis.text.y = element_text(size = 9)
)
print(p_kraje)
print(p_okresy)
# -------------------------
# 18) Export
# -------------------------
write.csv(
kraje_out,
file.path(out_dir, "index_rizikovosti_kraje.csv"),
row.names = FALSE,
fileEncoding = "UTF-8"
)
write.csv(
okresy_out,
file.path(out_dir, "index_rizikovosti_okresy_sjednocena_uzemi.csv"),
row.names = FALSE,
fileEncoding = "UTF-8"
)
wb <- createWorkbook()
addWorksheet(wb, "vahy_vek")
writeData(wb, "vahy_vek", weights_age)
addWorksheet(wb, "kraje")
writeData(wb, "kraje", kraje_out)
addWorksheet(wb, "okresy_uzemi")
writeData(wb, "okresy_uzemi", okresy_out)
addWorksheet(wb, "souhrn")
writeData(wb, "souhrn", bind_rows(
souhrn_kraje %>% mutate(uroven = "kraje"),
souhrn_okresy %>% mutate(uroven = "okresy_sjednocena_uzemi")
) %>% select(uroven, everything()))
saveWorkbook(
wb,
file.path(out_dir, "index_rizikovosti_regionu_5_5.xlsx"),
overwrite = TRUE
)
ggsave(
filename = file.path(out_dir, "graf_index_kraje.png"),
plot = p_kraje,
width = 10,
height = 6,
dpi = 300
)
ggsave(
filename = file.path(out_dir, "graf_index_top20_uzemi.png"),
plot = p_okresy,
width = 10,
height = 7,
dpi = 300
)
cat("\n=== HOTOVO ===\n")
cat("Výstupy uloženy do: ", out_dir, "\n", sep = "")
cat("- 5_5_text_do_prace.txt\n")
cat("- index_rizikovosti_kraje.csv\n")
cat("- index_rizikovosti_okresy_sjednocena_uzemi.csv\n")
cat("- index_rizikovosti_regionu_5_5.xlsx\n")
cat("- graf_index_kraje.png\n")
cat("- graf_index_top20_uzemi.png\n")
