CZEs on JLA Data

Model mezd v zrcadle času

Wed, 23 Jul 2025 00:00:00 +0000

Když jsem před lety sepisoval populárně poučný příspěvek o odhadování exponenciály metodou nejmenších čtverců – dělá se to přes stats::nls() – tak jsem použil vědomě lehčí formulace problému coby mezd ajťáků v časech Andreje Babiše. Tím jsem svojí exponenciálu zasadil do času a prostoru.

Rok se sešel s rokem, volební období s obdobím, a z obrazovek nás opět bombardují politici s tím že tentokráte určitě bude líp, stačí když dáme hlas jim (a ne těm druhým). Přišlo mi to jako zajímavá příležitost k tomu, abych se vrátil do staré řeky a oprášil techniky práce s geometrickou řadou v kontextu statistického programovacího jazyka R.

Cílem cvičení bude:

připomenout techniku, jak pomocí balíčku {czso} přistupovat k datům z Veřejné databáze Českého statistického úřadu přímo do R vaší session
načtený dataset zpracovat technikami světa {tidyverse}, konkrétně balíčky {dplyr} pro datovou manipulaci a {ggplot2} pro statickou vizualizaci
o datasetu mezd a jejich vývoji v čase podat zprávu graficky
nad datasetem mezd sestavit matematický model, a uplatnit jej

Protože mzdy a jejich vývoj v čase je složitý problém, který není snadné plně podchytit v jeho komplexnosti, zaměřím se na dva sektory ve kterých se pohybuju a se kterými mám žitou zkušenost:

jako konzultant působím v sektoru J - Informační a komunikační činnosti (“ajťáci”)
jako student a vyučující na VŠE patřím do sektoru P - Vzdělávání (“učitelky”)

Základem je načtení dat:

library(czso) # protože staťák...
library(tidyverse) # kvůli dplyr & ggplot2
library(zoo) # pro konverzi datumů / kvartály v letech

# načtu dataset s id 110079  = Zaměstnanci a průměrné hrubé měsíční mzdy podle odvětví
raw_mzdy <- czso::czso_get_table("110079")

# odliji stranou čistší dataset
clean_mzdy <- raw_mzdy %>% 
  filter(stapro_kod == '5958'  # průměrná mzda / zahazuju počty zaměstnanců
         & rok >= 2016
         & typosoby_kod == '200'# přepočet na ekvivalent plného úvazku
         & odvetvi_kod %in% c('P', 'J')) %>% # vybrané sektory
  # konverze konvence z roku + čtvrtletí na prosté datum (první den kvartálu)
  mutate(datum = as.Date(as.yearqtr(paste0(rok, "Q", ctvrtleti))))  %>% 
  arrange(datum) %>% # setřídím dle data / pro jistotu, kvůli sekvenci v příštím kroku
  group_by(odvetvi_kod) %>% 
  mutate(sekvence = rank(datum),
         posledni = datum == max(datum)) %>%  # poslední záznam - pro popisku grafů
  ungroup()

Nad načtenými daty připravím vizualizaci technikami ggplot2-u; je zajímavé pozorovat jak mzdy ajťáků i učitelek mají stejně jasný sezónní trend (1× ročně bonusy) ale se špičkami v různých čtvrtletích.

Pracovně se domnívám, že učitelky mají odměny spíše svázané s rozpočtem (vyplácené v Q4, aby se utratilo), kdežto ajťáci spíše s hospodářským výsledkem (vyplácené v Q1, po závěrce roku).

# základní overview graficky
ggplot(data = clean_mzdy, aes(x = datum, y = hodnota, 
                              fill = odvetvi_txt)) +
  geom_point(pch = 21, stroke = NA) +
  scale_y_continuous(limits = c(0, NA), 
                     labels = scales::dollar_format(prefix = "", 
                                                    suffix = " Kč",
                                                    big.mark = " ")) +  
  scale_x_date(breaks = seq(as.Date("2015-01-01"),
                            as.Date("2025-01-01"),
                            by = "2 years"),
               date_minor_breaks = "1 year",
               date_labels = "%Y") +
  labs(title = "Průměrná hrubá měsíční mzda v čase",
       fill = "Sektor podle ČSÚ") +
  theme_minimal() +
  theme(legend.position = c(0.795, 0.175),
        legend.direction = "vertical",
        axis.title = element_blank())

