politika 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.

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.

Dva Tomiové s odstupem času

Sat, 12 Jan 2019 00:00:00 +0000

Když jsem začal projekt o twitterové komunikaci pravého a falešného Tomia Okamury, tak jsem zpracoval jejich timeliny od “počátku světa” do 7. prosince 2018.

Na těchto datech jsem vytvořil tři klasifikační modely, které různými technikami předvídaly “pravost” autora tweetu:

rozhodovací strom nad tweetovými metadaty (rpart)
jednoduchou neuronku nad stejnými metadaty (keras, respektive TensorFlow)
sofistikovanější neuronku (bidirectional LSTM) nad slovy tweetů (opět keras a TensorFlow)

Zatímco jsem psal své klasifikační modely, tak Tomiové nezaháleli, a produkovali nová data. Od 7. prosince ke dnešnímu dni vydali 106 nových tweetů, z toho 51 od pravého a 55 od falešného Okamury. Což je vcelku vyvážené rozdělení, a v souladu s mým pozorováním, že fejkový Tomio je o něco ukecanější, nežli ten pravý.

Přišlo mi zajímavé použít nově vzniklé tweety jako verifikaci svých modelů, toto je můj výsledek:

Testovací vzorek nebyl velký, ale i přes to dosahly všechny tři klasifikační modely přesnost přes 95%. Což není špatné…

Všechny tři výsledky jsou vcelku srovnatelné, a tak jsem se rozhodl za vítěze požadovat strom podle rpart. Protože jeho fungování dokážu ze všech tří metod nejsnáze vysvětlit.

Závěry, který si z projektu odnáším jsou že:

klasifikace textu je zábavná, a jde dělat přesně
Tomio Okamura je konzistentní a dobře předvídatelný
i s malým Kašpárkem jde sehrát velké divadlo - respektive i jednoduchá technika se při dobré přípravě může výsledkem měřit s moderními AI krabičkami

Podkladové skripty jsou k dispozici na GitHubu: https://github.com/jlacko/dos-tomios.

Dva Tomiové na jednom Twitteru

Fri, 07 Dec 2018 00:00:00 +0000

Na českém Twitteru vystupují dva Tomiové Okamurové - jeden pravý, druhý falešný. Pro nás, lidi, nadané přirozenou inteligencí, není těžké už z profilovky na první dobrou poznat, který z nich k nám z jakého účtu promlouvá.

Přišlo mi ale zajímavé prozkoumat timeliny účtů @tomio_cz a @Tomio_Okamura strojově, technikami umělé inteligence.

A tedy změřit a spočítat jak oba Tomiové pracují s jazykem, a navrhnout takový klasifikační algoritmus, který by jejich tweety rozdělil na hejty xenofobního politika a hlášky internetového vtipálka.

Veškerou práci jsem provedl v erku - stažení dat přes knihovnu rtweet, textové zpracování přes knihovnu udpipe, a zpracování rozhodovacího stromu přes knihovnu rpart.

Prvotní stažení dat bylo jednoduché; obě timeliny mají dohromady přibližně 5 000 tweetů. Po rozbití na slova to dělá kolem 78 tisíc slov, to je rozsah zhruba čtyř diplomek (na VŠE klidně pěti). To už nějaká data jsou, ale stále dost málo na to aby se mi zafuněl notebook.

Dalším krokem bylo posoudit volbu slov oběma účty; protože se liší celkové počty tweetů (falešný Tomio je o něco ukecanější) nebylo praktické srovnávat absolutní hodnoty, a soustředil jsem se proto na srovnání relativních četností - zmínek slova na 1 000 tweetů.

Červená čára dělí čtverec četností na polovinu - napravo a dolů je více zmínek od pravého Tomia, nalevo a nahoru od falešného.

Postupně jsem zhodnotil hlavní slovní druhy:

vlastní jména
podstatná jména
přídavná jména
slovesa
příslovce

Je vidět, že pravý Tomio mluví hodně (hodně hodně!) o sobě a o SPD. Falešný Tomio mluví častěji než pravý o Ovčáčkovi, Zemanovi a Babišovi (a o Žížalovi, který mi mezi ty tři moc nezapadá).

