1 1 Úvod

Cieľom práce je spracovať a zhrnúť ekonometrické kroky na reálnych dátach v R (Posit Cloud).
Analyzujem ročné údaje o miere nezamestnanosti (v % pracovnej sily) pre tri krajiny: Czechia, Germany, Slovakia v období 2014–2024.
V práci odhadujem lineárny regresný model, overujem základné predpoklady (heteroskedasticita, multikolinearita, špecifikácia, vplyvné pozorovania) a ako doplnkovú metódu uvádzam zhlukovú analýzu.

2 2 Dáta

Použité dáta sú v súbore une_rt_a__custom_18708117_linear.csv (Eurostat, ročná frekvencia, vek 15–74 rokov, pohlavie Total).

data_path <- "une_rt_a__custom_18708117_linear.csv"
raw <- read.csv(data_path, check.names = FALSE, stringsAsFactors = FALSE)

d <- subset(
  raw,
  freq == "Annual" &
    age == "From 15 to 74 years" &
    sex == "Total" &
    geo %in% c("Czechia", "Germany", "Slovakia")
)

d$TIME_PERIOD <- as.integer(d$TIME_PERIOD)
d$OBS_VALUE <- as.numeric(d$OBS_VALUE)
d <- d[order(d$TIME_PERIOD, d$geo), ]

wide <- reshape(
  d[, c("TIME_PERIOD", "geo", "OBS_VALUE")],
  idvar = "TIME_PERIOD",
  timevar = "geo",
  direction = "wide"
)

names(wide) <- gsub("^OBS_VALUE\\.", "", names(wide))
names(wide)[names(wide) == "TIME_PERIOD"] <- "Year"
wide <- wide[order(wide$Year), ]
row.names(wide) <- NULL

wide$t <- wide$Year - min(wide$Year)
wide$D_break <- as.integer(wide$Year >= 2020)

knitr::kable(head(wide, 11), digits = 2, caption = "Dáta v širokom tvare (2014–2024)")
Dáta v širokom tvare (2014–2024)
Year Czechia Germany Slovakia t D_break
2014 6.1 4.7 13.1 0 0
2015 5.1 4.4 11.5 1 0
2016 4.0 3.9 9.6 2 0
2017 2.9 3.5 8.1 3 0
2018 2.2 3.2 6.5 4 0
2019 2.0 2.9 5.7 5 0
2020 2.6 3.6 6.7 6 1
2021 2.8 3.6 6.8 7 1
2022 2.2 3.1 6.1 8 1
2023 2.6 3.1 5.8 9 1
2024 2.6 3.4 5.3 10 1

Komentár:
Najprv som načítala export Eurostatu a prefiltrovala ho na ročné údaje pre vek 15–74 (Total) a krajiny Czechia, Germany, Slovakia. Následne som dáta prehodila do „wide“ tvaru, aby bol každý rok jeden riadok a každá krajina samostatný stĺpec. Pridala som časový trend t a dummy premennú D_break od roku 2020, aby som vedela lineárne zachytiť možný zlom.

2.1 2.1 Deskriptívne štatistiky

countries <- c("Czechia", "Germany", "Slovakia")

desc <- data.frame(
  Krajina = countries,
  n = sapply(countries, function(v) sum(!is.na(wide[[v]]))),
  priemer = sapply(countries, function(v) mean(wide[[v]], na.rm = TRUE)),
  sd = sapply(countries, function(v) sd(wide[[v]], na.rm = TRUE)),
  minimum = sapply(countries, function(v) min(wide[[v]], na.rm = TRUE)),
  maximum = sapply(countries, function(v) max(wide[[v]], na.rm = TRUE))
)

knitr::kable(desc, digits = 2, caption = "Deskriptívne štatistiky miery nezamestnanosti (%)")
Deskriptívne štatistiky miery nezamestnanosti (%)
Krajina n priemer sd minimum maximum
Czechia Czechia 11 3.19 1.32 2.0 6.1
Germany Germany 11 3.58 0.56 2.9 4.7
Slovakia Slovakia 11 7.75 2.58 5.3 13.1