Kromě výrazné roční periody je v grafech (hlavně na učitelkách) intuitivně cítit změna trendu kolem konce roku 2021. Tuto intuici můžeme ověřit odděleným natrénováním matematického modelu nad érami Andreje Babiše a Petra Fialy.

Předpoklad za modelem je, že se mzda se chová jako exponenciála (každý kvartál vzroste o stejné relativní procento) a ne jako přímka (každý kvartál vzroste o stejnou absolutní částku).

# omezený dataset "éra Andreje Babiše" pro trénink modelu
era_babise <- clean_mzdy %>% 
  filter(datum >= as.Date("2017-12-13")  # počátek první vlády AB
         & datum < as.Date("2021-12-17"))   # konec druhé vlády AB
 

# omezený dataset "éra Petra Fialy" pro trénink modelu
era_fialy <- clean_mzdy %>% 
  filter(datum >= as.Date("2021-12-17"))  # jmenování PF prezidentem MZ
  
# 4x matematický model přes stats::nls()
model_babis_p <- nls(hodnota ~ a * (1 + r)^sekvence,
                     data = subset(era_babise, odvetvi_kod == "P"),
                     start = list(a = 50000, r = .01)) 

model_babis_j <- nls(hodnota ~ a * (1 + r)^sekvence,
                     data = subset(era_babise, odvetvi_kod == "J"),
                     start = list(a = 50000, r = .01))  

model_fiala_p <- nls(hodnota ~ a * (1 + r)^sekvence,
                     data = subset(era_fialy, odvetvi_kod == "P"),
                     start = list(a = 50000, r = .01))  

model_fiala_j <- nls(hodnota ~ a * (1 + r)^sekvence,
                     data = subset(era_fialy, odvetvi_kod == "J"),
                     start = list(a = 50000, r = .01))

Když přepočteme kvartální růst mezd na roční ekvivalenty, tak se dostaneme na následující čísla:

ajťákům v časech Andreje Babiše rostly mzdy o 4.74% ročně
ajťákům v časech Petra Fialy rostly mzdy o 8.91% ročně
učitelkám v časech Andreje Babiše rostly mzdy o 11.2% ročně
učitelkám v časech Petra Fialy rostly mzdy o 4.52% ročně

Je velká otázka, jak moc můžeme modelovaný nárůst (a jeho změnu mezi vládami) přisuzovat za zásluhu konkrétnímu premiérovi. Těžko tvrdit, že Babiš může za Covid, případně Fiala za Ukrajinu. Ale říct, že za časů jednoho bylo jednak, a za časů druhého druhak, jde snadno - datumy začátku a konce vlád jsou ložené.

A také si můžeme společně zaspekulovat: jak by vypadal svět, pokud by se trend nezměnil? Jak by vypadaly dnes mzdy ajťáků a učitelek, pokud by pokračovalo tempo předchozí vlády?

Pomocníkem v našem spekulování bude metoda stats::predict.nls(), jejímž uplatněním na natrénovaný matematický model získáme nová data – a s jejich pomocí obohatíme původní obrázek o původní a nový trend.

Pro snazší orientaci barvím éru Petra Fialy fialově, a éru Andreje Babiše korporátní zelenou.

# pomocný dataset pro oddělený výpočet trendů v érách
trendy <- clean_mzdy %>% 
  select(datum, sekvence, posledni) %>% 
  unique() %>% 
  mutate(era = case_when(datum <= as.Date("2017-12-13") ~ "sobotka",
                         datum <= as.Date("2021-12-17") ~ "babis",
                         T ~ "fiala"))

# trendy ajťáků v datasetu
trendy$ab_p <- predict(model_babis_p, newdata = trendy)
trendy$pf_p <- predict(model_fiala_p, newdata = trendy)

# trendy učitelů v datasetu
trendy$ab_j <- predict(model_babis_j, newdata = trendy)
trendy$pf_j <- predict(model_fiala_j, newdata = trendy)