Z podstatných jmen mluví pravý Tomio hodně o člověku (o lidech), o vládě a o migrantech (které falešný Tomio ignoruje). Strana, volba a rok jsou důleživé pro oba Tomie srovnatelně, falešný se zajímá více o pana prezidenta.

Z přídavných jmen je rozdíl v použití slov český, další a islámský; mimochodem - věděli jste, že pravý Tomio používá 4,26x častěji slovo islámský, nežli slovo dobrý?

Na zájménech je nejzajímavější, že je pravý Tomio prakticky nepoužívá. Občas zmíní zvratné se, občas poukáže sám na sebe slovem já, ale ve srovnání s falešným Tomiem je to o ničem.

U sloves jsem musel, kvůli čitelnosti os, vypustit nejčastější být. I pro něj ale platí, že se slovesy je to jako se zájmeny - pravému Tomiovi prakticky vypadly, zatímco falešný Tomio s nimi pracuje.

U příslovcí se příběh opakuje. S výjimkou jediného - úderného, naléhavost budícího dnes - jsou výsadou falešného Tomia.

Toto vše si vykládám tím, že pravý Tomio se nepotřebuje vyjadřovat ve skutečných větách. Jako populistický předák si vystačí s hesly. Na co podnět, k čemu přísudek - když soukmenovci trpí?

Falešný Tomio, který si z Tomia skutečného dělá legraci, nejspíše cítí potřebu se vyjadřovat jako člověk, a místo newspeaku používá češtinu.

Dalším krokem byla příprava dat pro klasifikaci. Na základě zjištění z analýzy jsem provedl lehký feature engineering - zaměříl jsem se na hlavní rozdíly, tedy odkazy na Youtube, sebepropagaci, použití sloves, zájmen a příslovcí a na sdílení cizích tweetů (retweety).

Výstupem z klasifikace je vcelku jednoduchý rozhodovací strom:

Strom má sedm úrovní, a dosahuje přesnosti klasifikace lehce přes 90%. Což je docela pěkné číslo.

S trochou nadsázky lze pravidla stromu ještě více zobecnit:

příspěvek, který odkazuje na YouTube, je od pravého Tomia
příspěvek, který zmiňuje SPD a není retweetem, je od pravého Tomia
příspěvek o dvou a více větách je od falešného Tomia
retweet je od falešného Tomia
příspěvek, ze kterého vypadly zájména a příslovce, a který obsahuje maximálně dvě slovesa, je od pravého Tomia

Při stejném vstupním souboru s 30 proměnnými, ale se sofistikovanějším klasifikačním nástrojem - knihovnou Keras, respektive jejím backendem TensorFlow - se dostanu na úspěšnost kolem 92%. Pravda, hůře interpretovatelnou nežli jednoduchý rpartový strom.

Věřím tedy, že při větším počtu proměnných a se složitějším feature engineeringem bych se dostal na úspěšnost kolem 95%, kterou mám za horní mez takhle “malého” souboru dat.

Zdrojový kód podkládající moji analýzu přesahuje rozsah blogového příspěvku, ale je volně k dispozici na GitHubovém repozitáři jlacko/dos-tomios.

Jak mluvíme o Andrejovi Babišovi?

Sat, 24 Nov 2018 00:00:00 +0000

Když jsem před necelým rokem rozjel projekt Babišobot, tak jsem si za hlavní cíl položil pravidelné shrutí témat, která na twitteru spojujeme s osobou Andreje Babiše - s 371 tisíci fanoušky s přehledem nejsledovanějšího politika naší země.

Jako vedlejší cíl jsem si dal za úkol všechny zpracované tweety pro strýčka Příhodu uložit; data jsou cenná. Osoba premiéra budí silné spojení, a tak se mi těch tweetů sešlo dost (260 828, abych byl přesný). Rád bych se touto cestou podělil o několik poznatků, které jsem z dat vyčetl.

Pro úvod jsem se soustředil ne na plný dataset - co si myslí český Twitter jako celek - ale na jeho vzorek. Vybral jsem si podmnožinu největších influencerů. Ty jsem vydefinoval jako účty, které na tweetech o Andreji Babišovi za sledované období nasbíraly více, než 10 000 lajků.