Komentár:
Deskriptívne štatistiky mi dávajú prvý prehľad o úrovni a variabilite nezamestnanosti v jednotlivých krajinách. Vidím priemery, smerodajné odchýlky aj extrémy, čo je dôležité pred tým, než začnem modelovať.

3 3 Prieskum dát

3.1 3.1 Vývoj v čase

matplot(
  wide$Year,
  cbind(wide$Czechia, wide$Germany, wide$Slovakia),
  type = "l",
  lty = 1,
  lwd = 2,
  col = unname(cols_countries),
  xlab = "Rok",
  ylab = "Nezamestnanosť (%)",
  main = "Miera nezamestnanosti (2014–2024): Czechia, Germany, Slovakia"
)
legend("topright",
       legend = names(cols_countries),
       col = unname(cols_countries),
       lty = 1,
       lwd = 2,
       bty = "n")
abline(v = 2020, lty = 2, col = "gray40")
mtext("Prerušovaná čiara = rok 2020", side = 3, line = 0.2, cex = 0.85, col = "gray40")

Komentár:
Graf ukazuje vývoj nezamestnanosti v čase pre všetky tri krajiny. Prerušovanou čiarou som vyznačila rok 2020, ktorý beriem ako jednoduchý bod zlomu (zmena podmienok na trhu práce). Táto vizualizácia je dôležitá aj pre rozhodnutie, či má zmysel do modelu pridať dummy premennú.

3.2 3.2 Boxplot

boxplot(
  list(
    Czechia = wide$Czechia,
    Germany = wide$Germany,
    Slovakia = wide$Slovakia
  ),
  col = unname(cols_countries),
  border = "gray30",
  ylab = "Nezamestnanosť (%)",
  main = "Boxplot miery nezamestnanosti (2014–2024)"
)

Komentár:
Boxplot porovnáva rozdelenie nezamestnanosti medzi krajinami. Vidím medián, rozptyl (IQR) a prípadné odľahlé hodnoty. Je to rýchly spôsob, ako posúdiť, ktorá krajina má stabilnejší vývoj a ktorá väčšie výkyvy.

3.3 3.3 Korelačná matica (tabuľka) + heatmap

num_vars <- wide[, c("Czechia","Germany","Slovakia","t","D_break")]
C <- cor(num_vars, use = "complete.obs")
knitr::kable(round(C, 3), caption = "Korelačná matica numerických veličín")
Korelačná matica numerických veličín
Czechia Germany Slovakia t D_break
Czechia 1.000 0.965 0.970 -0.747 -0.458
Germany 0.965 1.000 0.944 -0.727 -0.379
Slovakia 0.970 0.944 1.000 -0.873 -0.596
t -0.747 -0.727 -0.873 1.000 0.866
D_break -0.458 -0.379 -0.596 0.866 1.000 
pal <- colorRampPalette(c("#2166ac", "white", "#b2182b"))(200)

layout(matrix(c(1,2), 1, 2), widths = c(4, 1))

par(mar = c(6, 6, 3, 1))
image(
  x = 1:ncol(C),
  y = 1:nrow(C),
  z = t(C)[, nrow(C):1],
  col = pal,
  zlim = c(-1, 1),
  axes = FALSE,
  main = "Heatmap korelačnej matice"
)
axis(1, at = 1:ncol(C), labels = colnames(C), las = 2)
axis(2, at = 1:nrow(C), labels = rev(rownames(C)), las = 2)
box()

for (i in 1:nrow(C)) {
  for (j in 1:ncol(C)) {
    text(j, nrow(C) - i + 1, labels = sprintf("%.2f", C[i, j]), cex = 0.9)
  }
}

par(mar = c(6, 2, 3, 4))
y_leg <- seq(-1, 1, length.out = 200)
z_leg <- matrix(y_leg, nrow = 1)

image(
  x = 1,
  y = y_leg,
  z = z_leg,
  col = pal,
  axes = FALSE,
  xlab = "",
  ylab = ""
)
axis(4, at = seq(-1, 1, by = 0.5), las = 2)
mtext("korelácia", side = 4, line = 2)