# výsledný obrázek - původní ggplot, doplněný o trendové čáry
ggplot(data = clean_mzdy, aes(x = datum, y = hodnota)) +
  geom_point(aes(fill = odvetvi_txt),
             stroke = NA,
             pch = 21)  +
  scale_y_continuous(limits = c(0, NA), 
                     labels = scales::dollar_format(prefix = "", 
                                                    suffix = " Kč",
                                                    big.mark = " ")) +  
  scale_x_date(breaks = seq(as.Date("2015-01-01"),
                            as.Date("2025-01-01"),
                            by = "2 years"),
               date_minor_breaks = "1 year",
               date_labels = "%Y") +
  geom_line(data = trendy, aes(x = datum, y = ab_p), 
            color = "grey", lty = "dashed") +
  geom_line(data = subset(trendy, era == "babis"), 
            aes(x = datum, y = ab_p, color = "AB")) +
  geom_line(data = subset(trendy, era == "fiala"), 
            aes(x = datum, y = pf_p, color = "PF")) +
  geom_line(data = trendy, aes(x = datum, y = ab_j), 
            color = "grey", lty = "dashed") +
  geom_line(data = subset(trendy, era == "babis"), 
            aes(x = datum, y = ab_j, color = "AB")) +
  geom_line(data = subset(trendy, era == "fiala"), 
            aes(x = datum, y = pf_j, color = "PF")) +
  geom_text(data = subset(clean_mzdy, posledni), 
            aes(x = datum, y = hodnota, label = scales::comma(hodnota)),
            nudge_x = 250) +
  geom_text(data = subset(trendy, posledni), 
            aes(x = datum, y = ab_p, label = scales::comma(ab_p)),
            color = "gray70",
            nudge_x = 250) +
  geom_text(data = subset(trendy, posledni), 
            aes(x = datum, y = ab_j, label = scales::comma(ab_j)),
            color = "gray70",
            nudge_x = 250) +
  scale_color_manual("Éra vlády", 
                     values = c("AB" = "#5c9234",
                                "PF" = "darkorchid")) +
  labs(title = "Trendy mezd v érách Babiše a Fialy",
       fill = "Sektor podle ČSÚ") +
  theme_minimal() + 
  guides(color = guide_legend(position = "bottom",
                              direction = "horizontal")) +
  theme(legend.position = c(0.795, 0.175),
        legend.direction = "vertical",
        axis.title = element_blank())

Z grafu je patrné, že změna trendu měla na ajťáky a učitelky opačný vliv:

ajťáci se dnes proti trendu z časů Andreje Babiše pohybují přibližně +15 tisíc Kč / měsíc
učitelky se dnes proti trendu z časů Andreje Babiše pohybují přibližně -20 tisíc Kč / měsíc

A protože jsme v Česku, kde se nehraje až tolik na to abych se měl absolutně dobře (co je absolutně dobře? jaká je jednotka dobrosti?) ale jestli se mám relativně líp jak soused, tak se podíváme na relativní poměr mezd ajťáků a učitelek:

rel_mzdy <- clean_mzdy %>% 
  # pivot z "dlouhého" formátu na "široký"
  pivot_wider(id_cols = datum, 
              names_from = odvetvi_kod, 
              values_from = hodnota) %>% 
  mutate(pomer = P / J) # podíl učitelek ku ajťákům

ggplot(data = rel_mzdy, aes(x = datum, y = pomer)) +
  annotate("rect",
           xmin = as.Date("2017-12-13"), # počátek první vlády AB
            xmax = as.Date("2021-12-17"), # konec druhé vlády AB
            ymin = 0,
            ymax = Inf,
            fill = "#5c9234",
            alpha = 1/5) +
    annotate("rect",
           xmin = as.Date("2021-12-17"), # jmenování PF premiérem
            xmax = max(clean_mzdy$datum), # konec datová řady
            ymin = 0,
            ymax = Inf,
            fill = "darkorchid",
            alpha = 1/5) +
  geom_smooth(se = F, color = "red", alpha = 2/3) + 
  geom_point(pch = 4, size = 3/4, color = "gray25") +
  geom_point(data = rel_mzdy[c(which.max(rel_mzdy$pomer),
                               which.min(rel_mzdy$pomer)),],
             color = "red") +
  geom_text(data = rel_mzdy[which.max(rel_mzdy$pomer),],
            aes(x = datum, y = pomer,
                label = paste0(round(100 * pomer, 2), "%")),
            nudge_y = .04) +
  geom_text(data = rel_mzdy[which.min(rel_mzdy$pomer),],
            aes(x = datum, y = pomer,
                label = paste0(round(100 * pomer, 2), "%")),
            nudge_y = -.04) +
  scale_y_continuous(limits = c(0, NA), 
                     labels = scales::percent) +  
  scale_x_date(breaks = seq(as.Date("2015-01-01"),
                            as.Date("2025-01-01"),
                            by = "2 years"),
               date_minor_breaks = "1 year",
               date_labels = "%Y") +
  theme_minimal() + 
  theme(axis.title = element_blank()) +
   labs(title = "Relativní srovnání mezd sektorů Vzdělávání a ICT",
        subtitle = "v érách premiérů Babiše a Fialy ")