Tímto omezením jsem získal vzorek 19 účtů, které dohromady publikovaly 4 754 tweetů, skládající se z 151 233 slov (což je 605 normostran - asi tak 8 diplomek). Zmíněné tweety posbíraly celkem 410 329 lajků.

Účty jsem přes palec rozdělil do tří kategorií:

politiky, typový případ @kalousekm - Miroslav Kalousek
vtipálky, typový případ @Posledniskaut - Poslední skaut™
novináře, typový případ @JaroslavKmenta - Jaroslav Kmenta

S tím, že bude zajímavé sledovat, jak se jednotlivé skupiny mezi sebou liší volbou témat a používáním jazyka.

Tyto tři skupiny netweetují stejně často, a tak nebylo praktické srovnávat absolutní počty slov. Srovnávám proto počty relativní - počet použití slova na 1 000 tweetů.

Vlastní jména spojená s osobou Andreje Babiše:

Není překvapivé, že nejčastěji je ve spojení s objektem zájmu zmiňováno jeho jméno; zajímavější je rozdíl v používání twitterového handlu - výrazně častěji s ním pracují twitteroví domorodci vtipálci, nežli novináři či politici.

V používání křestního jména jsou politici za průměrem - pan premiér pro ně není Andrejem Babišem, ale pouze Babišem. Což něco říká o jejich respektu a tom, že pan premiér nemá na twitteru mnoho politických přátel (respektive že političtí přátelé pana premiéra nesbírají tisíce lajků).

Dále je zajímavé, jak málo se politici v souvislosti s Andrejem Babišem vyjadřují k Seznamu (a jeho rozhovoru) a Praze (a komunálním volbám v ní); tyto témata přenechávají novinářům a vtipálkům.

Naopak násobně častěji než novináři či vtipálci se politici v souvislosti s Andrejem Babišem zmiňují o ODS (což je v řadě případů sebepropagace).

Postatná jména spojená s osobou Andreje Babiše:

Z podstatných jmen máme Andreje Babiše nejčastěji spojeného s vládou. Toto spojení je silné zejména pro politiky, pro novináře je Andrej Babiš především premiérem.

Pro vtipálky je časté, že Andrej Babiš je panem a předsedou - zpravidla současně, a zpravidla to není chápáno jako neutrální spojení (což je hezká ilustrace toho, proč se nehrnu do analýzy sentimentu v jazyce tak bohatém na ironii jako ten náš).

Je zajímavé, jak pro politiky nejsou (ve srovnání s novináři a vtipálky) tématem podstatná jména s vazbou na aktuální události - jako rozhovor, syn nebo kauza - ale vymezují se spíše k obecnějším tématům jako jsou ministr, komunista, strana či sama politika.

Vykládám si to tak, že politici nový pohled na osobu a činy Andreje Babiše nehledají, protože svůj názor již dobře znají. K aktuálním událostem se vyjadřují především proto, aby zopakovali co věděli do začátku - jako kdyby novodobý Cato tweetoval Ceterum autem censeo, Babišem esse delendam…

Slovesa - kromě být a mít - spojená s osobou Andreje Babiše:

Ze sloves jsem pro lepší čitelnost grafů musel vyloučit “být” a “mít” - protože fakt, že Andrej Babiš je či byl toto či ono, případně že má či by měl udělat toto či ono, se opakují tak často, že ostatním slovesům ničí osy.

Ze sloves, co mi zbyla, je nejčastější moci - zejména díky názoru politiků. Pro jejich tweety je typické, že Andrej Babiš něco může, případně musí.

Naopak novináři či vtipálci se spíše než o to co Andrej Babiš může či musí zajímají o to, co Andrej Babíš říká, respektive o to co dělá.

Přídavná jména spojená s osobou Andreje Babiše:

Z přídavných jmen vede český, jako v český premiér, následovaný přídavným jménem přivlastňovacím Babišův.