layout(1)
par(mar = c(5, 4, 4, 2) + 0.1)

Komentár:
Korelačná matica ukazuje lineárnu závislosť medzi numerickými premennými. Heatmapa mi pomáha rýchlo identifikovať silné pozitívne a negatívne korelácie. Zároveň je to prvá kontrola možnej multikolinearity (ak by boli regresory medzi sebou príliš silno korelované).

3.4 3.4 Medziročné zmeny (p. b.)

yoy <- data.frame(
  Year = wide$Year[-1],
  Czechia_pp = diff(wide$Czechia),
  Germany_pp = diff(wide$Germany),
  Slovakia_pp = diff(wide$Slovakia)
)
knitr::kable(yoy, digits = 2, caption = "Medziročné zmeny nezamestnanosti (v percentuálnych bodoch)")
Medziročné zmeny nezamestnanosti (v percentuálnych bodoch)
Year Czechia_pp Germany_pp Slovakia_pp
2015 -1.0 -0.3 -1.6
2016 -1.1 -0.5 -1.9
2017 -1.1 -0.4 -1.5
2018 -0.7 -0.3 -1.6
2019 -0.2 -0.3 -0.8
2020 0.6 0.7 1.0
2021 0.2 0.0 0.1
2022 -0.6 -0.5 -0.7
2023 0.4 0.0 -0.3
2024 0.0 0.3 -0.5

Komentár:
Medziročné zmeny (v percentuálnych bodoch) ukazujú, kedy boli v jednotlivých krajinách najvýraznejšie skoky. Pomáha mi to interpretovať „šoky“ v dátach a lepšie chápať, prečo môže byť vhodné uvažovať o zlome.

4 4 Regresný model

Ako závislú premennú volím nezamestnanosť na Slovensku. Vysvetľujúce premenné sú nezamestnanosť v Nemecku a Česku a časový trend. Zároveň dopĺňam dummy premennú D_break (od roku 2020), ktorá predstavuje jednoduchú lineárnu kvantifikáciu možného zlomu v úrovni.

m0 <- lm(Slovakia ~ Germany + Czechia + t, data = wide)
m1 <- lm(Slovakia ~ Germany + Czechia + t + D_break, data = wide)

summary(m1)
## 
## Call:
## lm(formula = Slovakia ~ Germany + Czechia + t + D_break, data = wide)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.24844 -0.08361 -0.01078  0.04232  0.34312 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)  6.83788    1.95448   3.499  0.01285 * 
## Germany     -0.55902    0.68183  -0.820  0.44363   
## Czechia      1.46797    0.24881   5.900  0.00105 **
## t           -0.44194    0.09392  -4.705  0.00331 **
## D_break      0.95797    0.46306   2.069  0.08403 . 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.2394 on 6 degrees of freedom
## Multiple R-squared:  0.9948, Adjusted R-squared:  0.9914 
## F-statistic: 288.6 on 4 and 6 DF,  p-value: 5.507e-07

Komentár:
Najprv odhadujem základný model bez zlomu (m0) a následne model so zlomom (m1). Model m1 umožní zachytiť posun úrovne nezamestnanosti na Slovensku po roku 2020, pričom zároveň kontrolujem vplyv Nemecka, Česka a trendu v čase.

4.1 4.1 Porovnanie modelov (prínos dummy)

anova_tab <- anova(m0, m1)
knitr::kable(anova_tab, digits = 4, caption = "Porovnanie m0 vs. m1 (prínos dummy D_break)")
Porovnanie m0 vs. m1 (prínos dummy D_break)
Res.Df RSS Df Sum of Sq F Pr(>F)
7 0.5893 NA NA NA NA
6 0.3440 1 0.2453 4.2799 0.084

Komentár:
Porovnanie m0 a m1 (ANOVA) mi povie, či pridanie dummy premennej významne zlepšuje model. Ak áno, znamená to, že zlom od roku 2020 má v dátach zmysel a je vhodné ho v modeli ponechať.

4.2 4.2 Graf na regresiu: skutočné vs. predikované (m1)