Graf je zrnitý (pamatujete, že učitelky mívají bonusy v jiném kvartálu než ajťáci?) ale dá se technikami erka vyhladit. A dvě informace z něj vyskakují zřetelně:

historicky nejvyšší poměr mezd průměrné učitelky k průměrnému ajťákovi byl 2021-Q4 (tedy poslední kvartál éry Andreje Babiše)
historicky nejmenší poměr mezd průměrné učitelky k průměrnému ajťákovi byl 2025-Q1 (tedy právě teď)

Díky matematickému modelování a technikám statistického programovacího jazyka R tak vidím, že změna poměrů z časů vlády Andreje Babiše k Petru Fialovi měla – alespoň co se mzdovéhovo vývoje týče – kromě vítězů také poražené. Učitelky, které se ptají “kde je moje dvacka?!” přitom lidsky chápu; stejně tak jako ajťáky kteří mlčí a šoupou nohama, že oni nic – to trh.

Síťové mapy v R

Fri, 15 Dec 2023 00:00:00 +0000

Když jsem před časem ― ve verzi 1.4.2 z léta 2019 ― zaváděl do balíčku {RCzechia} objekt KFME síťových polí, cílil jsem především na pokročilé uživatele statistického programovacího jazyka R. Síťová pole jsem osobně potřeboval pro relativně sofistikovaný problém ekologického modelování, a podle sebe jsem soudil ostatní.

Až s odstupem času jsem zjistil, že tento způsob využití nejen že není jediný možný, ale dokonce ani není převažující. Dobrým příkladem jsou uživatelé z oblasti faunistiky a floristiky. Velmi často se jedná o uživatele, pro které statistika a GIS nástroje představují spíše nutné zlo; jejich skutečná práce je o něčem jiném. Síťové mapy ale potřebují.

Rád bych nabídl i cílové skupině neprofesionálních programátorů kód, který z tabulky souřadnic míst nálezů ― kterou lze snadno a rychle vytvořit někde bokem, třeba v Excelu ― vykreslí v erku publikačně použitelnou síťovou mapu.

A to způsobem, který je využitelný metodou copy / paste, pouze se vcelku snadno splnitelnou podmínkou nainstalovaného erka (které je FOSS) a funkčního přístupu k internetu. Kromě nich je třeba už jen soubor (csvčko se sloupci lon a lat) s nálezy v souřadnicích GPS a níže uvedený kus kódu.

Pro ilustraci jsem zvolil z nálezové databáze AOPK záznamy o nálezech rosnatky okrouhlolisté (Drosera rotundifolia). Rosnatka je známá a populární rostlina; v našich podmínkách nezaměnitelná. V nálezové databázi je evidováno přes šest tisíc nálezů, takže je dobře zdokumentovaná. Je tedy dobrým kandidátem pro ilustraci technik mapování.

Prvním příkladem je mapa v kontextu původní metodiky KFME: “hrubá” síťová pole o velikosti 10 × 6 úhlových minut (což v našich zeměpisných šířkách představuje lichoběžníky blízké čtvercům). Jednotlivým polím pak jsou přiřazeny čtyřciferné kódy.

Pro snazší orientaci je mapa doplněna o hranice České republiky a vybrané říční toky.

