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

suppressMessages(library(sf))
suppressMessages(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)
## RCzechia: downloading remote dataset.
casti <- casti() %>%
  select(KOD, NAZEV)
## RCzechia: downloading remote dataset.
podklad <- obce %>% # všechny obce...
  rbind(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)
## RCzechia: downloading remote dataset.
    # systém inž. Křováka 

kraje <- kraje() %>%
  st_transform(crs = 5514)
## RCzechia: downloading remote dataset.
    # 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"))
## Warning in tm_style_white("Relativní výsledky", frame = F, legend.format
## = list(text.separator = "-", : tm_style_white is deprecated as of tmap
## version 2.0. Please use tm_style("white", ...) instead
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",
                                      fun = function(x) paste0(formatC(x / 1000, digits = 0, 
                                                                       format = "f"), " tis.")),
                 legend.text.size = 0.8, 
                 legend.title.size = 1.3) +
  tm_legend(position = c("RIGHT", "top"))
## Warning in tm_style_white("Absolutní výsledky", frame = F, legend.format
## = list(text.separator = "-", : tm_style_white is deprecated as of tmap
## version 2.0. Please use tm_style("white", ...) instead
    # 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.