wide$pred_m1 <- predict(m1)

plot(
  wide$Year, wide$Slovakia,
  type = "b", pch = 16,
  col = col_sk,
  xlab = "Rok", ylab = "Nezamestnanosť Slovakia (%)",
  main = "Skutočné vs. predikované hodnoty (m1)"
)
lines(wide$Year, wide$pred_m1, lty = 2, lwd = 2, col = col_sk)

legend(
  "topright",
  legend = c("Skutočné (Slovakia)", "Predikované (m1)"),
  col = c(col_sk, col_sk),
  lty = c(1, 2),
  pch = c(16, NA),
  lwd = c(1, 2),
  bty = "n"
)

Komentár:
Graf porovnáva skutočné hodnoty nezamestnanosti na Slovensku s predikciami modelu m1. Ak sa krivky približne prekrývajú, model má dobrú schopnosť približne opisovať dáta. Výrazné odchýlky môžu signalizovať, že model niečo nezachytáva (napr. nelinearitu alebo iné faktory).

4.3 4.3 Graf na regresiu: Slovakia vs Germany / Czechia (farby podľa obdobia)

grp <- ifelse(wide$D_break == 1, "Od 2020", "Pred 2020")
cols_pts <- cols_period[grp]

par(mfrow = c(1, 2))

plot(
  wide$Germany, wide$Slovakia,
  pch = 16, col = cols_pts,
  xlab = "Germany (%)", ylab = "Slovakia (%)",
  main = "Slovakia vs Germany"
)
abline(lm(Slovakia ~ Germany, data = wide), lwd = 2, col = "gray20")
legend("topleft", legend = names(cols_period), col = unname(cols_period), pch = 16, bty = "n")

plot(
  wide$Czechia, wide$Slovakia,
  pch = 16, col = cols_pts,
  xlab = "Czechia (%)", ylab = "Slovakia (%)",
  main = "Slovakia vs Czechia"
)
abline(lm(Slovakia ~ Czechia, data = wide), lwd = 2, col = "gray20")
legend("topleft", legend = names(cols_period), col = unname(cols_period), pch = 16, bty = "n")

par(mfrow = c(1, 1))

Komentár:
Scatter grafy ukazujú vzťah Slovenska s Nemeckom a Českom, pričom body sú farebne rozlíšené podľa obdobia pred/od roku 2020. Takto sa dá vizuálne posúdiť, či sa vzťah po roku 2020 zmenil a či dáva zmysel pracovať so zlomovou premennou.

5 5 Diagnostika rezíduí

par(mfrow = c(2,2))
plot(m1)

par(mfrow = c(1,1))

Komentár:
Diagnostické grafy sú základná kontrola predpokladov lineárneho modelu: (1) rezíduá vs fitted pre variabilitu a prípadnú heteroskedasticitu, (2) Q-Q plot pre normalitu rezíduí, (3) Scale-Location pre rozptyl rezíduí, (4) Cookova vzdialenosť pre vplyvné pozorovania. Pri malom počte rokov beriem grafy ako orientačné a interpretujem ich spolu s testami.

6 6 Heteroskedasticita

6.1 6.1 Diagnostika rezíduí – rezíduá vs fitted

plot(
  fitted(m1), resid(m1),
  pch = 16, col = "gray35",
  xlab = "Fitted hodnoty",
  ylab = "Rezíduá",
  main = "Diagnostika heteroskedasticity: Rezíduá vs fitted"
)
abline(h = 0, lty = 2, col = "gray40")
lines(lowess(fitted(m1), resid(m1)), lwd = 2, col = col_sk)
legend("topright", legend = c("LOWESS"), col = c(col_sk), lwd = 2, bty = "n")

Komentár:
Ak sa rozptyl rezíduí mení s úrovňou fitted hodnôt (napr. lievikovitý tvar), môže ísť o heteroskedasticitu. LOWESS krivka pomáha vidieť systematický vzor v rezíduách.

6.2 6.2 Breusch–Pagan test

lmtest::bptest(m1)
## 
##  studentized Breusch-Pagan test
## 
## data:  m1
## BP = 4.7529, df = 4, p-value = 0.3136