library(dplyr)    # obecná manipulace s daty
library(ggplot2)  # kreslení grafů
library(RCzechia) # prostorová data ČR

# načíst csv v definované struktuře - místo "mé" rosnatky použijte soubor vlastní! :)
# + transformovat z obyčejného na prostorový data frame
data <- read.csv("https://www.jla-data.net/sample/Drosera_rotundifolia.csv") %>% 
  st_as_sf(coords = c("lon", "lat"), crs = 4326)

# hranice Česka pro kontext
hranice <- republika(resolution = "low")

# pár hlavních řek pro kontext
reky <- reky(resolution = "low") %>% 
  filter(Major)

# mapová síť - hrubý podklad pro obrázek i značky
hruby_podklad <- KFME_grid(resolution = "low")

# středobody síťových polí - na nich budou značky
stredy_site <- st_centroid(hruby_podklad)

# čtverce s nálezem jako vektor - výčet
nalezy <- data %>% 
  st_join(hruby_podklad, left = F) %>%
  pull(ctverec) %>% 
  unique()

# vlastní kreslení obrázku
ggplot() +
  geom_sf(data = hranice, color = "gray25", fill = NA, lwd = 1) +
  geom_sf(data = reky, color = "navyblue") +
  geom_sf(data = hruby_podklad, color = "gray60", fill = NA, alpha = 1/4) +
  geom_sf(data = subset(stredy_site, ctverec %in% nalezy), 
          shape = 19,  
          color = "firebrick", 
          size = 3) +
  theme_minimal() +
  # popisky os jako čísla čtverců; kvůli čitelnosti skoky po dvou čtvercích 
  # ve vyšším rozlišení může stačit po jednom - pak třeba upravit labels i breaks
  scale_y_continuous(labels = as.character(seq(from = 74, to = 49, by = -2)),
                     breaks = seq(from = 48.5 + 1/20, 
                                  to = 48.5 + 1/20 + 25/10, 
                                  by = 2 * 1/10)) +
  scale_x_continuous(labels = as.character(seq(from = 38, to = 79, by = 2)),
                     breaks = seq(from = 12 + 1/12, 
                                  to = 12 + 1/12 + 41/6, 
                                  by = 2 * 1/6)) +
  # těsnější než defaultní nastavení okrajů mapy a popisků os 
  # může vyžadovat ladění v závislosti na rozlišení výstupu...
  theme(panel.grid.major = element_line(colour = "transparent"),
        axis.text.y = element_text(margin = margin(r = -18)),
        axis.text.x = element_text(margin = margin(t = -8)),
        plot.margin = margin(r = -20))

Druhým příkladem pak je mapa v kontextu modifikované metodiky KFME: “jemná” síťová pole, vzniklá rozdělením “hrubých” polí na 4 podčtverce označené písmenem.

Protože takto jemné členění by bylo příliš detailní pro použití na republiku jako celek, tak ponechávám na mapě původní “hrubou” síť, včetně názvů čtverců. Jemnější síť slouží jen pro označení místa nálezů.

library(dplyr)    # obecná manipulace s daty
library(ggplot2)  # kreslení grafů
library(RCzechia) # prostorová data ČR

# načíst csv v definované struktuře - místo "mé" rosnatky použijte soubor vlastní! :)
# + transformovat z obyčejného na prostorový data frame
data <- read.csv("https://www.jla-data.net/sample/Drosera_rotundifolia.csv") %>% 
  st_as_sf(coords = c("lon", "lat"), crs = 4326)

# hranice Česka pro kontext
hranice <- republika(resolution = "low")

# pár hlavních řek pro kontext
reky <- reky(resolution = "low") %>% 
  filter(Major)

# mapová síť - hrubý podklad pro obrázek, jemný pro značky na místech nálezů
hruby_podklad <- KFME_grid(resolution = "low")
jemny_podklad <- KFME_grid(resolution = "high")

# středobody síťových polí - na nich budou značky
stredy_site <- st_centroid(jemny_podklad)

# čtverce s nálezem jako vektor - výčet
nalezy <- data %>% 
  st_join(jemny_podklad, left = F) %>%
  pull(ctverec) %>% 
  unique()