Podobně jako u podstatných jmen platí, že u politiků je slabší zapojení aktuálních témat - mladý jako v mladý Babiš - a silnější pro obecné, útočné spojení - stíhaný jako ve trestně stíhaný premiér či vlastní jako ve vlastní prospěch.

Velký rozdíl je na slově politický - ten je pro politiky klíčový, naopak vtipálci jej používají málo - jejich cíl cílem je žert a ironie, ne politika.

Interpunkční znaménka spojená s osobou Andreje Babiše:

A konečně interpunkční znaméneka nám dávají lépe poznat charakter komunikace; politici mají významně vyšší frekvenci teček a čárek. Protože dělají krátké věty. Nepředkládají rozbor. Ani analýzu. Sdělují hesla, volají po akci.

Novináři a vtipálkové jsou ve srovnání s politiky vysloveně ukecaní.

Věřím, že jsem ukázal, že tweety o Andreji Babišovi jsou zajímavé, a že se z nich dá leccos vyčíst - nejen o panu předsedovi, ale také o autorech těchto tweetů.

Mým druhým krokem bude nad vytvořeným datasetem natrénovat model, které by účastníky internetové diskuze roztřídil do škatulek podle toho, zda se o Andrejovi Babišovi vyjadřují spíše jako politici, novináři nebo vtipálkové.

Už se vyloženě těším na to, co mi model řekne o prezidentovo mluvčím…

Kde uspořádat demonstraci?

Fri, 23 Mar 2018 00:00:00 +0000

Česká politika mě ne vždy baví jako občana a voliče, ale oceňuji na ní že generuje dobrá data.

Po inauguraci prezidenta republiky 8. března jsem se rozhodl se vrátit ještě jednou k volebním výsledkům a provézt si malé GISové cvičení - vypočíst si v Rku optimální lokalitu pro demonstraci na podporu prezidenta Zemana.

Hledání místa pro demonstraci přes Rkový kód je samozřejmě hloupost (taky kdo by Milošovi za takovýto projev demonstroval podporu, že) ale je to zajímavá technika s přesahem do světa obchodu - například do marketingu při rozhodování o umístění poboček podle současných klientů / budoucího potenciálu.

Stanovil jsem si tyto omezení:

uvažuji všechny voliče Miloše Zemana z druhého kola po obcích a jejich částech
(jsou k dispozici na oficiálních výsledcích)
uvažuji, že voliči Miloše Zemana jsou, obdobně jako sám prezident, špatní na nohy a na místo srazu mohou dorazit pouze z omezené vzdálenosti
(bude zajímavé sledovat, jak různé hodnoty tohoto parametru ovlivní místo srazu)

Základem je příprava dat; zde jsem vycházel ze svého bezprostředně povolebního cvičení na vizualizaci výsledků.

Protože budu pracovat se vzálenostmi, převádím všechny objekty do souřadnicového systému inž. Křováka, který je v metrech (na rozdíl od defaultního WGS84 v úhlových mírách). Republika se pak tváří trošku nakřivo, ale stále je to ona.

library(sf)
library(tidyverse)
library(tmap)
library(RCzechia)

# načtení dat z jlacko/Zeman2018 na GitHubu
Zeman2018 <- url("https://raw.githubusercontent.com/jlacko/Zeman2018/master/src/prezident.csv")
src <- read.csv2(Zeman2018,
                 stringsAsFactors = F) 

# výsledky voleb
druheKolo <- src %>%
  filter(CHYBA == 0) %>% # bez chyb
  filter(KOLO == 2) %>% # pouze druhé kolo
  group_by(OBEC) %>%
  summarize(celkem = sum(PL_HL_CELK), # celkem platných hlasů
            zeman = sum(HLASY_07),  # kandidát č.7 = Miloš Zeman
            pct_zeman = sum(HLASY_07)/sum(PL_HL_CELK)) %>% # procento platných pro Zemana
  mutate(KOD = as.character(OBEC)) # kod obce v RCzechia je text :(

obce <- obce_polygony() %>% 
  select(KOD = KOD_OBEC,
         NAZEV = NAZ_OBEC,
         hranice = GeneralizovaneHranice)

casti <- casti() %>%
  select(KOD, NAZEV, hranice = OriginalniHranice)