Komentár:
Breusch–Pagan test formálne testuje, či je rozptyl rezíduí konštantný. Pri p-hodnote nižšej než 0.05 by som heteroskedasticitu považovala za prítomnú.

6.3 6.3 Robustné štandardné chyby (HC1)

lmtest::coeftest(m1, vcov. = sandwich::vcovHC(m1, type = "HC1"))
## 
## t test of coefficients:
## 
##              Estimate Std. Error t value  Pr(>|t|)    
## (Intercept)  6.837878   1.856966  3.6823 0.0103027 *  
## Germany     -0.559017   0.656813 -0.8511 0.4273666    
## Czechia      1.467966   0.234331  6.2645 0.0007682 ***
## t           -0.441943   0.080514 -5.4891 0.0015304 ** 
## D_break      0.957969   0.490066  1.9548 0.0984055 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Komentár:
Robustné štandardné chyby poskytujú konzistentné odhady variability aj v prípade heteroskedasticity. Koeficienty sa nemenia, menia sa štandardné chyby a tým aj t-testy/p-hodnoty.

7 7 Multikolinearita

7.1 7.1 Korelačná matica regresorov

X <- wide[, c("Germany", "Czechia", "t", "D_break")]
knitr::kable(round(cor(X), 3), caption = "Korelačná matica regresorov")
Korelačná matica regresorov
Germany Czechia t D_break
Germany 1.000 0.965 -0.727 -0.379
Czechia 0.965 1.000 -0.747 -0.458
t -0.727 -0.747 1.000 0.866
D_break -0.379 -0.458 0.866 1.000

Komentár:
Silné korelácie medzi regresormi môžu spôsobovať multikolinearitu, ktorá vedie k nestabilným odhadom koeficientov (väčšie štandardné chyby a horšia interpretácia).

7.2 7.2 VIF (Variance Inflation Factor)

vif_manual <- function(model){
  X <- model.matrix(model)
  X <- X[, colnames(X) != "(Intercept)", drop = FALSE]
  vifs <- sapply(seq_len(ncol(X)), function(j){
    yj <- X[, j]
    xj <- X[, -j, drop = FALSE]
    r2 <- summary(lm(yj ~ xj))$r.squared
    1/(1-r2)
  })
  data.frame(Premenná = colnames(X), VIF = as.numeric(vifs))
}

knitr::kable(vif_manual(m1), digits = 3, caption = "VIF – kontrola multikolinearity")
VIF – kontrola multikolinearity
Premenná VIF
Germany 25.435
Czechia 18.821
t 16.927
D_break 10.201

Komentár:
VIF ukazuje, o koľko sa „nafukuje“ variancia odhadu koeficientu kvôli koreláciám s ostatnými regresormi. Vyššie hodnoty znamenajú vyšší problém s multikolinearitou.

8 8 Špecifikácia modelu

8.1 8.1 RESET test

lmtest::resettest(m1, power = 2:3, type = "fitted")
## 
##  RESET test
## 
## data:  m1
## RESET = 0.089311, df1 = 2, df2 = 4, p-value = 0.9163

Komentár:
RESET test orientačne kontroluje, či model nie je nesprávne špecifikovaný (napr. chýbajú nelineárne členy). Interpretujem ho spolu s grafmi, keďže vzorka je malá.

8.2 8.2 C+R grafy (component + residual)

Pri C+R grafoch môžu byť pozorovateľné odklony od priamky. Preto je v modeli zahrnutá aj dummy premenná (D_break) ako jednoduchá lineárna kvantifikácia zlomu od roku 2020.

cr_plot <- function(model, xname, col_line = "gray20", col_smooth = col_sk) {
  b <- coef(model)[xname]
  x <- model$model[[xname]]
  pr <- residuals(model) + b * x

  plot(
    x, pr,
    pch = 16, col = "gray35",
    xlab = xname,
    ylab = "Component + Residual",
    main = paste("C+R graf:", xname)
  )
  abline(lm(pr ~ x), lwd = 2, col = col_line)
  lines(lowess(x, pr), lwd = 2, col = col_smooth)
  legend("topleft", legend = c("Lineárny trend", "LOWESS"), col = c(col_line, col_smooth), lwd = 2, bty = "n")
}

