Práca s databázou - import údajov, grafy, štatistiky

knitr::opts_chunk$set(
    echo = TRUE,
    message = FALSE,
    warning = FALSE
)

Ukážka databázy

head(world_population_data)              # pár prvých riadkov

colnames(world_population_data)          # názvy premenných

 [1] "rank"             "cca3"             "country"         
 [4] "continent"        "2023 population"  "2022 population" 
 [7] "2020 population"  "2015 population"  "2010 population" 
[10] "2000 population"  "1990 population"  "1980 population" 
[13] "1970 population"  "area (km²)"       "density (km²)"   
[16] "growth rate"      "world percentage"

Grafy

Výber a následné triedenie databázy, ktorú som obmedzila na dve premenné, a to krajiny Malta a Cyprus.

library(dplyr)

cyprus_malta_data <- world_population_data %>%
  filter(country == "Cyprus"| country == "Malta") %>%
  select(`cca3`, `2023 population`,`2022 population`, `2020 population`,`2015 population`, `2010 population`,`2000 population`,`1990 population`,`1980 population`,`1970 population`,`growth rate`,`world percentage`)
head(cyprus_malta_data)

Skontrolovanie štruktúry dát

colnames(cyprus_malta_data)

 [1] "cca3"             "2023 population"  "2022 population" 
 [4] "2020 population"  "2015 population"  "2010 population" 
 [7] "2000 population"  "1990 population"  "1980 population" 
[10] "1970 population"  "growth rate"      "world percentage"

head(cyprus_malta_data)

Scatter plot

# Basic scatter plot
library(dplyr)
library(tidyr)
library(ggplot2)

# 1. Vyberiem potrebné stĺpce a dáta len pre Cyprus a Maltu
cyprus_malta_sel <- cyprus_malta_data %>%
filter(cca3 %in% c("CYP", "MLT")) %>%  # Filtrovanie Cypru a Malty
select(cca3, `2023 population`, `2022 population`, `2020 population`, `2015 population`, `2010 population`,`2000 population`,`1990 population`,`1980 population`,`1970 population`) 

# 2. Premením dáta do dlhého formátu (pre graf)
cyprus_malta_long <- cyprus_malta_sel %>%
pivot_longer(cols = c(`2023 population`, `2022 population`, `2020 population`,`2015 population`,`2010 population`,`2000 population`,`1990 population`,`1980 population`,`1970 population`), names_to = "year",         
values_to = "population")  

# 3. Vytvorím graf - Zobrazím populáciu Cypru a Malty v rokoch 1970 - 2023
ggplot(cyprus_malta_long, aes(x = year, y = population, color = cca3, group = cca3)) +
  geom_line(size = 1) +    
  geom_point(size = 3) +   
  theme_minimal() +        
  labs(title = "Populácia Cypru a Malty v rokoch 1970 až 2023",
       x = "Rok",
       y = "Populácia",
       color = "Krajina") + theme(axis.text.x = element_text(angle = 45, hjust = 1))

scale_color_manual(values = c("CYP" = "lightpink", "MLT" = "skyblue"))  

<ggproto object: Class ScaleDiscrete, Scale, gg>
    aesthetics: colour
    axis_order: function
    break_info: function
    break_positions: function
    breaks: waiver
    call: call
    clone: function
    dimension: function
    drop: TRUE
    expand: waiver
    get_breaks: function
    get_breaks_minor: function
    get_labels: function
    get_limits: function
    get_transformation: function
    guide: legend
    is_discrete: function
    is_empty: function
    labels: waiver
    limits: function
    make_sec_title: function
    make_title: function
    map: function
    map_df: function
    minor_breaks: waiver
    n.breaks.cache: NULL
    na.translate: TRUE
    na.value: grey50
    name: waiver
    palette: function
    palette.cache: NULL
    position: left
    range: environment
    rescale: function
    reset: function
    train: function
    train_df: function
    transform: function
    transform_df: function
    super:  <ggproto object: Class ScaleDiscrete, Scale, gg>

Boxplot

Z dôvodu, že premenné populácie majú v konkrétnom roku iba jednu hodnotu je vyhotovenie boxplotu bezpredmetné, avšak nižšie uvádzam názornú ukážku.

library(ggplot2)
library(dplyr)
library(scales)  