podklad <- obce %>% # všechny obce...
  bind_rows(casti) %>% # ...plus všechny části
  inner_join(druheKolo, by = c("KOD" = "KOD")) %>%
    # z obcí a částí připojit ty s výsledkem
    # filtrační (inner) join odstraní obce bez výsledku (Praha etc. - má ho z částí)
  st_transform(crs = 5514)
    # systém inž. Křováka 

republika <- republika() %>%
  st_transform(crs = 5514)
    # systém inž. Křováka 

kraje <- kraje() %>%
  st_transform(crs = 5514)
    # systém inž. Křováka

Pro základní orientaci nám pomůže mapa relativního úspěchu Miloše Zemana, známá z povolebních analýz. Z mapy je vidět relativně slabší podpora prezidenta Zemana v Praze, a silná v oblasti Sudet.

mapRelative <- tm_shape(podklad) + tm_fill(col = "pct_zeman", title = "Zemanův zisk", n = 5) +
  tm_shape(kraje) + tm_borders("grey80") +
  tm_shape(republika) + tm_borders("grey35") +
  tm_style("white", "Relativní výsledky", frame = F, 
                 legend.format = list(text.separator =  "-",
                                      fun = function(x) paste0(formatC(x * 100, digits = 0, 
                                                                       format = "f"), " %")),
                 legend.text.size = 0.8, 
                 legend.title.size = 1.3) +
  tm_legend(position = c("RIGHT", "top"))

print(mapRelative)

Pro účely svolání demonstrace ale nejsou až tak důležitá relativní čísla, jako hodnoty absolutní - na demonstraci nepřijdou procenta, ale lidé.

Když se podíváme na absolutní podporu, tak to s tou Prahou není tak zlé (i malý podíl z velkého počtu voličů může v součtu znamenat hodně lidí - účasníků demonstrace).

mapAbsolute <- tm_shape(podklad) + tm_fill(col = "zeman", title = "Zemanův zisk", n = 5) +
  tm_shape(kraje) + tm_borders("grey80") +
  tm_shape(republika) + tm_borders("grey35") +
  tm_style("white", "Absolutní výsledky", frame = F, 
                 legend.format = list(text.separator =  "-",
                                      text.align = "center"),
                 legend.text.size = 0.8, 
                 legend.title.size = 1.3) +
  tm_legend(position = c("RIGHT", "top"))
    # tuto mapu po použití ještě několikrát zrecykluji...

print(mapAbsolute)

Pro zjednodušení další práce si polygony obcí a částí nahradím středy - o něco si usnadním jak výpočet, tak interpretaci (místo typu vzdálenosti polygon od polygonu budu počítat vzdálenost bod od bodu, a navíc mi odpadnou částečné průsečíky - bod v kružnici buď je, nebo není).

Dále si připravím funkci šelmostroj, která mi pro každý z těchto 6 387 bodů dopočte součet Zemanovo voličů v nejbližším okolí - s tím, že co přesně znamená “nejbližší”, bude určovat parametr vzdalenost.

Z dopočtených hodnot Zemanovo voličů v okolí obce šelmostroj dále vybere ten nejvyšší, a tuto obec určí jako optimální místo demonstrace.

Na mapě volebního výsledku Miloše Zemana v obci pak nejlepší místo pro demonstraci označí křížkem a nakreslí kolem něj spádový okruh odpovídající parametru vzdalenost. O tom všem pak podá přes writeLines() zprávu.

Díky tomu, že jsem dohledání místa pro demonstraci svěřil funkci, je pro mě snadné jí volat opakovaně, s pokaždé s rozdílnou hodnotou parametru vzdalenost.

podklad <- podklad %>%
  st_centroid()

## Warning in st_centroid.sf(.): st_centroid assumes attributes are constant over
## geometries of x