# vlastní kreslení obrázku
ggplot() +
  geom_sf(data = hranice, color = "gray25", fill = NA, lwd = 1) +
  geom_sf(data = reky, color = "navyblue") +
  geom_sf(data = hruby_podklad, color = "gray60", fill = NA, alpha = 1/4) +
  geom_sf(data = subset(stredy_site, ctverec %in% nalezy), 
          shape = 19,  
          color = "firebrick", 
          size = 1.25) +
  theme_minimal() +
  # popisky os jako čísla čtverců; kvůli čitelnosti skoky po dvou čtvercích 
  # ve vyšším rozlišení může stačit po jednom - pak třeba upravit labels i breaks
  scale_y_continuous(labels = as.character(seq(from = 74, to = 49, by = -2)),
                     breaks = seq(from = 48.5 + 1/20, 
                                  to = 48.5 + 1/20 + 25/10, 
                                  by = 2 * 1/10)) +
  scale_x_continuous(labels = as.character(seq(from = 38, to = 79, by = 2)),
                     breaks = seq(from = 12 + 1/12, 
                                  to = 12 + 1/12 + 41/6, 
                                  by = 2 * 1/6)) +
  # těsnější než defaultní nastavení okrajů mapy a popisků os 
  # může vyžadovat ladění v závislosti na rozlišení výstupu...
  theme(panel.grid.major = element_line(colour = "transparent"),
        axis.text.y = element_text(margin = margin(r = -18)),
        axis.text.x = element_text(margin = margin(t = -8)),
        plot.margin = margin(r = -20))

Věřím, že vám tento příklad pomůže s vlastními mapami. A pokud shledáte můj kód užitečným pro vaši publikační činnost, zvažte v metodice citaci balíčku RCzechia, ideálně přes článek z JOSS https://joss.theoj.org/papers/10.21105/joss.05082.

Rayshader a volby 2023

Mon, 16 Jan 2023 00:00:00 +0000

Rozšiřující balíček {rayshader} je zajímavá aplikace 3D vizualizace v kontextu erka. V sítích internetu v nedávné době připravil (mini) senzaci terrence fosstodon se svojí sérií vizualizací populační hustoty různých zemí.

Vypadá to pěkně, a dá se to zreprodukovat – například takto vypadá populace Česka vynesená do výšky:

Přišlo mi zajímavé stejnou techniku využít pro vizualizaci volebních výsledků. Mapiček s podporou hlavních kandidátů je k dispozici řada. Což je správně; kreslit mapy je důležité a společensky přínosné. Už dlouho si myslím, že v této zemi se málo … kreslí mapy.

Jako svůj příspěvek ke kreslení map proto nabízím lehce alternativní pohled na podporu tří hlavních kandidátů v prvním kole.

Vizualizace je zajímavá tím, že ukazuje absolutní hodnotu obdržených hlasů: takže i Andrej Babiš se svým malým podílem z velkého čísla má v mapě dobře rozpoznatelné Prahu a Brno.

Zdrojový kód pro tvorbu vizuálů + obrázky ve vyšším rozlišení jsou pro případné zájemce k dispozici na GitHubu jako jlacko/3d-cesko.

Reliéf Česka

Sun, 27 Nov 2022 00:00:00 +0000

Vizualizace výškopisu, neboli terénního reliéfu, je jedním z častých případů využití erkové package {RCzechia}. Zejména v přírodních vědách se ukazuje potřeba od sebe odlišit horské a nížinné oblasti (zatímco administrativní jednotky, coby lidský konstrukt, jsou spíše méně relevantní).

Balíček {RCzechia} podporuje dvě formy výškopisu:

stínovanou - rastr ilustrující členitost terénu; typicky se zobrazuje v odstínech šedé
skutečnou - rastr, jehož hodnoty ukazují skutečnou nadmořskou výšku; typicky se zobrazuje v konvenci hypsometrických barev (nížiny zeleně, vrchoviny hnědě, a velehory bíle)

Pro obě formy výškopisu má dva rastery:

ostře oříznutý na hranice Česka
neoříznutý, se zachovaným výškopisem sousedů; zasahuje 25 kilometrů navíc od nejzazších bodů Česka. Rozsah je přibližně od pramenů Ohře k Malé Fatře.