# Filtrovanie len pre Cyprus a Maltu
cyprus_malta_long %>%
filter(cca3 %in% c("CYP", "MLT")) %>%
ggplot(aes(x = year, y = population, fill = cca3, color = cca3)) + geom_boxplot(alpha = 0.5, outlier.shape = 16, outlier.size = 2) +  
scale_fill_manual(values = c("CYP" = "lightpink", "MLT" = "lightblue")) + scale_color_manual(values = c("CYP" = "pink", "MLT" = "darkblue")) +  labs( title = "Populácia Cypru a Malty podľa rokov",
      x = "Rok",
      y = "Populácia",
      fill = "Krajina",
      color = "Krajina") + theme_minimal() + scale_y_continuous(labels = label_comma()) +  theme(axis.text.x = element_text(angle = 45, hjust = 1),  
      legend.position = "top",  
      plot.title = element_text(hjust = 0.5),  
      strip.text = element_text(size = 14), 
      axis.text = element_text(size = 12),  
      axis.title = element_text(size = 14)) +
    facet_wrap(~ cca3)

Základné štatistiky.

V nasledujúcej tabuľke zobrazujem výpočet základných štatistík Cypru a Malty. Je vypočítaný priemer populácie v rámci týchto dvoch krajín, minimálna a maximálna hodnota populácie, medián, smerodajná odchýlka či kvartily. Od roku 2010 do 2023 priemerná hodnota populácie stúpla z 774 220 na 897 601, čo je nárast asi o 16 %. Smerodajná odchýlka sa pohybuje okolo 500 000 vo všetkých rokoch, čo znamená, že variabilita hodnôt je pomerne veľká, ale relatívne stabilná v čase. Minimálne hodnoty stúpajú z 418 755 na 535 064, a maximá z 1 129 686 na 1 260 138. Celý rozsah hodnôt sa teda posúva smerom nahor, čo potvrdzuje všeobecný rast populácie daných krajín. Kvartily (Q25, Median, Q75) sa tiež postupne zvyšujú, čo znamená, že celé rozdelenie hodnôt sa posúva vyššie, nielen priemer.

library(dplyr)
library(tidyr)
library(knitr)

# Vyberiem Cyprus a Maltu a potrebné stĺpce
cyprus_malta_data <- world_population_data %>%
filter(country %in% c("Cyprus", "Malta")) %>%
select(cca3, `2023 population`, `2022 population`, `2020 population`, `2015 population`, `2010 population`, `2000 population`, `1990 population`, `1980 population`, `1970 population`, `growth rate`, `world percentage`)

# Premením do dlhého formátu, aby sme mali rok a populáciu v samostatných stĺpcoch
cyprus_malta_long <- cyprus_malta_data %>%
  pivot_longer(cols = ends_with("population"),
               names_to = "year",
               values_to = "population") %>%
  mutate(year = gsub(" population", "", year)) 

# Vyberiem len konkrétne roky na sumarizáciu (napr. 2010 až 2023)
selected_years <- c("2023", "2022", "2020", "2015", "2010")

# Vypočítam základné štatistiky pre každý rok (z oboch krajín)
pop_stats <- cyprus_malta_long %>%
  filter(year %in% selected_years) %>%
  group_by(year) %>%
  summarise(
    n      = n(),
    mean   = mean(population, na.rm = TRUE),
    sd     = sd(population, na.rm = TRUE),
    min    = min(population, na.rm = TRUE),
    q25    = quantile(population, 0.25, na.rm = TRUE),
    median = median(population, na.rm = TRUE),
    q75    = quantile(population, 0.75, na.rm = TRUE),
    max    = max(population, na.rm = TRUE),
    .groups = "drop")

# Vytvorenie peknej tabuľky
kable(pop_stats, digits = 0, caption = "**Základné štatistiky populácie pre Cyprus a Maltu** *(vybrané roky)*")

Základné štatistiky populácie pre Cyprus a Maltu (vybrané roky)

year	n	mean	sd	min	q25	median	q75	max
2010	2	774220	502704	418755	596488	774220	951953	1129686
2015	2	821930	516684	456579	639254	821930	1004605	1187280
2020	2	876447	510658	515357	695902	876447	1056992	1237537
2022	2	892387	507846	533286	712836	892387	1071938	1251488
2023	2	897601	512705	535064	716332	897601	1078870	1260138

tabuľku vieme vytvoriť i krajšiu s pomocou “kableExtra”:

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