selmostroj <- function(vzdalenost) {
  podklad$suma_zemanovcu <- NA # uklidit
  st_agr(podklad) <- "constant" # vše jsou konstanty (tato část sf stejně nefunguje...)
  
  for (i in 1:nrow(podklad)) { # pro všechny řádky podkladu
    buff <- st_buffer(podklad[i,], dist = vzdalenost) 
      # buffer o průměru vzdalenost
    isect <- st_intersection(podklad, buff) 
      # průsečík bufferu a pracovního seznamu
    podklad$suma_zemanovcu[i] <- sum(isect$zeman) 
      # uložit součet Zemanovo hlasů v bufferu do podkladu
  }
  
 stred <- podklad[which.max(podklad$suma_zemanovcu), ]
    # tato obec je optimální!
  
  mapAbsolute <- mapAbsolute + # recyklace dříve vytvořené mapy
    tm_shape(stred) + tm_dots(size = 1/5, col = "red", shape = 4) +
    tm_shape(st_buffer(stred, dist = vzdalenost)) + tm_borders(col = "red")

    # využívám vlastnosti Rka, že si ve funkci z vnějšího okolí mohu "půjčit"
    # libovolný objekt, a změny na něm vykonané <- operátorem se nepropíší zpátky
    # (pokud nepoužiji <<- operátor)
  
  print(mapAbsolute)
    # zobrazení...
  
  writeLines(paste("Optimální místo demonstrace:", 
            stred$NAZEV, 
            "\nZemanovců v okolí", vzdalenost / 1000, "kilometrů:",
            formatC(stred$suma_zemanovcu, format = "f", big.mark = " ", digits = 0)))
}

První krok pro mě bude ověření nejlepšího místa pro demonstraci, pokud jsou voliči Miloše Zemana ochotni dorazit pouze z “maximální”" vzdálenosti dvou kilometrů:

selmostroj(2 * 1000) #2 kilometry

## Optimální místo demonstrace: Ostrava-Jih 
## Zemanovců v okolí 2 kilometrů: 32 103

Pokud by voliči Miloše Zemana byli skutečně takto málo mobilní, tak bude nejvhodnější uspořádat demonstraci v Ostravě.

Jako (relativně) malé město s vysokým podílem voličů Miloše Zemana na celkové populaci je Ostrava pro sraz prezidentových příznivců při malé dojezdové vzdálenosti ideální místo.

Druhý krok pro mě bude ověření nejlepšího místa pro demonstraci, pokud jsou voliči Miloše Zemana ochotni dorazit z o něco větší vzdálenosti 10 kilometrů:

selmostroj(10 * 1000) # 10 kilometrů

## Optimální místo demonstrace: Praha 2 
## Zemanovců v okolí 10 kilometrů: 183 125

Pokud by se voliči Miloše Zemana dokázali sjet ze vzdálenosti celých deseti kilometrů, tak se naplno prokáží výhody Prahy: efekt velkého města zvítězí nad procentuálně nízkou podporou. Pražští Zemanovci se mohou sjet třeba na Karlově náměstí.

A když spádovou oblast rozšířím ještě více, z 10 kilometrů na 30?

selmostroj(30 * 1000) # 30 kilometrů

## Optimální místo demonstrace: Praha-Troja 
## Zemanovců v okolí 30 kilometrů: 325 862

Při dojezdové vzdálenosti třicet kilometrů je stále nejvýhodnější místo pro demonstraci Praha. Příznivci Miloše Zemana z Prahy a okolí se mohou sjet třeba na Císařském ostrově - ten mají přes Suchdol v dojezdové vzdálenosti i Zemanovci z Kladna a okolí.

A když ani třicet kilometrů nestačí? Co když je Zemanovec ochoten sednout do auta, a překonat vzdálenost celých 50 kilometrů, jen aby podpořil svého vůdce?

selmostroj(50 * 1000) # 50 kilometrů

## Optimální místo demonstrace: Račiněves 
## Zemanovců v okolí 50 kilometrů: 543 378

Pokud by příznivci Miloše Zemana byli ochotni cestovat na místo srazu 50 kilometrů, tak bude nejlepší se sjet u Račiněvsi. Toto městěčko nedaleko od Litoměřic, kousek od ústecké Dé osmičky, je dobře přístupné pro Zemanovce z Prahy i ze Severu.

A pokud bych hodil všechny zábrany za hlavu, a nechal se sjet všechny Milošovo Zemanovo voliče ze vzdálenosti 150 kilometrů?