par(mfrow = c(2,2))
cr_plot(m1, "Germany")
cr_plot(m1, "Czechia")
cr_plot(m1, "t")
cr_plot(m1, "D_break")

par(mfrow = c(1,1))

Komentár:
C+R grafy kombinujú čiastkový (lineárny) efekt regresora a rezíduá. Ak LOWESS krivka viditeľne odbieha od priamky, môže to naznačovať nelinearitu alebo štrukturálnu zmenu. V tomto prípade odklony pozorujem, a preto som použila dummy premennú ako lineárnu kvantifikáciu zlomu.

9 9 Vplyvné pozorovania

cd <- cooks.distance(m1)

plot(
  cd, type = "h", lwd = 2,
  xlab = "Pozorovanie (index)", ylab = "Cookova vzdialenosť",
  main = "Cookova vzdialenosť (m1)",
  col = "gray35"
)
abline(h = 4/length(cd), lty = 2, col = col_sk)

infl <- which(cd > 4/length(cd))
infl_tab <- data.frame(
  Index = infl,
  Year = wide$Year[infl],
  CookD = cd[infl]
)

if (length(infl) == 0) {
  cat("Neboli identifikované výrazne vplyvné pozorovania podľa pravidla 4/n.\n")
} else {
  knitr::kable(infl_tab, digits = 4, caption = "Vplyvné pozorovania podľa Cookovej vzdialenosti")
}
Vplyvné pozorovania podľa Cookovej vzdialenosti
Index Year CookD
7 7 2020 0.7812
9 9 2022 0.4201

Komentár:
Cookova vzdialenosť ukazuje, či niektoré pozorovanie výrazne ovplyvňuje odhad modelu. Ak sa vplyvné pozorovanie objaví, je vhodné ho bližšie skontrolovať a interpretovať, prečo je odlišné.

10 10 Zhluková analýza (prierezové údaje – rok 2024)

V tejto časti vytvorím prierezový dataset pre rok 2024 a vykonám hierarchické zhlukovanie (Ward.D2): výber prierezu, štandardizácia, vzdialenosti, dendrogram, priradenie klastrov a rozklad variability (TSS, WSS, BSS).

d2024 <- wide[wide$Year == 2024, c("Czechia", "Germany", "Slovakia")]
x <- as.numeric(d2024[1, ])
names(x) <- colnames(d2024)

udaje <- data.frame(Unemployment = x)
row.names(udaje) <- names(x)

knitr::kable(udaje, digits = 1, caption = "Prierezové údaje – nezamestnanosť v roku 2024 (%)")
Prierezové údaje – nezamestnanosť v roku 2024 (%)
Unemployment
Czechia 2.6
Germany 3.4
Slovakia 5.3

Komentár:
Z pôvodného časového datasetu som vybrala iba rok 2024, čím vznikli prierezové údaje (jedna hodnota na krajinu). Takto viem krajiny porovnať a rozdeliť do klastrov podľa podobnosti.

udaje_scaled <- scale(udaje)
dist_mat <- dist(udaje_scaled)

hc <- hclust(dist_mat, method = "ward.D2")

plot(
  hc,
  main = "Hierarchické zhlukovanie krajín podľa miery nezamestnanosti (Ward.D2)",
  xlab = "",
  sub = ""
)

k <- 2
rect.hclust(hc, k = k, border = "gray40")

Komentár:
Najprv som údaje štandardizovala, aby zhlukovanie nebolo ovplyvnené mierkou. Následne som spočítala vzdialenosti a použila Wardovu metódu, ktorá minimalizuje vnútroklastrovú variabilitu. Dendrogram ukazuje, ktoré krajiny sú si najbližšie.

klaster_membership <- cutree(hc, k = k)
klaster_tab <- data.frame(
  Krajina = row.names(udaje),
  Nezamestnanosť = as.numeric(udaje$Unemployment),
  Klaster = as.integer(klaster_membership),
  row.names = NULL
)