# Vyberiem Cyprus a Maltu a potrebné stĺpce
cyprus_malta_data <- world_population_data %>%
filter(country %in% c("Cyprus", "Malta")) %>%
select(cca3, `2023 population`, `2022 population`, `2020 population`, `2015 population`, `2010 population`, `2000 population`, `1990 population`, `1980 population`, `1970 population`, `growth rate`, `world percentage`)

# Premením do dlhého formátu, aby sme mali rok a populáciu v samostatných stĺpcoch
cyprus_malta_long <- cyprus_malta_data %>%
 pivot_longer(cols = ends_with("population"),names_to = "year", values_to = "population") %>% mutate(year = gsub(" population", "", year)) 

# Vyberiem len konkrétne roky na sumarizáciu (napr. 2010 až 2023)
selected_years <- c("2023", "2022", "2020", "2015", "2010")

# Vypočítam základné štatistiky pre každý rok (z oboch krajín)
pop_stats <- cyprus_malta_long %>%
  filter(year %in% selected_years) %>%
  group_by(year) %>%
  summarise(
    n      = n(),
    mean   = mean(population, na.rm = TRUE),
    sd     = sd(population, na.rm = TRUE),
    min    = min(population, na.rm = TRUE),
    q25    = quantile(population, 0.25, na.rm = TRUE),
    median = median(population, na.rm = TRUE),
    q75    = quantile(population, 0.75, na.rm = TRUE),
    max    = max(population, na.rm = TRUE),
    .groups = "drop")

# Vytvorenie štýlovanej tabuľky s kableExtra
pop_stats %>%
  kable(digits = 0, caption = "Základné štatistiky populácie pre Cyprus a Maltu (vybrané roky)") %>%
  kable_styling(
    full_width = FALSE,
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    position = "center",
    font_size = 13) %>%
  column_spec(1, bold = TRUE) %>%  # Tučný text pre rok
  row_spec(0, bold = TRUE, color = "purple", background = "pink") %>%
  add_header_above(c(" " = 2, "Štatistiky populácie" = 7), bold = TRUE, background = "pink", color = "black") %>%
  kable_paper("hover", full_width = FALSE) %>%
  kable_material(c("hover"))  

Základné štatistiky populácie pre Cyprus a Maltu (vybrané roky)

		Štatistiky populácie
year	n	mean	sd	min	q25	median	q75	max
2010	2	774220	502704	418755	596488	774220	951953	1129686
2015	2	821930	516684	456579	639254	821930	1004605	1187280
2020	2	876447	510658	515357	695902	876447	1056992	1237537
2022	2	892387	507846	533286	712836	892387	1071938	1251488
2023	2	897601	512705	535064	716332	897601	1078870	1260138

Testovanie hypotéz

Nasledujúcimi príkazmi zisťujem, či sa priemerná populácia krajín na svete významne zmenila medzi rokmi 1970 a 2023. Na lepšiu vizualizáciu uvádzam boxplot, ktorý vizuálne ukazuje rozloženie populácie jednotlivých krajín v období medzi týmito dvoma rokmi – napríklad, že v roku 2023 majú krajiny všeobecne vyšší počet obyvateľov a väčšie rozdiely medzi nimi ako v roku 1970. Na uvedenom boxplote je taktiež možné sledovať extrémne hodnoty.

t-test: Porovnanie populácie krajín v rokoch 1970 a 2020

library(dplyr)
library(tidyr)
library(ggplot2)
library(scales)

# Prevedenie do long formátu
world_population_long <- world_population_data %>%
  pivot_longer(cols = ends_with("population"), names_to = "year", values_to = "population", names_pattern = "(\\d{4}) population") %>%
  mutate(year = as.numeric(year))

# t-test – porovnanie priemernej populácie krajín medzi rokmi 1970 a 2020
t.test.result <- t.test(world_population_long$population[world_population_long$year == 1970], world_population_long$population[world_population_long$year == 2023], paired = FALSE)

print(t.test.result)

    Welch Two Sample t-test

data:  world_population_long$population[world_population_long$year == 1970] and world_population_long$population[world_population_long$year == 2023]
t = -1.8559, df = 340.12, p-value = 0.06433
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -38287050   1112018
sample estimates:
mean of x mean of y 
 15786909  34374425 