selmostroj(150 * 1000) # 150 kilometrů

## Optimální místo demonstrace: Němčice 
## Zemanovců v okolí 150 kilometrů: 2 035 075

Pokud bych opravdu chtěl dostat na jedno místo všechny Zemanovce zblízka i zdáli, tak dám sraz v Němčicích u Litomyšle, vzdušnou čarou na půl cesty mezi Prahou a Ostravou.
Tato malá obec o 996 obyvatelích představuje skutečný pupek zemanovského světa.

Kdepak je Krakonošovo?

Tue, 30 Jan 2018 00:00:00 +0000

Výsledy prezidentské volby o uplynulém víkendu jsem nebyl zcela nadšen. Abych svoju morální kocovinu vyléčil, rozhodl jsem se prozkoumat a ukázat kraj, který dává hlas politikovi, jehož paní Hašková - Coolidge nepovažuje za sprosťáka.

U nás na Praze 7 je kavárenská kultura dobře usazena, Miloš zde posbíral s bídou 24% hlasů a vítězství profesora Drahoše se pohledem z okna zdálo být nepochybné.

Vydal jsem se ho proto hledat Zemanovce s pomocí erka, Leafletu, tmapu a nejjemnějšího výsledku voleb ze statistického úřadu.

Výsledkem je interaktivní mapa ukazující hustotu výskytu Zemanovců v Čechách a na Moravě, kterou vám tímto předkládám :)

Prázdná místa na mapě jsou vojenské újezdy (kde se nevolí) a drobné nepřesnosti dané tím, že potřebuji stahnout velikost stránek na průchozí velikost.

Zdrojový kód mé vizualizace je k dispozici na GitHubu jlacko/Zeman2018.

Kdo volí jaké strany?

Sat, 04 Nov 2017 00:00:00 +0000

Před časem jsem si udělal malý statistický průzkum na to, jak vypadají voliči Tomia Okamury. V něm jsem srovnával korelaci volebního výsledku strany SPD v okresu s celkem 20 statistickými veličinami, a hledal tu nejsilnější.

Na svůj článek jsem dostal vcelku pozitivní ohlas, a tak jsem se rozhodl zpracovaná data ještě jednou oprášit a hotnoty korelace propočítat na všechny parlamentní strany.

Využil jsem přitom toho, že Rko je skriptovací jazyk, a získat devět obdobných výsledků neznamená udělat stejnou práci devětkrát, ale “jenom” napsat jeden for cyklus, což je kódu na pár řádek (říkal jsem, že miluji Rko? :)

Připomenu své zpracované veličiny:

počet cizinců, vztažený k počtu obyvatel.
počet cizinců, kromě Slováků (kteří u nás nejsou tak úplně cizí), vztažený k počtu obyvatel
počet cizinců ze zemí mimo EU (ti “nejcizejší cizinci”), vztažený k počtu obyvatel
počet léčených diabetiků (jako míra zdravotního stresu), vztažený k počtu obyvatel
počet potratů na 100 narozených dětí (jako míra zdravotního a sociálního stresu)
počet vyplacných sociálních dávek, vztažený k počtu obyvatel
počet vyplacených příspěvků na bydlení, vztažený k počtu obyvatel
počet vyplacených přídavků na děti, vztažený k počtu obyvatel
celková hlášená kriminalita, vztažená k počtu obyvatel
počet nahlášených vloupání, vztažený k počtu obyvatel
podíl dětí (obyvatel věkové skupiny 0 - 14 let) z celkového počtu obyvatel
podíl důchodců (obyvatel věkové skupiny 65+) z celkového počtu obyvatel
počet obyvatel do okresu přistěhovalých, vztažený k počtu obyvatel
počet obyvatel z okresu vystěhovalých, vztažený k počtu obyvatel
celkové saldo migrace, vztažené k počtu obyvatel
procento obyvatel venkova (obcí do tří tisíc obyvatel)
procento obyvatel měst (obcí nad tři tisíce obyvatel)
procento celkové nezaměstnanosti
procento nezaměstnanosti mužů
procento nezaměstnanosti žen

