weight_vec   <- setNames(age_rates_2024$weight_age, age_rates_2024$age_group)
# =========================
# 10) Finální analýza – projekce 2030
# =========================
analysis_base <- 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
) %>%
left_join(proj_kraje_wide, by = "kraj_key")
missing_coef_orp <- analysis_base %>%
filter(
is.na(coef_0) | is.na(coef_1_4) | is.na(coef_5_9) |
is.na(coef_10_14) | is.na(coef_15_18)
) %>%
select(kraj, orp, kraj_key)
if (nrow(missing_coef_orp) > 0) {
cat("\nORP bez napojených koeficientů projekce:\n")
print(missing_coef_orp, n = Inf)
stop("Některá ORP nemají krajské projekční koeficienty.")
}
analysis_orp <- analysis_base %>%
mutate(
g_0_2030     = g_0_2024     * coef_0,
g_1_4_2030   = g_1_4_2024   * coef_1_4,
g_5_9_2030   = g_5_9_2024   * coef_5_9,
g_10_14_2030 = g_10_14_2024 * coef_10_14,
g_15_18_2030 = g_15_18_2024 * coef_15_18,
deti_0_18_2030 =
g_0_2030 + g_1_4_2030 + g_5_9_2030 + g_10_14_2030 + g_15_18_2030,
reg_0_2030     = g_0_2030     * reg_rate_vec[["0"]],
reg_1_4_2030   = g_1_4_2030   * reg_rate_vec[["1_4"]],
reg_5_9_2030   = g_5_9_2030   * reg_rate_vec[["5_9"]],
reg_10_14_2030 = g_10_14_2030 * reg_rate_vec[["10_14"]],
reg_15_18_2030 = g_15_18_2030 * reg_rate_vec[["15_18"]],
registrovani_odhad_2030 =
reg_0_2030 + reg_1_4_2030 + reg_5_9_2030 + reg_10_14_2030 + reg_15_18_2030,
visits_0_2030     = reg_0_2030     * contacts_vec[["0"]],
visits_1_4_2030   = reg_1_4_2030   * contacts_vec[["1_4"]],
visits_5_9_2030   = reg_5_9_2030   * contacts_vec[["5_9"]],
visits_10_14_2030 = reg_10_14_2030 * contacts_vec[["10_14"]],
visits_15_18_2030 = reg_15_18_2030 * contacts_vec[["15_18"]],
navstevy_odhad_2030 =
visits_0_2030 + visits_1_4_2030 + visits_5_9_2030 + visits_10_14_2030 + visits_15_18_2030,
vazena_populace_2030 =
g_0_2030     * weight_vec[["0"]] +
g_1_4_2030   * weight_vec[["1_4"]] +
g_5_9_2030   * weight_vec[["5_9"]] +
g_10_14_2030 * weight_vec[["10_14"]] +
g_15_18_2030 * weight_vec[["15_18"]],
pocet_ordinaci_2030 = pocet_ordinaci_2024,
demograficka_zatez_2030 = deti_0_18_2030 / pocet_ordinaci_2030,
registracni_zatez_2030  = registrovani_odhad_2030 / pocet_ordinaci_2030,
vykonova_zatez_2030     = navstevy_odhad_2030 / pocet_ordinaci_2030,
vazena_zatez_2030       = vazena_populace_2030 / pocet_ordinaci_2030
) %>%
select(
kraj, orp, orp_key,
pocet_ordinaci_2024, pocet_ordinaci_2030,
deti_0_18_2024,
g_0_2024, g_1_4_2024, g_5_9_2024, g_10_14_2024, g_15_18_2024,
g_0_2030, g_1_4_2030, g_5_9_2030, g_10_14_2030, g_15_18_2030,
deti_0_18_2030,
registrovani_odhad_2030,
navstevy_odhad_2030,
vazena_populace_2030,
demograficka_zatez_2030,
registracni_zatez_2030,
vykonova_zatez_2030,
vazena_zatez_2030
) %>%
arrange(desc(vykonova_zatez_2030), desc(registracni_zatez_2030), desc(demograficka_zatez_2030), orp)
if (nrow(analysis_orp) == 0) {
stop("Po spojení dat nezůstal žádný záznam.")
}
# =========================
# 11) Diagnostika
# =========================
summary_stats <- tibble(
ukazatel = c(
"ORP v populačních datech",
"ORP s ordinací v roce 2024",
"ORP v konečné analýze",
"Celkový počet ordinací 2024 v analyzovaných ORP"
),
hodnota = c(
nrow(pop_orp_total),
nrow(ord_orp),
nrow(analysis_orp),
sum(analysis_orp$pocet_ordinaci_2024, na.rm = TRUE)
)
)
# =========================
# 12) TOP 10 nejhorších ORP
# =========================
top_n <- min(10, nrow(analysis_orp))
top10 <- analysis_orp %>%
slice_head(n = top_n) %>%
mutate(
orp_graf = ifelse(
duplicated(orp) | duplicated(orp, fromLast = TRUE),
paste0(orp, " (", kraj, ")"),
orp
),
label_hodnota = fmt_dec1(vykonova_zatez_2030)
) %>%
mutate(
orp_graf = factor(orp_graf, levels = rev(unique(orp_graf)))
)
# =========================
# 13) Graf
# =========================
plot_top10 <- ggplot(top10, aes(x = orp_graf, y = vykonova_zatez_2030)) +
geom_col(fill = "#5B8DB8", width = 0.85) +
geom_text(
aes(label = label_hodnota),
hjust = -0.05,
size = 5
) +
coord_flip(clip = "off") +
scale_y_continuous(
labels = function(x) scales::number(x, accuracy = 1, big.mark = " ", decimal.mark = ","),
expand = expansion(mult = c(0, 0.14))
) +
labs(
title = "TOP 10 nejhorších ORP v roce 2030",
subtitle = "Odhadovaný počet návštěv na 1 ordinaci",
x = NULL,
y = "Odhadovaný počet návštěv na 1 ordinaci"
) +
theme_minimal(base_size = 16) +
theme(
plot.title = element_text(face = "bold", size = 24),
plot.subtitle = element_text(size = 16, margin = margin(b = 12)),
axis.title.y = element_blank(),
axis.text.y = element_text(size = 15),
axis.text.x = element_text(size = 13),
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(20, 80, 20, 20)
)
ggsave(
filename = file.path(output_dir, "7.5.1_top10_orp_odhad_navstev_na_ordinaci_2030.png"),
plot = plot_top10,
width = 14,
height = 8.5,
dpi = 320
)
# =========================
# 14) Export tabulek
# =========================
write_csv(analysis_orp, file.path(output_dir, "7.5.1_projekce_poptavky_a_nabidky_orp_2030.csv"))
write_csv(top10 %>% select(-orp_graf, -label_hodnota), file.path(output_dir, "7.5.1_top10_nejhorsich_orp_2030.csv"))
write_csv(age_rates_2024, file.path(output_dir, "7.5.1_a041_vekove_sazby_2024.csv"))
write_csv(proj_kraje_age, file.path(output_dir, "7.5.1_krajske_koeficienty_populace_2024_2030.csv"))
write_csv(summary_stats, file.path(output_dir, "7.5.1_souhrnne_pocty.csv"))
write_csv(kontrola_base, file.path(output_dir, "7.5.1_kontrola_zakladnich_hodnot.csv"))
wb <- createWorkbook()
addWorksheet(wb, "analyza_orp_2030")
writeData(wb, "analyza_orp_2030", analysis_orp)
addWorksheet(wb, "top10")
writeData(wb, "top10", top10 %>% select(-orp_graf, -label_hodnota))
addWorksheet(wb, "vekove_sazby_2024")
writeData(wb, "vekove_sazby_2024", age_rates_2024)
addWorksheet(wb, "koeficienty_kraje")
writeData(wb, "koeficienty_kraje", proj_kraje_age)
addWorksheet(wb, "souhrn")
writeData(wb, "souhrn", summary_stats)
addWorksheet(wb, "kontrola")
writeData(wb, "kontrola", kontrola_base)
saveWorkbook(
wb,
file = file.path(output_dir, "7.5.1_projekce_poptavky_a_nabidky_orp_2030.xlsx"),
overwrite = TRUE
)
# =========================
# 15) Výpis do konzole
# =========================
cat("\n========================================\n")
cat("7.5.1 HOTOVO\n")
cat("Výstupní složka:\n", output_dir, "\n")
cat("========================================\n\n")
cat("Souhrnné počty:\n")
print(summary_stats, n = Inf)
cat("\nTOP 10 nejhorších ORP – odhad návštěv na 1 ordinaci v roce 2030:\n")
print(
analysis_orp %>%
select(
kraj, orp,
pocet_ordinaci_2030,
deti_0_18_2030,
registrovani_odhad_2030,
navstevy_odhad_2030,
vykonova_zatez_2030
) %>%
slice_head(n = 10),
n = Inf
)
cat("\nKontrola základních hodnot 2024:\n")
print(kontrola_base, n = Inf)
rm(list = ls(all.names = TRUE))
graphics.off()
try(cat("\014"), silent = TRUE)
invisible(gc())
# =========================================================
# 7.5.2 – INDEX ZATÍŽENÍ A „RIZIKOVOST“ REGIONU (ORP, 2030)
# ---------------------------------------------------------
# VYCHÁZÍ Z HOTOVÉHO VÝSTUPU 7.5.1:
# C:/Users/karel/Desktop/7.5.1/7.5.1_projekce_poptavky_a_nabidky_orp_2030.csv
#
# UKAZATELE:
# - demografická zátěž 2030
# - vážená zátěž 2030
# - registrační zátěž 2030
# - výkonová zátěž 2030
#
# INDEX:
# - z_demografická_2030 = z-score(demografická zátěž 2030)
# - z_vážená_2030       = z-score(vážená zátěž 2030)
# - z_registrační_2030  = z-score(registrační zátěž 2030)
# - z_výkonová_2030     = z-score(výkonová zátěž 2030)
# - index_z_orp_2030    = průměr 4 z-score složek
#
# VÝSTUP:
# - matice TOP 10 nejhorších ORP
# - CSV + XLSX
# =========================================================
# =========================
# 0) Balíčky
# =========================
needed_packages <- c(
"readr", "dplyr", "tidyr", "ggplot2",
"scales", "openxlsx", "tibble", "stringr"
)
to_install <- needed_packages[!needed_packages %in% rownames(installed.packages())]
if (length(to_install) > 0) install.packages(to_install)
suppressPackageStartupMessages({
library(readr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(scales)
library(openxlsx)
library(tibble)
library(stringr)
})
options(readr.show_col_types = FALSE)
# =========================
# 1) Cesty
# =========================
input_file <- "C:/Users/karel/Desktop/7.5.1/7.5.1_projekce_poptavky_a_nabidky_orp_2030.csv"
output_dir <- "C:/Users/karel/Desktop/7.5.2"
dir.create(output_dir, recursive = TRUE, showWarnings = FALSE)
if (!file.exists(input_file)) {
stop("Chybí vstupní soubor z kapitoly 7.5.1: ", input_file)
}
# =========================
# 2) Pomocné funkce
# =========================
fmt_int <- function(x) {
scales::number(x, accuracy = 1, big.mark = " ", decimal.mark = ",")
}
fmt_dec1 <- function(x) {
scales::number(x, accuracy = 0.1, big.mark = " ", decimal.mark = ",")
}
fmt_dec2 <- function(x) {
scales::number(x, accuracy = 0.01, big.mark = " ", decimal.mark = ",")
}
z_std <- function(x) {
s <- sd(x, na.rm = TRUE)
m <- mean(x, na.rm = TRUE)
if (is.na(s) || s == 0) return(rep(0, length(x)))
as.numeric((x - m) / s)
}
scale01 <- function(x) {
rng <- range(x, na.rm = TRUE)
if (!is.finite(rng[1]) || !is.finite(rng[2]) || rng[1] == rng[2]) {
return(rep(0.5, length(x)))
}
(x - rng[1]) / (rng[2] - rng[1])
}
# =========================
# 3) Načtení vstupu z 7.5.1
# =========================
analysis_orp <- read_csv(input_file)
required_cols <- c(
"kraj", "orp", "orp_key",
"pocet_ordinaci_2030",
"deti_0_18_2030",
"registrovani_odhad_2030",
"navstevy_odhad_2030",
"vazena_populace_2030",
"demograficka_zatez_2030",
"registracni_zatez_2030",
"vykonova_zatez_2030",
"vazena_zatez_2030"
)
missing_cols <- setdiff(required_cols, names(analysis_orp))
if (length(missing_cols) > 0) {
stop("Ve vstupním souboru chybí sloupce: ", paste(missing_cols, collapse = ", "))
}
analysis_orp <- analysis_orp %>%
mutate(
z_demograficka_2030 = z_std(demograficka_zatez_2030),
z_vazena_2030       = z_std(vazena_zatez_2030),
z_registracni_2030  = z_std(registracni_zatez_2030),
z_vykonova_2030     = z_std(vykonova_zatez_2030),
index_z_orp_2030    = rowMeans(
cbind(
z_demograficka_2030,
z_vazena_2030,
z_registracni_2030,
z_vykonova_2030
),
na.rm = TRUE
)
) %>%
arrange(
desc(index_z_orp_2030),
desc(vykonova_zatez_2030),
desc(registracni_zatez_2030),
desc(demograficka_zatez_2030),
orp
)
if (nrow(analysis_orp) == 0) {
stop("Vstupní soubor je prázdný.")
}
# =========================
# 4) TOP 10 nejhorších ORP
# =========================
top_n <- min(10, nrow(analysis_orp))
top10 <- analysis_orp %>%
slice_head(n = top_n) %>%
mutate(
orp_label = ifelse(
duplicated(orp) | duplicated(orp, fromLast = TRUE),
paste0(orp, " (", kraj, ")"),
orp
)
)
top10_tabulka <- top10 %>%
transmute(
Kraj = kraj,
ORP = orp,
`Ordinace 2030` = pocet_ordinaci_2030,
`Demografická zátěž` = demograficka_zatez_2030,
`Vážená zátěž` = vazena_zatez_2030,
`Registrační zátěž` = registracni_zatez_2030,
`Výkonová zátěž` = vykonova_zatez_2030,
`Index Z-score ORP` = index_z_orp_2030
)
# =========================
# 5) Matice
# =========================
matice_long <- top10 %>%
transmute(
ORP = orp_label,
`Demografická zátěž` = demograficka_zatez_2030,
`Vážená zátěž` = vazena_zatez_2030,
`Registrační zátěž` = registracni_zatez_2030,
`Výkonová zátěž` = vykonova_zatez_2030,
`Index Z-score ORP` = index_z_orp_2030
) %>%
pivot_longer(
cols = -ORP,
names_to = "ukazatel",
values_to = "hodnota"
) %>%
group_by(ukazatel) %>%
mutate(fill_value = scale01(hodnota)) %>%
ungroup() %>%
mutate(
label = case_when(
ukazatel == "Index Z-score ORP" ~ fmt_dec2(hodnota),
TRUE ~ fmt_dec1(hodnota)
)
)
orp_levels <- rev(unique(top10$orp_label))
matice_long <- matice_long %>%
mutate(
ORP = factor(ORP, levels = orp_levels),
ukazatel = factor(
ukazatel,
levels = c(
"Demografická zátěž",
"Vážená zátěž",
"Registrační zátěž",
"Výkonová zátěž",
"Index Z-score ORP"
)
)
)
plot_matice <- ggplot(matice_long, aes(x = ukazatel, y = ORP, fill = fill_value)) +
geom_tile(color = "white", linewidth = 1.1) +
geom_text(aes(label = label), size = 5) +
scale_fill_gradient(
low = "#dceaf6",
high = "#2b67a0",
guide = "none"
) +
scale_x_discrete(position = "top") +
labs(
title = "Index zatížení a „rizikovost“ ORP v roce 2030",
subtitle = "TOP 10 nejhorších ORP podle souhrnného Z-score indexu",
x = NULL,
y = NULL
) +
theme_minimal(base_size = 16) +
theme(
plot.title = element_text(face = "bold", size = 24, hjust = 0),
plot.subtitle = element_text(size = 15, margin = margin(b = 10)),
axis.text.x = element_text(size = 14, face = "bold", angle = 0, hjust = 0.5),
axis.text.y = element_text(size = 15),
panel.grid = element_blank(),
plot.margin = margin(20, 20, 20, 20)
)
ggsave(
filename = file.path(output_dir, "7.5.2_index_rizikovosti_orp_2030_matice.png"),
plot = plot_matice,
width = 15,
height = 9,
dpi = 320,
bg = "white"
)
# =========================
# 6) Souhrn
# =========================
summary_stats <- tibble(
ukazatel = c(
"Počet ORP v analýze",
"Počet ordinací 2030 (konstantně dle 2024)",
"Nejhorší ORP dle indexu",
"Hodnota indexu nejhoršího ORP"
),
hodnota = c(
nrow(analysis_orp),
sum(analysis_orp$pocet_ordinaci_2030, na.rm = TRUE),
top10$orp[1],
round(top10$index_z_orp_2030[1], 4)
)
)
# =========================
# 7) Export CSV
# =========================
write_csv(analysis_orp, file.path(output_dir, "7.5.2_index_rizikovosti_orp_2030.csv"))
write_csv(top10_tabulka, file.path(output_dir, "7.5.2_top10_nejhorsich_orp_2030.csv"))
write_csv(summary_stats, file.path(output_dir, "7.5.2_souhrnne_pocty.csv"))
# =========================
# 8) Excel
# =========================
wb <- createWorkbook()
addWorksheet(wb, "analyza_orp_2030")
writeData(wb, "analyza_orp_2030", analysis_orp)
addWorksheet(wb, "top10")
writeData(wb, "top10", top10_tabulka)
addWorksheet(wb, "souhrn")
writeData(wb, "souhrn", summary_stats)
saveWorkbook(
wb,
file = file.path(output_dir, "7.5.2_index_rizikovosti_orp_2030.xlsx"),
overwrite = TRUE
)
# =========================
# 9) Text metodiky
# =========================
writeLines(
c(
"7.5.2 – Index zatížení a rizikovosti ORP v roce 2030",
"",
"Vstupem je hotový výstup kapitoly 7.5.1.",
"Souhrnný index je vypočten jako průměr čtyř standardizovaných ukazatelů:",
"- demografická zátěž 2030",
"- vážená zátěž 2030",
"- registrační zátěž 2030",
"- výkonová zátěž 2030",
"",
"Vyšší hodnota indexu znamená vyšší relativní rizikovost ORP."
),
con = file.path(output_dir, "7.5.2_metodika.txt")
)
# =========================
# 10) Konzole
# =========================
cat("\n========================================\n")
cat("7.5.2 HOTOVO\n")
cat("Výstupní složka:\n", output_dir, "\n")
cat("========================================\n\n")
cat("TOP 10 nejhorších ORP podle indexu:\n")
print(
analysis_orp %>%
select(
kraj, orp,
demograficka_zatez_2030,
vazena_zatez_2030,
registracni_zatez_2030,
vykonova_zatez_2030,
index_z_orp_2030
) %>%
slice_head(n = 10),
n = Inf
)
cat("\nSouhrn:\n")
print(summary_stats, n = Inf)
cat("\nVytvořené soubory:\n")
cat("- 7.5.2_index_rizikovosti_orp_2030_matice.png\n")
cat("- 7.5.2_index_rizikovosti_orp_2030.csv\n")
cat("- 7.5.2_top10_nejhorsich_orp_2030.csv\n")
cat("- 7.5.2_souhrnne_pocty.csv\n")
cat("- 7.5.2_index_rizikovosti_orp_2030.xlsx\n")
cat("- 7.5.2_metodika.txt\n")
