coRona data #2 — roste to? Klesá to?
Dneska se opět podíváme na data o COVIDu pomocí Rka. Znovu předesílám - cílem není fušování do díla epidemiologům, ale demonstrace možností vizualizace a analýzy v Rku nad aktuálními daty.
Tématem tentokrát bude jak si zpřehlednit data z https://onemocneni-aktualne.mzcr.cz/covid-19 . Na této stránce jsou pravidelně aktualizována data, a dokonce část dat je poskytnuta jako OpenData. Super. Nicméně mi vadí několik věcí:
- chybí mi graf ukazující v jednom grafu nově potvrzené nakažené, nově hospitalizované a nově zemřelé.
- a chybí mi pohled po dnech v týdnu, neboť data potvrzených testů mají zjevně silnou závislost právě na tom zda je sobota nebo středa.
Jak si pomocí Rka toto udělat? Celkem snadno. Zdroják je na konci článku.
Získání dat
Jako data použijeme dva zdroje.
Hlavní kumulativní metriky snadno získáme z CSV souboru https://onemocneni-aktualne.mzcr.cz/api/v2/covid-19/nakazeni-vyleceni-umrti-testy.csv
data <- read.csv("https://onemocneni-aktualne.mzcr.cz/api/v2/covid-19/nakazeni-vyleceni-umrti-testy.csv",
as.is=T,
encoding = "UTF8" )
names(data)[1] <- "datum"Data o hospitalizacích bohužel musíme vyparsovat z https://onemocneni-aktualne.mzcr.cz/covid-19/prehled-hospitalizaci, kde se ukrývají jako JSON v atributu elementu #js-hospitalization-data. K tomu použijete knihovny rvest a jsonlite.
url<-xml2::read_html("https://onemocneni-aktualne.mzcr.cz/covid-19/prehled-hospitalizaci")
selector_name<-"#js-hospitalization-data"
json <- html_nodes(x = url, css = selector_name) %>%
html_attr("data-linechart")
jsondata <- fromJSON(json)
hospitalizace <- jsondata$values[[1]]Data následně transformujeme pomocí dplyr. Pomocí funkce lag spočítáme denní přírůstky z kumulovaných dat a pomocí funkce zoo::rollapply klouzavý doprava zarovnaný průměr.
Celkový pohled na vývoj
Pojďme na grafy. Nejprve celkový pohled na nakažené, hospitalozované a mrtvé. Ve všech případech jde o denní přírůstky. Počty hospitalizovaných tak mohou být záporné, pokud je ten den více propuštěných pacientů. Levá osa jsou nakažení a pravá jsou mrtví a hospitalizovaní.
Roste to což? Všechny trendy jdou nahoru s časovým zpožděním. Trendy jsou počítány pomocí geom_smooth().
Takto to vypadá, když se podíváme na 7d klouzavý průměr. I přes opatření
22. 10. 2020 stále roste a náznak zlomu je teprve 28. 10. 2020.
Pohled na dny v týdnu
Jak jsem zmiňoval, tak vývoj pozitivních testů má týdenní cyklus. Je tedy zajímavé se dívat na jednotlivé pondělky, úterky atd. jako na samostatné řady.
Vidíme, že samostatné řady tvoří exponencielu a teprve poslední středa a čtvrtek jsou poprvé nižší než stejný den v minulém týdnu. Je třeba poznamenat, že ta středa je 28. 10., tedy státní svátek. A čtvrtek je den po státním svátku. Podobný pokles se stal s pondělkem 28. 9. a následným úterkem 29. 9.
Lépe to vynikne na následujícím grafu, který ukazuje přírůstky oproti stejnému dni minulý týden.
V tomto pohledu je jasně vidět, že podobný pokles nastal ke konci září a po krátkém volnu došlo k explozivním nárůstům kolem. Hypotézy poklesu jsou dvě:
- opatření zabrala a vidíme první náznak ústupu, který bude pokračovat
- lidé pouze využili svátek a volna ve školách k ústupu na chalupy, kde se vesele promořují. A začátkem dalšího týdne naběhnou na testy.
Reálný dopad opatření tedy skutečně uvidíme až v pondělí a úterý příštího týdne.
Zdrojový kód
Kód použitý pro tvorbu grafů jsem přidal do našeho public git repozitáře jako další příklad naší miniškoličky Rka.
Celý kód ukazuje několik středně pokročilých operací:
- parsování stránky
- trochu složitější operace dplyr
- grafy v ggplot2 s custom osami, přidání druhé osy v pravo, otočení textu na ose a přidání horizontal a vertical interception lines
Toto všechno vám s láskou přináší data geeci z Etnetera Activate
