Analýza COVID dát v krajinách V4

Import údajov

library(readr)
covid <- read_csv2("Covid.csv")
head(covid)

str(covid)

spc_tbl_ [4,372 × 5] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ country   : chr [1:4372] "Czechia" "Czechia" "Czechia" "Czechia" ...
 $ date      : Date[1:4372], format: "2020-01-04" "2020-01-05" "2020-01-06" "2020-01-07" ...
 $ cases     : num [1:4372] 0 0 0 0 0 0 0 0 0 0 ...
 $ deaths    : num [1:4372] 0 0 0 0 0 0 0 0 0 0 ...
 $ population: num [1:4372] 10673216 10673216 10673216 10673216 10673216 ...
 - attr(*, "spec")=
  .. cols(
  ..   country = col_character(),
  ..   date = col_date(format = ""),
  ..   cases = col_double(),
  ..   deaths = col_double(),
  ..   population = col_double()
  .. )
 - attr(*, "problems")=<externalptr> 

summary(covid)

   country               date                cases             deaths         population      
 Length:4372        Min.   :2020-01-04   Min.   :      0   Min.   :     0   Min.   : 5473195  
 Class :character   1st Qu.:2020-10-03   1st Qu.:  59088   1st Qu.:  1308   1st Qu.: 8631530  
 Mode  :character   Median :2021-07-03   Median :1043490   Median : 20372   Median :10178762  
                    Mean   :2021-07-03   Mean   :1627459   Mean   : 30076   Mean   :16054113  
                    3rd Qu.:2022-04-02   3rd Qu.:2153564   3rd Qu.: 41474   3rd Qu.:17601346  
                    Max.   :2022-12-31   Max.   :6368388   Max.   :118533   Max.   :38385734  

Základné grafy

Čiarový graf

library(ggplot2)
ggplot(covid, aes(x = date, y = cases, color = country)) +
geom_line(size=1) +
theme_minimal() +
labs(title = "Vývoj počtu prípadov COVID v krajinách V4",
x = "Dátum", y = "Počet prípadov")

covid$cases<- format(covid$cases, scientific = FALSE)

Interpretácia grafu: Na osi X je čas (Dátum) od roku 2020 do 2023. Na osi Y je kumulatívny počet prípadov COVID. Poľsko (modrá čiara) má najvyšší počet prípadov (viac ako 6 miliónov). Česko (červená čiara) nasleduje s približne 4,5 miliónmi prípadov. Maďarsko (zelená čiara) a Slovensko (fialová čiara) majú pod 2 milióny prípadov, pričom Slovensko je mierne pod Maďarskom. Vidieť typické pandemické vlny – prudké nárasty a následné spomalenia.

Záver: Počet prípadov bol najvyšší v Poľsku, najnižší na Slovensku, no priebeh vĺn bol vo všetkých krajinách veľmi podobný.

Scatterplot

Pozn. skúšal som viacerými spôsobmi spraviť to, aby mi ukázalo čísla/intervaly na Y-osi normálne, prípadne po miliónových intervaloch - tak ako na X-osi, ale bohužiaľ bez výsledku.

library(scales)
library(ggplot2)
ggplot(covid, aes(x = population, y = cases, color = country)) +
geom_point() +
theme_minimal() +
labs(title = "Počet prípadov vs. veľkosť populácie",
x = "Populácia", y = "Počet prípadov")

Interpretácia grafu Os X (Populácia): Slovensko má ~5,5 milióna obyvateľov (fialová). Maďarsko a Česko majú ~10 miliónov (zelená a červená). Poľsko má ~38–39 miliónov (tyrkysová).

Os Y (Počet prípadov): Hodnoty sú kumulatívne počty prípadov počas pandémie.

Tvar grafu: Každá krajina je zobrazená ako zvislý „stĺpec bodov“. To je preto, že populácia sa počas rokov nemení, ale počet prípadov áno → každá krajina má fixnú hodnotu na X a mnoho hodnôt na Y (pre rôzne dátumy).