knitr::kable(klaster_tab, digits = 2, caption = "Priradenie krajín do klastrov (k = 2)")
Priradenie krajín do klastrov (k = 2)
Krajina Nezamestnanosť Klaster
Czechia 2.6 1
Germany 3.4 1
Slovakia 5.3 2

Komentár:
Tabuľka ukazuje výsledné priradenie krajín do klastrov. Pri k = 2 je výsledok interpretovateľný ako rozdelenie na krajiny s nižšou vs. vyššou nezamestnanosťou v roku 2024.

descriptives <- aggregate(
  udaje$Unemployment,
  by = list(klaster = klaster_membership),
  FUN = function(z) c(n = length(z), mean = mean(z), sd = sd(z), min = min(z), max = max(z))
)

descriptives <- data.frame(
  klaster = descriptives$klaster,
  n = descriptives$x[, "n"],
  mean_unemp = descriptives$x[, "mean"],
  sd_unemp = descriptives$x[, "sd"],
  min_unemp = descriptives$x[, "min"],
  max_unemp = descriptives$x[, "max"]
)

knitr::kable(descriptives, digits = 2, caption = "Deskriptívne štatistiky miery nezamestnanosti podľa klastrov")
Deskriptívne štatistiky miery nezamestnanosti podľa klastrov
klaster n mean_unemp sd_unemp min_unemp max_unemp
1 2 3.0 0.57 2.6 3.4
2 1 5.3 NA 5.3 5.3

Komentár:
Deskriptívne štatistiky klastrov mi pomáhajú interpretovať, čím sa skupiny líšia. Vidím priemernú nezamestnanosť v klastri a rozptyl.

ssq <- function(x, m) sum((x - m)^2)

var_names <- colnames(udaje_scaled)

TSS <- sapply(var_names, function(v) {
  ssq(udaje_scaled[, v], mean(udaje_scaled[, v]))
})

WSS <- sapply(var_names, function(v) {
  x <- udaje_scaled[, v]
  sum(tapply(x, klaster_membership, function(z) ssq(z, mean(z))))
})

BSS <- TSS - WSS

variab_tab <- data.frame(
  Variable = var_names,
  TSS = TSS,
  WSS = WSS,
  BSS = BSS,
  BSS_over_TSS = BSS / TSS
)

knitr::kable(variab_tab, digits = 3, caption = "Rozklad variability (TSS, WSS, BSS) pre mieru nezamestnanosti")
Rozklad variability (TSS, WSS, BSS) pre mieru nezamestnanosti
Variable TSS WSS BSS BSS_over_TSS
Unemployment Unemployment 2 0.166 1.834 0.917

Komentár:
Rozklad variability (TSS, WSS, BSS) ukazuje, koľko variability vysvetľuje rozdelenie do klastrov. Pomer BSS/TSS vyjadruje, aký podiel celkovej variability je „medzi klastrami“.

11 11 Záver

Na ročných údajoch o miere nezamestnanosti (2014–2024) pre Czechia, Germany a Slovakia som vykonala popis dát (trend, boxplot, korelácie vrátane heatmap) a odhadla regresný model, kde bola závislá premenná nezamestnanosť na Slovensku a vysvetľujúce premenné boli nezamestnanosť v Nemecku a Česku, časový trend a dummy premenná D_break od roku 2020.

Model som skontrolovala pomocou diagnostických grafov a štandardných testov: heteroskedasticita (graf rezíduí + Breusch–Pagan + robustné štandardné chyby), multikolinearita (korelácie a VIF), špecifikácia (RESET), vplyvné pozorovania (Cookova vzdialenosť) a C+R grafy.
Ako doplnkovú metódu som spracovala zhlukovú analýzu prierezových údajov pre rok 2024 pomocou Wardovej metódy a vyhodnotila klastry aj rozklad variability (TSS, WSS, BSS).

12 12 Zdroje

  • Eurostat: dataset UNE_RT_A (ročné údaje o miere nezamestnanosti; export do CSV)
  • R: použité balíčky v práci (lmtest, sandwich)