Jak načíst česká data o COVID-19?
František Kalvas (s asistencí Davida Kružlíka a Patrika Galety)
Skompilováno: 21. červen 2020
Načtení packages a úvodní nastavení
library(easypackages)
library("readr")
library("openxlsx")
library("ggplot2")
library("plotly")##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary("rvest")## Loading required package: xml2##
## Attaching package: 'rvest'## The following object is masked from 'package:readr':
##
## guess_encoding# Uložíme si do objektu stránku, kde jsou otevřená data
dataUrl = 'https://onemocneni-aktualne.mzcr.cz/api/v1/covid-19/'
# Stáhneme si ze stránky adresy souborů s daty
# laskavě poradil: Patrik Galeta; já bych totiž tu odpornou šipku nikdy nenapsal :)
urls <-
read_html(dataUrl) %>%
html_nodes('p+ .mb-10') %>%
html_attr("href")
urls## [1] "/api/v1/covid-19/testy.csv"
## [2] "/api/v1/covid-19/nakaza.csv"
## [3] "/api/v1/covid-19/nakazeni-vyleceni-umrti-testy.csv"
## [4] "/api/v1/covid-19/osoby.csv"
## [5] "/api/v1/covid-19/pomucky.csv"Nejsme ještě na konci, neboť nemáme holé názvy, ale název s částí adresy. Vidíme, že soubory se jmenují:
testy.csv
nakaza.csv
osoby.csv
pomucky.csv
Stahování dat v *.csv
Teď tedy máme jasno, kde soubory jsou, víme jak se jmenují a můžeme je začít stahovat. To že název osahuje část adresy využijeme, prostě k tomu přidáme zbytek, aby byla adresa kompletní.
# Uložíme si začátky adres do objektu
zacatky = 'https://onemocneni-aktualne.mzcr.cz'
# A teď načteme jednotlivá data jako tibbles
testy = read_csv(url(paste0(zacatky, urls[1])))## Parsed with column specification:
## cols(
## datum = col_date(format = ""),
## testy_den = col_double(),
## testy_celkem = col_double()
## )nakaza = read_csv(url(paste0(zacatky, urls[2])))## Parsed with column specification:
## cols(
## datum = col_date(format = ""),
## pocet_den = col_double(),
## pocet_celkem = col_double()
## )osoby = read_csv(url(paste0(zacatky, urls[3])))## Parsed with column specification:
## cols(
## datum = col_date(format = ""),
## kumulovany_pocet_nakazenych = col_double(),
## kumulovany_pocet_vylecenych = col_double(),
## kumulovany_pocet_umrti = col_double(),
## kumulovany_pocet_provedenych_testu = col_double()
## )pomucky = read_csv(url(paste0(zacatky, urls[4])))## Parsed with column specification:
## cols(
## datum_hlaseni = col_date(format = ""),
## vek = col_double(),
## pohlavi = col_character(),
## kraj = col_character(),
## nakaza_v_zahranici = col_double(),
## nakaza_zeme_csu_kod = col_character()
## )# Kontrola, zda se vše načetlo dobře
lapply(list(testy, nakaza, osoby, pomucky), tail)## [[1]]
## # A tibble: 6 x 3
## datum testy_den testy_celkem
## <date> <dbl> <dbl>
## 1 2020-06-14 1121 498150
## 2 2020-06-15 3673 501823
## 3 2020-06-16 4023 505846
## 4 2020-06-17 4036 509882
## 5 2020-06-18 4351 514233
## 6 2020-06-19 3050 517283
##
## [[2]]
## # A tibble: 6 x 3
## datum pocet_den pocet_celkem
## <date> <dbl> <dbl>
## 1 2020-06-15 40 10064
## 2 2020-06-16 47 10111
## 3 2020-06-17 51 10162
## 4 2020-06-18 118 10280
## 5 2020-06-19 126 10406
## 6 2020-06-20 42 10448
##
## [[3]]
## # A tibble: 6 x 5
## datum kumulovany_poce~ kumulovany_poce~ kumulovany_poce~ kumulovany_poce~
## <date> <dbl> <dbl> <dbl> <dbl>
## 1 2020-06-15 10064 7414 332 501823
## 2 2020-06-16 10111 7431 333 505846
## 3 2020-06-17 10162 7458 334 509882
## 4 2020-06-18 10280 7472 336 514233
## 5 2020-06-19 10406 7477 336 517283
## 6 2020-06-20 10448 7477 336 517283
##
## [[4]]
## # A tibble: 6 x 6
## datum_hlaseni vek pohlavi kraj nakaza_v_zahranici nakaza_zeme_csu_kod
## <date> <dbl> <chr> <chr> <dbl> <chr>
## 1 2020-04-05 20 Z CZ071 NA <NA>
## 2 2020-04-05 20 Z CZ071 NA <NA>
## 3 2020-04-05 20 Z CZ071 NA <NA>
## 4 2020-04-05 20 Z CZ071 NA <NA>
## 5 2020-04-14 20 Z CZ032 NA <NA>
## 6 2020-04-05 20 Z CZ071 NA <NA>Určitě by to šlo načíst nějak pomocí ‘for’ cyklu, ale mně nejde v jeho rámci, generovat názvy objektů… Dokážete někdo tady kód vylepšit?
Uložení dat do jednoho *.xlsx souboru
# Nyní vše uložíme jako jednotlivé listy jednoho excelovského souboru.
l = list(testy = testy, nakaza = nakaza, osoby = osoby, pomucky = pomucky) # pattern: sheetName = data.frameName
write.xlsx(l, file = "covi19cz.xlsx", colNames = TRUE)A je to! Všechna data máme a můžeme se pustit do jejich zpracování a analýzy! Ale to až někdy příště…
P. S. Jen tak cvičně, alespoň graf o vývoji počtu nových případů za den:
g = ggplot(nakaza,
aes(x = datum, y = pocet_den)) +
geom_line() +
geom_line(aes(x = datum, y = pocet_celkem, col = 'red')) +
labs(title = "Absolutní a kumulované (červeně) počty nových případů v ČR",
x = "datum",
y = "počet potvrzených případů") +
theme_classic()
ggplotly(g) # že je tak jednoduché udělat interaktivní graf mi ukázal David KružlíkDavidův graf
David Kružlík v rámci KSS/KA1 udělal docela pěkný animovaný graf. Byla by škoda to s Vámi nesdílet.
library(ggplot2)
library(gganimate)
library(hrbrthemes)
library(viridis)## Loading required package: viridisLite## Chci do grafu doplnit klouzavé průměry, šikovnou funkci jsem našel na StackOverflow:
## https://stackoverflow.com/a/44827824/7406109; nebudu nic předstírat,
## kopíruju včetně originálních komentářů.
moving_fun <- function(x, w, FUN, ...) {
# x: a double vector
# w: the length of the window, i.e., the section of the vector selected to apply FUN
# FUN: a function that takes a vector and return a summarize value, e.g., mean, sum, etc.
# Given a double type vector apply a FUN over a moving window from left to the right,
# when a window boundary is not a legal section, i.e. lower_bound and i (upper bound)
# are not contained in the length of the vector, return a NA_real_
if (w < 1) {
stop("The length of the window 'w' must be greater than 0")
}
output <- x
for (i in 1:length(x)) {
# plus 1 because the index is inclusive with the upper_bound 'i'
lower_bound <- i - w + 1
if (lower_bound < 1) {
output[i] <- NA_real_
} else {
output[i] <- FUN(x[lower_bound:i, ...])
}
}
output
}
# Připojíme klouzavý průměr počtu nově nakažených za den
## Protože zdravotnictví i občané fungují v nějakém týdenním cyklu,
## volím klouzavý průměr za 7 dní
nakaza$poc_den_klouz = moving_fun(nakaza$pocet_den, 7, mean)
# podmínka - počínaje prvním nakaženým případem
## Je důležité nejdřív spočítat klouzavý průměr a potom teprve 'oříznout' data,
## protože na počátku časové řady funkce vygeneruje 6 NAs, 'moving_fun' totiž
## počítá klouzavý průměr za _n_ předchozích hodnot vektoru, proto nemá na
## _n-1_ prvních pozicích vektoru dost pozorování a objeví se tu NA.
## Když nejdříve filtrujeme a pak počítáme, zbytečně nebudeme mít na začátku pozorování.
nakaza <- filter(nakaza, pocet_celkem > 1)
# Připravíme si graf jak pro animaci, tak interaktivní graf
g = ggplot(nakaza, aes(x=datum, y=pocet_den)) +
geom_line(size=1, color="darkorchid3") +
geom_point(size=3) +
geom_line(aes(x = datum, y = poc_den_klouz, size = 1.5)) +
scale_color_viridis(discrete = TRUE) +
ggtitle("Počet nově nakažených za den: od 12.3. - dnes") +
ylab("Počet nově nakažených") +
xlab("Dny") +
transition_reveal(datum) +
theme_gray()
# Toto samo o sobě vykreslí animovaný graf
g
Ale pokud se chcete ‘pošťárat’ v konkrétních hodnotách, spíš poslouží interaktivní graf:
# Graf už máme uložený v objektu 'g', takže ho nemusíme programovat znova
ggplotly(g)