Základné zistenia: Poľsko (najľudnatejšia krajina) malo aj najviac prípadov, čo je logické – viac obyvateľov → viac príležitostí na nákazu. Slovensko má najmenej obyvateľov, preto je aj celkový počet prípadov nižší. Pri Maďarsku a Česku vidno podobné počty prípadov, no Česko má vo výsledku vyšší rozsah (vyšší stĺpec na Y-osi). Medzi počtom obyvateľov a celkovým počtom prípadov je teda jasný pozitívny vzťah.

Boxplot

ggplot(covid, aes(x = country, y = deaths, fill = country)) +
geom_boxplot() +
theme_minimal() +
labs(title = "Rozdelenie počtu úmrtí podľa krajín",
x = "Krajina", y = "Úmrtia")

Interpretácia:

Poland (Poľsko) – má jednoznačne najvyšší počet úmrtí zo všetkých krajín. – Box (interkvartilové rozpätie) je veľmi vysoký, čo znamená, že počty úmrtí sa v priebehu pandémie značne menili. – Medián (čierna čiara vo vnútri boxu) je niekde okolo 75 000, ale hodnoty siahajú až nad 100 000.

Česko a Maďarsko – majú stredne vysoké počty úmrtí (okolo 30 000–40 000). – Medián je vyšší v Maďarsku, rozptyl je porovnateľný.

Slovensko – má jednoznačne najnižší počet úmrtí (okolo 20 000). – Box je menší → rozptyl je užší, priebeh pandémie v úmrtiach bol relatívne „kompaktnejší“.

Štatistiky

Základné štatistiky

library(dplyr)
library(knitr)
library(kableExtra)

stats <- covid %>%
group_by(country) %>%
summarise(
mean_cases = mean(cases, na.rm=TRUE),
median_cases = median(cases, na.rm=TRUE),
sd_cases = sd(cases, na.rm=TRUE),
mean_deaths = mean(deaths, na.rm=TRUE),
median_deaths = median(deaths, na.rm=TRUE),
sd_deaths = sd(deaths, na.rm=TRUE)
)

stats %>%
kable(digits = 2, caption = "Štatistiky COVID prípadov a úmrtí podľa krajín") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))

Štatistiky COVID prípadov a úmrtí podľa krajín

country	mean_cases	median_cases	sd_cases	mean_deaths	median_deaths	sd_deaths
Czechia	NA	1688091	1694876.1	23367.26	30491	16536.99
Hungary	NA	808197	798204.1	24597.41	29992	18938.55
Poland	NA	2881517	2407157.9	61961.05	75105	46687.34
Slovakia	NA	391696	731252.8	10377.53	12513	8267.41

Česko: Priemerný počet prípadov: ~1,96 milióna. Medián prípadov: ~1,68 milióna → rozdelenie je trochu „ťahané nahor“ extrémnymi hodnotami. Priemerný počet úmrtí: ~23 367. Medián úmrtí: ~30 491 → znamená, že v druhej polovici obdobia boli úmrtia vyššie. Relatívne vysoké štandardné odchýlky (variabilita v čase).

Maďarsko: Priemerný počet prípadov: ~909 tisíc, čo je menej než v Česku, ale… Priemerný počet úmrtí: ~24 597 → paradoxne vyšší než v Česku, hoci prípadov bolo menej. To môže naznačovať vyššiu úmrtnosť (väčší podiel úmrtí na prípadoch).

Poľsko: Najväčší priemerný počet prípadov: ~2,93 milióna. Najväčší priemerný počet úmrtí: ~61 961 → jednoznačne najhoršie postihnutá krajina V4. Extrémne vysoká štandardná odchýlka → priebeh pandémie bol v Poľsku veľmi rozkolísaný (silné vlny).