Základní formou vizualizace je base plot. Nedává úplně publikační kvalitu, ale je super pro rychlý náhled. Sestavit ho zabere pár řádků kódu. Zde stínovaný výškopis v neoříznuté formě.

library(RCzechia)
library(terra)

# stínovaný výškopis jako lokální objekt
stiny <- RCzechia::vyskopis(format = "rayshaded", cropped = FALSE)

# plot výškopisu
plot(stiny, 
     col = gray.colors(15), # 50 odstínů šedi...
     legend = FALSE) # vysvětlení intenzity šedé nepředstavuje přidanou hodnotu

# plot hranic
plot(RCzechia::republika("low"), # zjednodušený obrys republiky
     border = "red", # hranice červeně
     col = NA, # bez výplně
     add = TRUE) # vykreslit přes přeschozí plot / prostý výškopis

Pro sofistikovanější použití se hodí vybrat z výškopisu Česka pouze relevantní část. Pro přesné vymezení oblasti zájmu doporučuji praktický nástroj bboxfinder. Jako příklad oblasti zájmu jsem vybral pohoří Východní Sudety, ale jiná by posloužila stejně dobře.

Pouze – vzhledem k rozlišení podkladového rasteru, který má pro řízení objemu stahovaných dat pixely o velikosti přibližně 100×100 metrů – doporučím oblasti zájmu o velikosti desítek kilometrů a větší. Pro menší to bude technicky fungovat stejně, ale obrázek bude “zrnitý”.

Prvním krokem je náhled na oblast zájmu technikou leaflet.js / vypadá dobře…

library(dplyr)
library(RCzechia)
library(leaflet)

# definování oblasti zájmu jako sf geometrie
area_of_interest <- c(xmin = 16.590729, ymin = 49.900827,
                      xmax = 17.536926, ymax = 50.515173) %>% 
  st_bbox(crs = st_crs(4326)) %>% 
  st_as_sfc()

# vizuální kontrola
leaflet(data = area_of_interest) %>% 
  addProviderTiles("CartoDB.Positron") %>% 
  addPolygons()

Druhým krokem je vlastní zakreslení výškopisu technikami {ggplot2}, který (na rozdíl od base plotu) dovedu s čistým svědomím doporučit pro použití v publikacích.

Pro oživení mapy doplňuji tři barevné vrcholky; povšimněte si techniky setřídění faktoru podle nadmořské výšky. Ta rozhodne o pořadí vrcholků v legendě grafu (jinak by to bylo abecedně; a Keprník před Pradědem nechceme).

Protože základní verze ggplotu není velký kamarád s prostorovými rastery tak využívám k zobrazení tidyterra::geom_spatraster() z balíčku {tidyterra}. A dále postupuji standardními technikami ggplotu, jako jsou nastavení barev, legend, titulků a popisků grafu.

library(terra)
library(ggplot2)
library(tidyterra) # ggplot2 v základní verzi rastery moc nemusí, proto doplněk
library(sf)

# reliéf Česka včetně okolí...
relief <- RCzechia::vyskopis(format = "actual", 
                             cropped = FALSE) %>% 
  # ... oříznutý na oblast zájmu
  crop(area_of_interest, mask = TRUE)

# nělikol vrcholů pro oživení obrázku
vrcholy <- data.frame(lat = c(50.0830, 50.2075, 50.1709),
                      long = c(17.2309, 16.8476, 17.1164),
                      nazev = c("Praděd", "Sněžník", "Keprník"),
                      vyska = c(1491, 1424, 1423)) %>% 
  st_as_sf(coords = c("long", "lat"), crs = 4326) %>% 
  mutate(nazev = forcats::fct_reorder(nazev, vyska, .desc = TRUE))

# obrázek technikami ggplotu - barevná škála podle nadmořské výšky
ggplot() +
  tidyterra::geom_spatraster(data = relief) +
  geom_sf(data = vrcholy, 
          aes(color = nazev), 
          pch = 4, 
          stroke = 2,
          alpha = 4/5) +
  scale_color_manual(values = c("Praděd" = "firebrick4",
                                "Sněžník" = "navyblue",
                                "Keprník" = "dodgerblue3")) +
  scale_fill_gradientn(colors = hypso.colors(10),
                       labels = scales::label_number(suffix = " m"),
                       limits = c(150, 1550),
                       na.value = NA) +
  labs(title = "Východní Sudety - země neznámá...",
       fill = "Nadmořská\nvýška",
       color = "Významné\nvrcholy") +
  theme_bw() +
  theme(legend.text.align = 1,
        legend.title.align = 0.5)