# Boxplot – vizualizácia rozdielu medzi rokmi
world_population_long %>%
  filter(year %in% c(1970, 2023)) %>%
  ggplot(aes(x = factor(year), y = population, fill = factor(year))) +
  geom_boxplot(alpha = 0.7, outlier.shape = 16, outlier.size = 1.5) +
  scale_y_continuous(labels = label_comma()) +
  scale_fill_manual(values = c("1970" = "lightgreen", "2023" = "yellow")) +
  labs(
    title = "Porovnanie populácie krajín v rokoch 1970 a 2023",
    x = "Rok",
    y = "Populácia krajín") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5, size = 16),
    axis.title = element_text(size = 13),
    axis.text = element_text(size = 11),
    legend.position = "none")

ANOVA

H0: Priemerná populácia krajín sa medzi rokmi nelíši.

H1: Aspoň v jednom roku sa priemerná populácia krajín líši od ostatných rokov.

# ANOVA – testovanie rozdielov priemernej populácie medzi rokmi
anova.result <- aov(population ~ factor(year), data = world_population_long)
summary(anova.result)

               Df    Sum Sq   Mean Sq F value Pr(>F)
factor(year)    8 8.987e+16 1.123e+16   0.831  0.576
Residuals    2097 2.836e+19 1.353e+16               

Výsledky ANOVY (F(8, 2097) = 0.831, p = 0.576) ukazujú, že medzi rokmi neexistujú štatisticky významné rozdiely. To znamená, že vývoj populácie podľa týchto údajov nepreukazuje systematický nárast alebo pokles v jednotlivých rokoch – zmeny možno považovať za náhodné, čím sa nulová hypotéza nezamieta, pretože nie je štatisticky významný dôkaz, že by sa priemerná populácia krajín medzi rokmi líšila.

Linear Regression

Lineárnou regresiou som skúmala vplyv roku, hustoty obyvateľstva a rozlohy krajiny na populáciu krajiny. Výsledky ukazujú, že model je štatisticky významný (F(3, 2102) = 188.3, p < 2.2e-16), čo znamená, že aspoň jedna z premenných má vplyv na populáciu.

Rok je významným prediktorom populácie, pričom každý ďalší rok je spojený s nárastom populácie približne o 355 500 obyvateľov.

Rozloha krajiny je najsilnejším faktorom; väčšie krajiny majú výrazne vyššiu populáciu (každý km² prispieva v priemere o 30 obyvateľov, p < 2e-16).

Hustota obyvateľstva nebola štatisticky významná (p = 0.814), teda podľa tohto modelu nemá významný vplyv na celkovú populáciu.

Model vysvetľuje približne 21 % variability v populácii krajín (R² = 0.2119), čo naznačuje, že existujú aj ďalšie faktory, ktoré ovplyvňujú veľkosť populácie, a ktoré nie sú zahrnuté v tomto modeli.

# Linearna regresia pre populáciu krajiny
model <- lm(population ~ year + `density (km²)` + `area (km²)`, data = world_population_long)

summary(model)

Call:
lm(formula = population ~ year + `density (km²)` + `area (km²)`, 
    data = world_population_long)

Residuals:
       Min         1Q     Median         3Q        Max 
-389069080  -15682655   -8548796     505115 1312368897 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)     -7.024e+08  2.454e+08  -2.862  0.00425 ** 
year             3.555e+05  1.225e+05   2.902  0.00375 ** 
`density (km²)`  2.680e+02  1.142e+03   0.235  0.81447    
`area (km²)`     3.022e+01  1.283e+00  23.556  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 103300000 on 2102 degrees of freedom
Multiple R-squared:  0.2119,    Adjusted R-squared:  0.2107 
F-statistic: 188.3 on 3 and 2102 DF,  p-value: < 2.2e-16

library(broom)
library(dplyr)
library(kableExtra)
library(stringr)
library(scales)  

model <- lm(population ~ year + `density (km²)` + `area (km²)`, data = world_population_long)