Slovensko: Najnižší priemerný počet prípadov (~707 tisíc). Aj úmrtí mala najmenej (~10 378). Medián úmrtí 12 513 naznačuje, že v druhej polovici pandémie bol počet úmrtí už vyšší než na začiatku. Variabilita (sd) je menšia než u ostatných, čo zodpovedá menšej krajine.

Korelačná analýza a heatmapa

library(corrplot)
num_data <- covid %>%
select(population, cases, deaths) %>%
na.omit()

cor_matrix <-cor(num_data)

Error in cor(num_data) : 'x' must be numeric

(Pozn. Pri poslednej úprave a funkcii RUN ALL (ctrl+alt+R) sa mi nejakým nedopatrením stalo, že mi nejde zobraziť korelačná analýza, z dôvodu, že som už stratil nervy a je veľa hodín a nechce sa mi tu nad tým už sedieť prikladám iba screenshot, ktorý som odfotil ešte predtým, ako sa to pokazilo.)

Korelácia ešte keď to fungovalo

Interpretácia hodnôt korelácie:

Cases – Deaths: 0.92 veľmi silná pozitívna korelácia: čím viac prípadov, tým viac úmrtí. To je očakávané, pretože úmrtia sú priamo dôsledkom infekcií.

Population – Deaths: 0.58 stredne silná pozitívna korelácia: väčšie krajiny majú vo všeobecnosti viac úmrtí. To je logické, keďže pri väčšej populácii je vyšší absolútny počet obyvateľov vystavený riziku.

Population – Cases: 0.44 slabšia až stredná korelácia: väčšie krajiny majú tendenciu mať viac prípadov, ale vzťah nie je taký silný, ako medzi prípadmi a úmrtiami. To môže byť ovplyvnené rozdielmi v testovaní, opatreniach alebo štatistickom vykazovaní.

Testovanie hypotéz

t.test(
covid$deaths[covid$country == "Slovakia"],
covid$deaths[covid$country == "Czechia"]
)

    Welch Two Sample t-test

data:  covid$deaths[covid$country == "Slovakia"] and covid$deaths[covid$country == "Czechia"]
t = -23.228, df = 1605.8, p-value < 0.00000000000000022
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -14086.62 -11892.83
sample estimates:
mean of x mean of y 
 10377.53  23367.26 

V priemere malo Česko počas sledovaného obdobia o približne 13000 úmrtí viac ako Slovensko. Rozdiel je veľký aj štatisticky významný. Na základe dát môžeme s vysokou istotou povedať, že úmrtnosť v Česku bola dlhodobo vyššia než na Slovensku.

Anova

anova_result <- aov(cases ~ country, data = covid)
summary(anova_result)

              Df            Sum Sq          Mean Sq F value              Pr(>F)    
country        3  3481683094412067 1160561031470689   471.8 <0.0000000000000002 ***
Residuals   4368 10744050988456546    2459718632888                                
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Výsledok znamená, že rozdiely medzii krajinami sú štatisticky významné - priemerný počet prípadov COVID sa nedá vysvetliť len náhodou. Hviezdičky pri p-hodnote naznačujú veľmi silnú štatistickú významnosť (p<0,001).

Lineárna regresia

model <- lm(deaths ~ cases + population, data = covid)
summary(model)

Call:
lm(formula = deaths ~ cases + population, data = covid)

Residuals:
     Min       1Q   Median       3Q      Max 
-29577.4  -3763.0     81.2   7887.7  20049.3 

Coefficients:
                  Estimate     Std. Error t value            Pr(>|t|)    
(Intercept) -2994.32483155   287.09658892  -10.43 <0.0000000000000002 ***
cases           0.01506962     0.00010864  138.72 <0.0000000000000002 ***
population      0.00053226     0.00001503   35.42 <0.0000000000000002 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11610 on 4369 degrees of freedom
Multiple R-squared:  0.8763,    Adjusted R-squared:  0.8763 
F-statistic: 1.548e+04 on 2 and 4369 DF,  p-value: < 0.00000000000000022