Věřím, že jsem na jednoduchém příkladě ukázal možnosti využití balíčku {RCzechia} jako zdroje podkladových dat pro výškopis Česka, a dále pak modelové příklady využití stínovaných a skutečných hodnot.

A to jak technikami base plotu, tak balíčku {ggplot2} coby nejpoužívanějšího “dospělého” grafického nástroje ve světě erka. QED.

Kde se v Čechách nejvíc krade?

Fri, 10 Jun 2022 00:00:00 +0000

Česká policie nedávno zveřejnila formou otevřených dat Mapu kriminality. Podstatné přitom je, že neuvolnila toliko mapovou aplikaci, ale současně také podkladová data ve strojově čitelném formátu. To dává příležitost k vlastnímu zpracování výstupů, například s využitím technik statistického programovacího jazyka R. Což jsem učinil.

Zaměřil jsem se přitom na hledání odpovědi na otázku “kde se v Čechách nejvíce krade?”.

Databáze z mapy kriminality má historii deset let, ale já se zaměřil na poslední tři roky (od prvního května 2019 do posledního května 2022). Za tu dobu se událo 89 800 krádeží.

Rozpadnu-li si území Česka do šestiúhelníků o ploše 125 kilometrů čtverečných (kterých je 720) a vynesu-li do takto získané mapy součty krádeží, tak dostanu takovouto mapku:

Vidím, že se krade nejvíce v Praze. A to dokonce tak, že abych dosáhl v mapce nějakého odlišení v barevné škále, tak jsem musel trochu podvádět – a na hodnoty uplatnit logaritmickou transformaci. Jinak bych měl temně červenou Prahu v nudně zeleném moři zbytku světa.

Jsou však krádeže výhradně problémem pro Pražáky? Zaměřím-li se na specifický typ kradení, kterým je pytláctví a polní pych, dostanu mapku významně odlišnou.

V první řadě mě nepřekvapí, že pytláctví jako formy krádeže je výrazně méně, nežli krádeží celkem. Za sledované tři roky eviduje PČR pouze 101 případů pytláctví a polního pychu.

Současně vidím, že když už se pytlačí, tak se tak děje především v Křivoklátských hvozdech. Což je zajímavé v kontextu zvažovaného národního parku…

Absolutně čísla jsou zajímavá, ale co mi to říkají o šanci, že budu obětí krádeže zrovna já? V Praze se nejenom hodně krade, ale také zde bydlí mnoho lidí. Je pro mě tedy zajímavé relativní hodnota – počet krádeží vztažený k počtu obyvatel.

Ten díky erkovému balíčku {czso} snadno získám přímo z pohodlí své R session (zvažuji přitom počet obyvatel v obci ze sčítání lidu v roce 2010).

Vidím, že Praha na tom je na tom nejhůře nejen absolutně, ale i relativně k počtu obyvatel. Dokonce takovým způsobem, že abych získal nějaký odstup v barevné škále, tak si opět musím vypomoci logaritmickou transformací. Díky ní se mi barvy rozvrství tak, že kromě problematické Prahy vyplavou na povrch i ostatní krajská města a drsný Sever.

Ale jaká by mohla být moje úvaha o kriminalitě z pohledu zločince? Z pohledu zločince mě zajímá především riziko dopadení – respektive naděje na nedopadení, čiliže šance uniknutí trestu. I ta se dá vynést do mapy (jako podíl případů ve stavu neobjasněno z krádeží jako celku).

Vidím, že z pohledu zločince je pro mne opět zajímavé krást v Praze. Sice je tam konkurence, ale riziko odhalení je vcelku přijatelné. Naopak se jako zločinec budu vyhybat oblastem Sudet.

Pozornost opět poutá oblast drsného Severu, kde se sice relativně vzato krade první liga, ale objasněnost krádeží je v kontextu republiky jako celku vysoká.