)
ggsave(
filename = file.path(out_dir, "mapa_vykonova_zatez_na_1_FTE_kraje.png"),
plot = p_map,
width = 11.5,
height = 8,
dpi = 300,
bg = "white"
)
# -------------------------
# 10) Export
# -------------------------
write_csv(navstevy_kraje, file.path(out_dir, "01_navstevy_kraje_A041_regiony24.csv"))
write_csv(uvazky_kraje, file.path(out_dir, "02_uvazky_kraje.csv"))
write_csv(vykonova_tbl, file.path(out_dir, "03_vykonova_zatez_kraje.csv"))
write_csv(tabulka_vykonova, file.path(out_dir, "04_tabulka_vykonova_zatez.csv"))
wb <- createWorkbook()
title_style <- createStyle(
textDecoration = "bold",
fontSize = 12,
halign = "center",
valign = "center"
)
header_style <- createStyle(
textDecoration = "bold",
halign = "center",
valign = "center",
border = "Bottom"
)
addWorksheet(wb, "navstevy_kraje")
writeData(wb, "navstevy_kraje", navstevy_kraje)
addWorksheet(wb, "uvazky_kraje")
writeData(wb, "uvazky_kraje", uvazky_kraje)
addWorksheet(wb, "vykonova_zatez")
writeData(wb, "vykonova_zatez", vykonova_tbl)
addWorksheet(wb, "tabulka_do_prace")
writeData(
wb, "tabulka_do_prace",
"Tabulka. Výkonová zátěž pediatrické péče podle krajů v roce 2024",
startRow = 1, startCol = 1
)
mergeCells(wb, "tabulka_do_prace", cols = 1:5, rows = 1)
addStyle(wb, "tabulka_do_prace", title_style, rows = 1, cols = 1, gridExpand = TRUE)
writeData(
wb, "tabulka_do_prace",
tabulka_vykonova,
startRow = 3, startCol = 1,
headerStyle = header_style
)
setColWidths(wb, "navstevy_kraje", cols = 1:2, widths = "auto")
setColWidths(wb, "uvazky_kraje", cols = 1:2, widths = "auto")
setColWidths(wb, "vykonova_zatez", cols = 1:4, widths = "auto")
setColWidths(wb, "tabulka_do_prace", cols = 1:5, widths = c(10, 24, 18, 16, 20))
saveWorkbook(
wb,
file.path(out_dir, "vykonova_zatez_kraje.xlsx"),
overwrite = TRUE
)
# -------------------------
# 11) Výpis
# -------------------------
cat("\n========================================================\n")
cat("VÝKONOVÁ ZÁTĚŽ KRAJŮ – HOTOVO\n")
cat("========================================================\n")
cat("Zdroj návštěv: A041 / regiony 24 / B9:O9\n")
cat("Zdroj krajů:   A041 / regiony 24 / B7:O7\n")
cat("Výstupní složka:\n", out_dir, "\n\n", sep = "")
print(vykonova_tbl, n = Inf)
cat("\nUloženo:\n")
cat("- graf_vykonova_zatez_na_1_FTE_kraje.png\n")
cat("- mapa_vykonova_zatez_na_1_FTE_kraje.png\n")
cat("- 4 CSV soubory\n")
cat("- vykonova_zatez_kraje.xlsx\n")
cat("========================================================\n")
rm(list = ls(all.names = TRUE))
gc()
cat("\014")
graphics.off()
# =========================================================
# VÝKONOVÁ ZÁTĚŽ KRAJŮ 2024
# ---------------------------------------------------------
# výkonová zátěž = celkové návštěvy / celkové úvazky
#
# regiony 24:
#   B7:O7  = kraje
#   B9:O9  = celkové počty návštěv
#
# výstupy:
#   - tabulka krajů
#   - graf výkonové zátěže
#   - mapa výkonové zátěže
#   - CSV + XLSX + PNG
# =========================================================
# -------------------------
# 0) Balíčky
# -------------------------
needed_packages <- c(
"readxl", "dplyr", "stringr", "ggplot2",
"sf", "RCzechia", "scales", "openxlsx", "readr"
)
to_install <- needed_packages[!needed_packages %in% rownames(installed.packages())]
if (length(to_install) > 0) install.packages(to_install)
suppressPackageStartupMessages({
library(readxl)
library(dplyr)
library(stringr)
library(ggplot2)
library(sf)
library(RCzechia)
library(scales)
library(openxlsx)
library(readr)
})
options(readxl.show_progress = FALSE)
# -------------------------
# 1) Cesty
# -------------------------
file_pldd <- "C:/Users/karel/Desktop/registrace/Datovy-souhrn-SSS-07-13-vykaz-a041-prakticky-lekar-pro-deti-a-dorost-2025-01.xlsx"
sheet_pldd <- "regiony 24"
file_uvazky <- "C:/Users/karel/Desktop/uvazky/Datovy-souhrn-NR-02-01-pracovnici-uvazky-zp-vek-pohlavi-kraj-okres-2024-01.xlsx"
sheet_uvazky <- "kraje_clean"
out_dir <- "C:/Users/karel/Desktop/6.2.2"
if (!dir.exists(out_dir)) dir.create(out_dir, recursive = TRUE)
if (!file.exists(file_pldd)) stop("Chybí soubor PLDD:\n", file_pldd)
if (!file.exists(file_uvazky)) stop("Chybí soubor úvazků:\n", file_uvazky)
if (!(sheet_pldd %in% excel_sheets(file_pldd))) {
stop("V souboru PLDD chybí list: ", sheet_pldd)
}
if (!(sheet_uvazky %in% excel_sheets(file_uvazky))) {
stop("V souboru úvazků chybí list: ", sheet_uvazky)
}
# -------------------------
# 2) Parametry
# -------------------------
valid_kraje <- c(
"Hlavní město Praha", "Středočeský kraj", "Jihočeský kraj", "Plzeňský kraj",
"Karlovarský kraj", "Ústecký kraj", "Liberecký kraj", "Královéhradecký kraj",
"Pardubický kraj", "Kraj Vysočina", "Jihomoravský kraj", "Olomoucký kraj",
"Zlínský kraj", "Moravskoslezský kraj"
)
# -------------------------
# 3) Pomocné funkce
# -------------------------
clean_name <- function(x) {
x %>%
as.character() %>%
str_squish() %>%
str_replace_all("\\s+", " ") %>%
str_trim()
}
normalize_text <- function(x) {
x <- as.character(x)
x <- iconv(x, from = "", to = "ASCII//TRANSLIT")
x[is.na(x)] <- ""
x <- tolower(x)
x <- gsub("\u00A0", " ", x, fixed = TRUE)
x <- gsub("\\s+", " ", x)
trimws(x)
}
to_num <- function(x) {
if (is.numeric(x)) return(x)
x <- as.character(x)
x <- gsub("\u00A0", " ", x, fixed = TRUE)
x <- gsub("\\s+", "", x)
x <- gsub(",", ".", x, fixed = TRUE)
suppressWarnings(as.numeric(x))
}
fmt_num <- function(x) {
ifelse(
abs(x - round(x)) < 1e-9,
format(round(x), big.mark = " ", decimal.mark = ",", scientific = FALSE, trim = TRUE),
format(round(x, 1), nsmall = 1, big.mark = " ", decimal.mark = ",", scientific = FALSE, trim = TRUE)
)
}
find_first_existing_col <- function(df, candidates) {
hit <- candidates[candidates %in% names(df)]
if (length(hit) == 0) return(NA_character_)
hit[1]
}
normalize_kraj <- function(x) {
x <- clean_name(x)
x <- str_replace_all(x, "–", "-")
x <- str_replace_all(x, "—", "-")
dplyr::case_when(
x %in% c("Hl. město Praha", "Hl. m. Praha", "Hlavní město Praha", "Praha") ~ "Hlavní město Praha",
x %in% c("Středočeský kraj") ~ "Středočeský kraj",
x %in% c("Jihočeský kraj") ~ "Jihočeský kraj",
x %in% c("Plzeňský kraj") ~ "Plzeňský kraj",
x %in% c("Karlovarský kraj") ~ "Karlovarský kraj",
x %in% c("Ústecký kraj") ~ "Ústecký kraj",
x %in% c("Liberecký kraj") ~ "Liberecký kraj",
x %in% c("Královéhradecký kraj") ~ "Královéhradecký kraj",
x %in% c("Pardubický kraj") ~ "Pardubický kraj",
x %in% c("Kraj Vysočina", "Vysočina") ~ "Kraj Vysočina",
x %in% c("Jihomoravský kraj") ~ "Jihomoravský kraj",
x %in% c("Olomoucký kraj") ~ "Olomoucký kraj",
x %in% c("Zlínský kraj") ~ "Zlínský kraj",
x %in% c("Moravskoslezský kraj") ~ "Moravskoslezský kraj",
TRUE ~ x
)
}
theme_prace <- function(base_size = 12) {
theme_minimal(base_size = base_size) +
theme(
plot.title = element_text(face = "bold", size = base_size + 2, color = "black", hjust = 0.5),
plot.subtitle = element_text(size = base_size - 1, color = "black", hjust = 0.5),
axis.title = element_text(face = "bold", color = "black"),
axis.text = element_text(color = "black"),
legend.title = element_text(face = "bold", color = "black"),
legend.text = element_text(color = "black"),
plot.caption = element_text(color = "black", hjust = 1),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_line(color = "grey80", linewidth = 0.35),
plot.background = element_rect(fill = "white", color = NA),
panel.background = element_rect(fill = "white", color = NA),
legend.background = element_rect(fill = "white", color = NA),
legend.key = element_rect(fill = "white", color = NA)
)
}
read_uvazky_sheet <- function(path, sheet) {
x1 <- read_excel(path, sheet = sheet, guess_max = 50000)
names(x1) <- names(x1) %>% as.character() %>% str_squish()
total_col1 <- find_first_existing_col(x1, c("Celkem", "Celkem...7", "Celkem...8"))
if (!is.na(total_col1)) return(x1)
x2 <- read_excel(path, sheet = sheet, skip = 1, guess_max = 50000)
names(x2) <- names(x2) %>% as.character() %>% str_squish()
total_col2 <- find_first_existing_col(x2, c("Celkem", "Celkem...7", "Celkem...8"))
if (!is.na(total_col2)) return(x2)
stop("Na listu ", sheet, " se nepodařilo načíst sloupec 'Celkem'.")
}
find_kraj_name_column <- function(sf_obj, valid_kraje) {
df <- st_drop_geometry(sf_obj)
candidate_cols <- names(df)
scores <- lapply(candidate_cols, function(col) {
vals <- df[[col]]
vals_chr <- as.character(vals)
normed <- normalize_kraj(vals_chr)
n_match <- sum(!is.na(normed) & normed %in% valid_kraje)
data.frame(
column = col,
n_match = n_match,
stringsAsFactors = FALSE
)
})
scores <- bind_rows(scores) %>%
arrange(desc(n_match), column)
if (nrow(scores) == 0 || max(scores$n_match, na.rm = TRUE) == 0) {
return(NA_character_)
}
scores$column[1]
}
# -------------------------
# 4) Návštěvy z A041 – regiony 24
# -------------------------
raw_pldd_reg <- read_excel(file_pldd, sheet = sheet_pldd, col_names = FALSE)
# pevně:
# B7:O7 = kraje
# B9:O9 = celkové návštěvy
col_idx <- 2:15
row_kraje <- 7
row_navstevy_celkem <- 9
kraje_raw <- raw_pldd_reg[row_kraje, col_idx] %>%
unlist(use.names = FALSE) %>%
as.character() %>%
str_squish()
navstevy_raw <- raw_pldd_reg[row_navstevy_celkem, col_idx] %>%
unlist(use.names = FALSE)
navstevy_kraje <- tibble(
kraj = normalize_kraj(kraje_raw),
navstevy_celkem = to_num(navstevy_raw)
) %>%
filter(!is.na(kraj), kraj %in% valid_kraje) %>%
mutate(
kraj = factor(kraj, levels = valid_kraje)
) %>%
arrange(kraj) %>%
mutate(kraj = as.character(kraj))
cat("=== NÁVŠTĚVY PODLE KRAJŮ (B9:O9) ===\n")
print(navstevy_kraje, n = Inf)
if (nrow(navstevy_kraje) != 14) {
stop("Počet krajů z A041 není 14.")
}
if (length(unique(na.omit(navstevy_kraje$navstevy_celkem))) <= 1) {
stop("Návštěvy se načetly chybně – hodnoty jsou stejné nebo chybí.")
}
# -------------------------
# 5) Úvazky z kraje_clean
# -------------------------
uv_raw <- read_uvazky_sheet(file_uvazky, sheet_uvazky)
names(uv_raw) <- names(uv_raw) %>% as.character() %>% str_squish()
cat("\n=== NÁZVY SLOUPCŮ – KRAJSKÉ ÚVAZKY ===\n")
print(names(uv_raw))
col_kraj_uv <- find_first_existing_col(uv_raw, c("Kraj", "kraj"))
col_total_uv <- find_first_existing_col(uv_raw, c("Celkem...7", "Celkem...8", "Celkem"))
if (is.na(col_kraj_uv)) col_kraj_uv <- names(uv_raw)[1]
if (is.na(col_total_uv)) col_total_uv <- names(uv_raw)[7]
if (any(is.na(c(col_kraj_uv, col_total_uv)))) {
stop("Na listu kraje_clean nebyly nalezeny potřebné sloupce.")
}
uvazky_kraje <- uv_raw %>%
transmute(
kraj = normalize_kraj(.data[[col_kraj_uv]]),
uvazky_celkem = to_num(.data[[col_total_uv]])
) %>%
filter(!is.na(kraj), kraj != "", kraj != "ČR", kraj %in% valid_kraje) %>%
filter(!is.na(uvazky_celkem)) %>%
group_by(kraj) %>%
summarise(
uvazky_celkem = sum(uvazky_celkem, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
kraj = factor(kraj, levels = valid_kraje)
) %>%
arrange(kraj) %>%
mutate(kraj = as.character(kraj))
cat("\n=== ÚVAZKY PODLE KRAJŮ ===\n")
print(uvazky_kraje, n = Inf)
# -------------------------
# 6) Spojení + výkonová zátěž
# -------------------------
vykonova_tbl <- tibble(kraj = valid_kraje) %>%
left_join(navstevy_kraje, by = "kraj") %>%
left_join(uvazky_kraje, by = "kraj") %>%
mutate(
navstevy_celkem = coalesce(navstevy_celkem, 0),
uvazky_celkem = coalesce(uvazky_celkem, 0),
vykonova_zatez_na_fte = ifelse(
uvazky_celkem > 0,
navstevy_celkem / uvazky_celkem,
NA_real_
)
) %>%
arrange(desc(vykonova_zatez_na_fte))
cat("\n=== FINÁLNÍ TABULKA – VÝKONOVÁ ZÁTĚŽ ===\n")
print(vykonova_tbl, n = Inf)
# -------------------------
# 7) Tabulka do práce
# -------------------------
tabulka_vykonova <- vykonova_tbl %>%
transmute(
Pořadí = row_number(),
Kraj = kraj,
`Celkové návštěvy` = fmt_num(navstevy_celkem),
`Úvazky celkem` = fmt_num(uvazky_celkem),
`Výkonová zátěž na 1 FTE` = fmt_num(vykonova_zatez_na_fte)
)
# -------------------------
# 8) Graf
# -------------------------
plot_vykonova <- vykonova_tbl %>%
arrange(vykonova_zatez_na_fte) %>%
mutate(
kraj = factor(kraj, levels = kraj),
stitek = fmt_num(vykonova_zatez_na_fte)
)
p_vykonova <- ggplot(plot_vykonova, aes(x = vykonova_zatez_na_fte, y = kraj)) +
geom_col(fill = "#5A7FAE", width = 0.7) +
geom_text(
aes(label = stitek),
hjust = -0.1,
size = 3.2,
color = "black"
) +
scale_x_continuous(
limits = c(0, max(plot_vykonova$vykonova_zatez_na_fte, na.rm = TRUE) * 1.18)
) +
labs(
title = "Výkonová zátěž na 1 FTE podle krajů v roce 2024",
subtitle = "Výkonová zátěž vyjádřená jako celkové návštěvy na 1 FTE",
x = "Návštěvy na 1 FTE",
y = NULL
) +
theme_prace(12)
ggsave(
filename = file.path(out_dir, "graf_vykonova_zatez_na_1_FTE_kraje.png"),
plot = p_vykonova,
width = 11,
height = 7.5,
dpi = 300,
bg = "white"
)
# -------------------------
# 9) Mapa
# -------------------------
kraje_sf <- RCzechia::kraje() %>%
st_transform(4326)
name_col_sf <- find_kraj_name_column(kraje_sf, valid_kraje)
if (is.na(name_col_sf)) {
stop("Nepodařilo se najít sloupec s názvy krajů v polygonové vrstvě.")
}
kraje_sf <- kraje_sf %>%
mutate(kraj = normalize_kraj(.data[[name_col_sf]])) %>%
left_join(vykonova_tbl %>% select(kraj, vykonova_zatez_na_fte), by = "kraj")
label_pts <- st_point_on_surface(kraje_sf)
label_coords <- st_coordinates(label_pts)
labels_df <- kraje_sf %>%
st_drop_geometry() %>%
mutate(
X = label_coords[, 1],
Y = label_coords[, 2],
label_short = str_replace(kraj, " kraj", ""),
label_short = str_replace(label_short, "Hlavní město ", ""),
label = paste0(label_short, "\n", fmt_num(vykonova_zatez_na_fte))
)
p_map <- ggplot() +
geom_sf(
data = kraje_sf,
aes(fill = vykonova_zatez_na_fte),
color = "#7FA2C6",
linewidth = 0.5
) +
geom_text(
data = labels_df,
aes(x = X, y = Y, label = label),
size = 3,
color = "black",
lineheight = 0.95
) +
scale_fill_gradient(
low = "#DCEBFA",
high = "#0D4F8B",
name = "Návštěvy\nna 1 FTE",
labels = function(x) format(round(x, 1), big.mark = " ", decimal.mark = ",", scientific = FALSE)
) +
labs(
title = "Obr. 2: Výkonová zátěž pediatrické péče podle krajů v roce 2024",
subtitle = "Celkové návštěvy na 1 FTE",
caption = "Zdroj návštěv: A041, sheet 'regiony 24', B9:O9."
) +
coord_sf(datum = NA) +
theme_prace(12) +
theme(
legend.position = "right",
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid.major = element_blank()
)
ggsave(
filename = file.path(out_dir, "mapa_vykonova_zatez_na_1_FTE_kraje.png"),
plot = p_map,
width = 11.5,
height = 8,
dpi = 300,
bg = "white"
)
# -------------------------
# 10) Export
# -------------------------
write_csv(navstevy_kraje, file.path(out_dir, "01_navstevy_kraje_A041_regiony24.csv"))
write_csv(uvazky_kraje, file.path(out_dir, "02_uvazky_kraje.csv"))
write_csv(vykonova_tbl, file.path(out_dir, "03_vykonova_zatez_kraje.csv"))
write_csv(tabulka_vykonova, file.path(out_dir, "04_tabulka_vykonova_zatez.csv"))
wb <- createWorkbook()
title_style <- createStyle(
textDecoration = "bold",
fontSize = 12,
halign = "center",
valign = "center"
)
header_style <- createStyle(
textDecoration = "bold",
halign = "center",
valign = "center",
border = "Bottom"
)
addWorksheet(wb, "navstevy_kraje")
writeData(wb, "navstevy_kraje", navstevy_kraje)
addWorksheet(wb, "uvazky_kraje")
writeData(wb, "uvazky_kraje", uvazky_kraje)
addWorksheet(wb, "vykonova_zatez")
writeData(wb, "vykonova_zatez", vykonova_tbl)
addWorksheet(wb, "tabulka_do_prace")
writeData(
wb, "tabulka_do_prace",
"Tabulka. Výkonová zátěž pediatrické péče podle krajů v roce 2024",
startRow = 1, startCol = 1
)
mergeCells(wb, "tabulka_do_prace", cols = 1:5, rows = 1)
addStyle(wb, "tabulka_do_prace", title_style, rows = 1, cols = 1, gridExpand = TRUE)
writeData(
wb, "tabulka_do_prace",
tabulka_vykonova,
startRow = 3, startCol = 1,
headerStyle = header_style
)
setColWidths(wb, "navstevy_kraje", cols = 1:2, widths = "auto")
setColWidths(wb, "uvazky_kraje", cols = 1:2, widths = "auto")
setColWidths(wb, "vykonova_zatez", cols = 1:4, widths = "auto")
setColWidths(wb, "tabulka_do_prace", cols = 1:5, widths = c(10, 24, 18, 16, 20))
saveWorkbook(
wb,
file.path(out_dir, "vykonova_zatez_kraje.xlsx"),
overwrite = TRUE
)
# -------------------------
# 11) Výpis
# -------------------------
cat("\n========================================================\n")
cat("VÝKONOVÁ ZÁTĚŽ KRAJŮ – HOTOVO\n")
cat("========================================================\n")
cat("Zdroj návštěv: A041 / regiony 24 / B9:O9\n")
cat("Zdroj krajů:   A041 / regiony 24 / B7:O7\n")
cat("Výstupní složka:\n", out_dir, "\n\n", sep = "")
print(vykonova_tbl, n = Inf)
cat("\nUloženo:\n")
cat("- graf_vykonova_zatez_na_1_FTE_kraje.png\n")
cat("- mapa_vykonova_zatez_na_1_FTE_kraje.png\n")
cat("- 4 CSV soubory\n")
cat("- vykonova_zatez_kraje.xlsx\n")
cat("========================================================\n")