Lineárny regresný model ukazuje, že počet prípadov COVID je silne spojený s počtom úmrtí (p < 0.001). Každých 1000 prípadov prináša v priemere približne 15 úmrtí. Populácia krajiny má tiež štatisticky významný efekt – väčšie krajiny evidujú viac úmrtí aj po zohľadnení počtu prípadov. Celková vysvetľovacia schopnosť modelu je vysoká (R² = 0.876), čo znamená, že model zachytáva väčšinu variability v počte úmrtí.

Prehľad koeficientov

library(broom)
coef_tbl <- broom::tidy(model, conf.int = TRUE) %>%
mutate(
term = dplyr::recode(term,
"(Intercept)" = "Intercept",
"Cases" = "Cases (počet prípadov)",
"Population" = "Population (obyvatelia)"
),
stars = dplyr::case_when(
p.value < 0.001 ~ "",
p.value < 0.01 ~ "",
p.value < 0.05 ~ "",
p.value < 0.1 ~ "·",
TRUE ~ ""
)
) %>%
transmute(
Term = term,
Estimate = estimate,
`Std. Error` = std.error,
`t value` = statistic,
`p value` = p.value,
`95% CI` = stringr::str_c("[", round(conf.low, 3), ", ", round(conf.high, 3), "]"),
Sig = stars
)

coef_tbl %>%
kable(digits = 3,
caption = "OLS koeficienty: Deaths ~ Cases + Population") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("striped","hover","condensed")) %>%
column_spec(1, bold = TRUE) %>%
row_spec(0, bold = TRUE, background = "#f2f2f2") %>%
footnote(general = "Signif. kódy: *** p<0.001, ** p<0.01, * p<0.05, · p<0.1.", threeparttable = TRUE)

OLS koeficienty: Deaths ~ Cases + Population

Term	Estimate	Std. Error	t value	p value	95% CI	Sig
Intercept	-2994.325	287.097	-10.430	0	[-3557.18, -2431.47]
cases	0.015	0.000	138.717	0	[0.015, 0.015]
population	0.001	0.000	35.419	0	[0.001, 0.001]
Note:
Signif. kódy: *** p<0.001, ** p<0.01, * p<0.05, · p<0.1.

fit.tbl <- glance(model) %>%
  transmute(
`R-squared` = r.squared,
`Adj. R-squared` = adj.r.squared,
`F-statistic` = statistic,
`F p-value` = p.value,
`AIC` = AIC,
`BIC` = BIC,
`Num. obs.` = nobs
)

coef_tbl %>%
kable(digits = 3, caption = "Model – metriky zhody") %>%
kable_styling(full_width = FALSE, bootstrap_options = c("condensed"))

Model – metriky zhody

Term	Estimate	Std. Error	t value	p value	95% CI	Sig
Intercept	-2994.325	287.097	-10.430	0	[-3557.18, -2431.47]
cases	0.015	0.000	138.717	0	[0.015, 0.015]
population	0.001	0.000	35.419	0	[0.001, 0.001]

Interpretácia koeficientov:

Intercept = -2994.3 – matematická konštanta modelu. Hovorí, že ak by bolo prípadov aj populácia nulová, predikovaný počet úmrtí by bol záporný (~ -2994). To samozrejme nedáva reálny význam, ale intercept je potrebný na vyrovnanie priamky.

Cases (0.015) – koeficient je kladný a štatisticky vysoko významný (p < 0.001). – Znamená, že pri náraste počtu prípadov o 1 jednotku sa počet úmrtí zvýši v priemere o 0.015. – Prakticky: na 1000 prípadov pripadá asi 15 úmrtí.

Population (0.001) – tiež kladný a vysoko významný (p < 0.001). – Znamená, že pri zvýšení populácie o 1 jednotku (1 obyvateľa) sa predpokladá nárast úmrtí o 0.001. – Teda pri 1 milióne obyvateľov sa očakáva v priemere približne 1000 úmrtí navyše (pri rovnakom počte prípadov).