# Úprava výstupu a formátovanie
coef.tbl <- tidy(model, conf.int = TRUE) %>%
  mutate(
    term = recode(term,
      "(Intercept)" = "Intercept",
      "year" = "Rok",
      "`density (km²)`" = "Hustota obyvateľstva",
      "`area (km²)`" = "Rozloha"),
    stars = case_when(
      p.value < 0.001 ~ "***",
      p.value < 0.01  ~ "**",
      p.value < 0.05  ~ "*",
      p.value < 0.1   ~ "·",
      TRUE            ~ "." ),
    Estimate = label_comma()(estimate),
    `Std. Error` = label_comma()(std.error),
    `t value` = round(statistic, 2),
    `p value` = round(p.value, 4),
    `95% CI` = str_c("[", label_comma()(round(conf.low, 2)), ", ", label_comma()(round(conf.high, 2)), "]")
  ) %>%
  transmute(
    Premenná = term,
    Odhad = Estimate,
    `Štandardná chyba` = `Std. Error`,
    `t-hodnota` = `t value`,
    `p-hodnota` = `p value`,
    `95% Interval spoľahlivosti` = `95% CI`,
    `Významnosť` = stars
  )

# Pekná tabuľka s hover efektom a bez „e“ zápisu
coef.tbl %>%
  kable(caption = "Regresný model populácie krajín podľa roku, hustoty a rozlohy") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed")) %>%
  column_spec(1, bold = TRUE) %>%
  row_spec(0, bold = TRUE, background = "pink") %>%
  footnote(
    general = "Signif. codes: *** p<0.001, ** p<0.01, * p<0.05, · p<0.1.",
    threeparttable = TRUE)

Regresný model populácie krajín podľa roku, hustoty a rozlohy

Premenná	Odhad	Štandardná chyba	t-hodnota	p-hodnota	95% Interval spoľahlivosti	Významnosť
Intercept	-702,407,686	245,431,087	-2.86	0.0043	[-1,183,720,923, -221,094,449]	**
Rok	355,502	122,505	2.90	0.0037	[115,258, 595,747]	**
Hustota obyvateľstva	268	1,142	0.23	0.8145	[-1,971, 2,507]	.
Rozloha	30	1	23.56	0.0000	[28, 33]	***
Note:
Signif. codes: *** p<0.001, ** p<0.01, * p<0.05, · p<0.1.

fit.tbl <- glance(model) %>%
  transmute(
    `R-squared` = round(r.squared, 3),
    `Adj. R-squared` = round(adj.r.squared, 3),
    `F-statistic` = round(statistic, 2),
    `F p-value` = format.pval(p.value, digits = 3, eps = 0.001),
    `AIC` = round(AIC, 2),
    `BIC` = round(BIC, 2),
    `Počet pozorovaní` = nobs)

fit.tbl %>%
  kable(
    caption = "Ukazovatele kvality regresného modelu populácie krajín") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"))

Ukazovatele kvality regresného modelu populácie krajín

R-squared	Adj. R-squared	F-statistic	F p-value	AIC	BIC	Počet pozorovaní
0.212	0.211	188.34	<0.001	83706.8	83735.06	2106

library(dplyr)
library(ggplot2)
library(tidyr)

num_df <- world_population_data %>% select(where(is.numeric))
print(colnames(num_df))

 [1] "rank"            "2023 population" "2022 population"
 [4] "2020 population" "2015 population" "2010 population"
 [7] "2000 population" "1990 population" "1980 population"
[10] "1970 population" "area (km²)"      "density (km²)"  

cor_mat <- cor(num_df, use = "pairwise.complete.obs")
cor_long <- as.data.frame(as.table(cor_mat))
colnames(cor_long) <- c("Var1", "Var2", "Corr")
ord <- order(colSums(abs(cor_mat)), decreasing = TRUE)
vars_ordered <- colnames(cor_mat)[ord]
cor_long$Var1 <- factor(cor_long$Var1, levels = vars_ordered)
cor_long$Var2 <- factor(cor_long$Var2, levels = rev(vars_ordered)) 

# Vykreslenie heatmapy s hodnotami
ggplot(cor_long, aes(x = Var1, y = Var2, fill = Corr)) +
  geom_tile(color = "white") +
  geom_text(aes(label = round(Corr, 2)), size = 3) +
  scale_fill_gradient2(low = "blue", mid = "white", high = "red", midpoint = 0,
                       limits = c(-1, 1), name = "Pearson r") +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    axis.title = element_blank(),
    panel.grid = element_blank()) +
  labs(title = "Heatmap korelačnej matice (numerické premenné)")

Analýza korelačnej matice ukazuje, že populácia krajín je silne konzistentná medzi jednotlivými rokmi. Rozloha krajiny je stredne pozitívne korelovaná s populáciou, zatiaľ čo hustota obyvateľstva nemá výrazný lineárny vzťah s veľkosťou populácie.