Pro každou z devíti parlamentních stran jsem si našel veličinu, která má nejsilnější korelaci s volebním výsledkem. Uvažoval jsem přitom absolutní hodnotu korelačního koeficientu - nebylo pro mě důležité, jestli je úměra přímá (čím víc, tím víc) nebo nepřímá (čím víc, tím míň), ale hlavně aby byla silná.

parlamentní strana	nejpodstatnější veličina	korelační koeficient
topka	stehovani_plus	0.730
ODS	stehovani_plus	0.683
SPD	davky_celkem	0.660
ANO	davky_celkem	0.653
pirati	cizinci_mimo_eu	0.630
lidovci	stehovani_minus	-0.609
socdem	podil_14minus	-0.445
komunisti	potraty	0.439
STAN	stehovani_saldo	0.324

Z tabulky vyvozuju že:

volební úspěch ODS a TOP 09 stojí a padá na migraci do regionu; migrace do regionu je přitom dobrá proxy pro regionální konjunkturu. Okresy, které jsou na tom dobře, a počet nově přistěhovalých obyvatel vzhledem k populaci je vysoký, volí tyto strany více, nežli okresy, které na tom jsou špatně a nikomu se tam stěhovávat nechce.
volební úspěch SPD a ANO závisí nejsilněji na počtu dávek na hlavu. V okresech, jejichž obyvatelé berou v průměru na člověka hodně sociálních dávek, je volební výsledek těchto stran lepší, nežli v okresech ve kterých se dávky moc nečerpají.
výsledek ČPS závisí nejsilněji na podílu cizinců mimo země EU z obyvatel; toto je zajímavé, protože cizinci nemají volební právo. Výsledek si překládám tak, že volební výsledek pirátů je tím lepší, čím více je daný okres podobnější Praze (volebním obvodu s nejvyšším podílem cizinců mimo EU).
výsledek KDU-ČSL opět souvisí s migrací, ale nepřímo: výsledek lidovců je tím lepší, čím méně se obyvatelé okresu odstěhovávají z okresu pryč. Jinými slovy se lidovcům nejvíce daří mezi lidmi, kteří sedí doma a nikam se nederou.
výsledek ČSSD nejsilněji závisí na podílu dětí z obyvatel okresu; opět se jedná o závislost nepřímou (čím méně, tím více). Je zajímavé, že pro volební úspěch sociálních demokratů není až tak podstatný vysoký podíl důchodců (což byla samostatně sledovaná veličina), jako to, aby v kraji nebyly děti.
KSČM to má hozené podobně jako sociální demokraté, jenom o něco drsněji. Komunistům se nejlépe daří v okresech, které mají vysoký podíl potratů ku živě narozeným dětem (… a divme se pak, že jim ubývají voliči).
výsledek Starostů ze sledovaných veličin nejsilněji souvisí se saldem migrace, ale jedná se ze všech parlamentních stran o korelaci nejslabší. Můj závěr tedy je, že pro starosty se mi nepodařilo najít silnou korelaci pro žádnou ze sledovaných veličin a jejich podpora závisí na něčem jiném (snad na kvalitě kandidátů, ale ve skutečnosti nevím).

Ještě zajímavější nežli tato tabulka je, že hodnotu korelace výsledků strany s dvaceti ekonomickými a sociálními ukazateli můžu použít jako souřadnice bodu ve dvacetirozměrném prostoru; a ze souřadnic si následně odečíst vzdálenost od pozice hnutí ANO, vítěze parlamentních voleb.

Získám tak míru voličské podobnosti parlamentní strany s hnutím Andreje Babiše, a podle ní si mohu sestavit pravděpodobnou vládní koalici - stačí přitom vycházet z předpokladu, že nejsnáze se bude Andreji Babišovi uzavírat spojenectví se stranami, jejichž voliči se nejvíce podobají jeho voličům.

Na základě statistické podobnosti voličského profilu parlamentních stran s vítězem voleb tedy očekávám vládní koalici ANO + SPD s podporou komunistů.
A k tomu soukromě dodávám, budiž nám dobré Nebe milostivo…