Úloha_6

Analýza makroekonomických ukazovateľov

Úvod do problému, stanovenie hypotéz

Rozhodla som sa modelovať hodnotu akciového indexu (Stock Index Value) v závislosti od makroekonomických premenných: inflácie (Inflation Rate (%)), rastu HDP (GDP Growth Rate (%)), nezamestnanosti (Unemployment Rate (%)), a úrokovej sadzby (Interest Rate (%)).

Pracovná hypotéza predpokladá:

• Inflation Rate (%) – negatívny vplyv na akciový index.

• GDP Growth Rate (%) – pozitívny vplyv.

• Unemployment Rate (%) – negatívny vplyv.

• Interest Rate (%) – negatívny vplyv.

Cieľom analýzy je overiť, ktoré premenné štatisticky významne ovplyvňujú Stock Index Value a posúdiť vhodnosť lineárneho regresného modelu.

Načítanie knižníc

library(zoo)
library(tseries)
library(lmtest)
library(sandwich)
library(car)
library(carData)
library(cowplot)
library(ggplot2)
rm(list=ls())

Načitanie dát

data <- read.csv("economic_indicators_dataset_2010_2023.csv")

Výber premennych

macro <- data[, c("Inflation.Rate....",
                  "GDP.Growth.Rate....",
                  "Unemployment.Rate....",
                  "Interest.Rate....",
                  "Stock.Index.Value")]

summary(macro)

 Inflation.Rate.... GDP.Growth.Rate.... Unemployment.Rate.... Interest.Rate.... Stock.Index.Value
 Min.   :0.000      Min.   :-5.000      Min.   : 2.000        Min.   :-0.980    Min.   : 1017    
 1st Qu.:2.525      1st Qu.:-1.170      1st Qu.: 4.258        1st Qu.: 2.027    1st Qu.:11588    
 Median :5.205      Median : 2.580      Median : 6.865        Median : 4.975    Median :20996    
 Mean   :5.085      Mean   : 2.415      Mean   : 6.907        Mean   : 4.698    Mean   :20926    
 3rd Qu.:7.710      3rd Qu.: 5.445      3rd Qu.: 9.502        3rd Qu.: 7.353    3rd Qu.:30825    
 Max.   :9.990      Max.   : 9.930      Max.   :11.970        Max.   :10.000    Max.   :39982    

Imputácia mediánov

column_medians <- sapply(macro, median, na.rm = TRUE)

macro_imp <- macro
for (col in names(macro)) {
  macro_imp[[col]][is.na(macro_imp[[col]])] <- column_medians[col]
}

macro <- macro_imp

Boxploty

num_plots <- length(names(macro))
par(mfrow = c(2, 3))
par(mar = c(4, 4, 2, 1))

for (col in names(macro)) {
  boxplot(macro[[col]], main = col, xlab = "Hodnota", col = "lightblue")
}

mtext("Boxploty makroekonomických premenných", outer = TRUE, cex = 1.4, font = 2)

par(mfrow = c(1, 1))

Teraz sme:

• Skontrolovali štruktúru dát.

• Vybrali relevantné premenné.

• Doplnili chýbajúce hodnoty mediánmi.

• Vykreslili boxploty pre jednotlivé premenné, aby sme identifikovali potenciálne odľahlé hodnoty.

Pozorovania ukázali, že väčšina dát je v očakávanom rozsahu. Inflácia a úroková sadzba majú mierne rozšírené rozptýlenie, ale nie je extrémne.

Lineárna regresia – model 1

model <- lm(Stock.Index.Value ~ Inflation.Rate.... +
              GDP.Growth.Rate.... +
              Unemployment.Rate.... +
              Interest.Rate....,
            data = macro)

summary(model)

Call:
lm(formula = Stock.Index.Value ~ Inflation.Rate.... + GDP.Growth.Rate.... + 
    Unemployment.Rate.... + Interest.Rate...., data = macro)

Residuals:
     Min       1Q   Median       3Q      Max 
-20623.1  -9434.3    104.2   9972.6  19610.5 

Coefficients:
                      Estimate Std. Error t value Pr(>|t|)    
(Intercept)           23055.78    1678.73  13.734   <2e-16 ***
Inflation.Rate....      -37.23     167.90  -0.222    0.825    
GDP.Growth.Rate....     -26.39     121.94  -0.216    0.829    
Unemployment.Rate....  -152.38     166.52  -0.915    0.361    
Interest.Rate....      -175.40     157.57  -1.113    0.266    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11090 on 495 degrees of freedom
Multiple R-squared:  0.00455,   Adjusted R-squared:  -0.003494 
F-statistic: 0.5656 on 4 and 495 DF,  p-value: 0.6877

Lineárny model odhadovaný pre Stock Index Value na základe premenných Inflation Rate, GDP Growth Rate, Unemployment Rate a Interest Rate ukazuje, že žiadna z vysvetľujúcich premenných nie je štatisticky významná. Intercept je vysoko významný, ale všetky koeficienty ostatných premenných majú p-hodnoty výrazne vyššie ako 0,05. Hodnota R-squared je extrémne nízka (0,00455), čo naznačuje, že model nevysvetľuje variabilitu Stock Index Value.

Reziduá modelu sa pohybujú približne medzi −20623 a +19610 a ich medián je veľmi blízko nule, čo naznačuje stredné centrovanie reziduí.

Diagnostické grafy pre model 1

par(mfrow = c(2, 2))
plot(model)
mtext("Diagnostické grafy regresného modelu", outer = TRUE, cex = 1.2, font = 2)

par(mfrow = c(1, 1))

Residuals vs Fitted

• Väčšina reziduí je rozptýlená okolo nuly bez výrazného systematického skreslenia, aj keď vidíme niektoré extrémne body.

Q-Q plot

• Reziduá sú približne normálne rozložené, hoci na okrajoch grafu možno pozorovať mierne odchýlky – niekoľko extrémnych hodnôt.

Scale-Location

• Variancia reziduí je relatívne stabilná; nie sú výrazné známky heteroskedasticity.

Residuals vs Leverage

• Väčšina bodov má nízku páku a štandardizované reziduá sa pohybujú medzi −2 a +2. Žiadne pozorovanie nevybočuje výrazne z Cookovej vzdialenosti.

Jarque–Bera test normality

residuals_model <- residuals(model)
jb_test <- jarque.bera.test(residuals_model)
jb_test

    Jarque Bera Test

data:  residuals_model
X-squared = 26.622, df = 2, p-value = 1.656e-06

Hodnota testu JB = 26,622 s p-hodnotou 1,656e-06 naznačuje, že reziduá nie sú úplne normálne rozložené. Odchýlky môžu byť spôsobené extrémnymi hodnotami alebo špičatými rozdeleniami.

Outlier test

outlier_test <- outlierTest(model)
outlier_test

No Studentized residuals with Bonferroni p < 0.05
Largest |rstudent|:

Jedno pozorovanie bolo označené ako potenciálny odľahlý bod (rstudent = −1,8766), ale p-hodnota po Bonferroni korekcii nie je k dispozícii. Tento bod môže mierne ovplyvniť odhad koeficientov.

Heteroskedasticita – grafy pre model 1

p1 <- ggplot(macro, aes(x = GDP.Growth.Rate...., y = resid(model)^2)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "GDP Growth (%)",
       y = "Reziduá²",
       title = "Reziduá² vs GDP Growth") +
  theme_minimal()

p2 <- ggplot(macro, aes(x = Inflation.Rate...., y = resid(model)^2)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "Inflation Rate (%)",
       y = "Reziduá²",
       title = "Reziduá² vs Inflation") +
  theme_minimal()

plot_grid(p1, p2)

Na grafoch “Reziduá vs GDP Growth” a “Reziduá vs Inflation” môžeme pozorovať, že ružová vyhladená krivka zostáva relatívne plochá a rozptyl reziduí sa s hodnotami premenných výrazne nemení. Menšie kolísanie naznačuje len slabé náznaky heteroskedasticity, ktoré však nie sú výrazné. Celkovo možno teda usúdiť, že v modeli sa heteroskedasticita výrazne nevyskytuje a rozptyl náhodnej zložky zostáva približne konštantný.

Oprava modelu (model 2) + vylúčenie problem

shift <- abs(min(macro$GDP.Growth.Rate...., na.rm = TRUE)) + 0.01

model2 <- lm(Stock.Index.Value ~
               I(log(GDP.Growth.Rate.... + shift)) +
               Unemployment.Rate.... +
               Interest.Rate....,
             data = macro)

summary(model2)

Call:
lm(formula = Stock.Index.Value ~ I(log(GDP.Growth.Rate.... + 
    shift)) + Unemployment.Rate.... + Interest.Rate...., data = macro)

Residuals:
     Min       1Q   Median       3Q      Max 
-20968.9  -9345.4    -62.7   9908.4  19840.0 

Coefficients:
                                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)                          23669.9     1683.6  14.059   <2e-16 ***
I(log(GDP.Growth.Rate.... + shift))   -517.9      533.4  -0.971    0.332    
Unemployment.Rate....                 -148.3      166.2  -0.892    0.373    
Interest.Rate....                     -174.3      157.2  -1.109    0.268    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11060 on 496 degrees of freedom
Multiple R-squared:  0.006244,  Adjusted R-squared:  0.0002336 
F-statistic: 1.039 on 3 and 496 DF,  p-value: 0.375

Po logaritmickej transformácii GDP Growth Rate a odstránení Inflation Rate model ukazuje podobný obraz: žiadna z premenných (okrem interceptu) nie je štatisticky významná. Koeficienty sú stále nízke a p-hodnoty vyššie než 0,05. R-squared je veľmi nízke (0,0062), čo znamená, že model stále nevysvetľuje variabilitu Stock Index Value.

Reziduá sú podobne rozptýlené a medián je blízko nuly.

Diagnostické grafy pre model 2

par(mfrow = c(2, 2))
plot(model2)
mtext("Diagnostické grafy - Model 2 (log GDP)", outer = TRUE, cex = 1.2, font = 2)

par(mfrow = c(1, 1))

Residuals vs Fitted

• Podobne ako pri model 1, reziduá sú rozptýlené okolo nuly, bez výrazných systematických odchýlok.

Q-Q plot

• Reziduá sú približne normálne rozložené, mierne odchýlky na okrajoch.

Scale-Location

• Variancia reziduí je stabilná, nenaznačuje heteroskedasticitu.

Residuals vs Leverage

• Väčšina bodov má nízku páku, žiadne výrazne ovplyvňujúce pozorovanie.

Heteroskedasticita – grafy pre model 2

p3 <- ggplot(macro, aes(x = log(GDP.Growth.Rate.... + 1), y = resid(model2)^2)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "log(GDP Growth)",
       y = "Reziduá²",
       title = "Reziduá² vs log(GDP Growth)") +
  theme_minimal()

p4 <- ggplot(macro, aes(x = Unemployment.Rate...., y = resid(model2)^2)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "loess", se = FALSE, color = "red") +
  labs(x = "Unemployment Rate (%)",
       y = "Reziduá²",
       title = "Reziduá² vs Unemployment") +
  theme_minimal()

plot_grid(p3, p4)

Po logaritmickej transformácii premennej GDP Growth sa ružová krivka vyrovnala a rozptyl reziduí sa stal rovnomernejším, čo naznačuje, že transformácia znížila heteroskedasticitu. Premenná Unemployment Rate nevykazuje viditeľné známky heteroskedasticity, takže celkovo možno povedať, že nový model má stabilnejší rozptyl reziduí a lepšiu štruktúru ako pôvodný.

Breusch-Pagan test pre model 1 aj model 2

bptest(model)

    studentized Breusch-Pagan test

data:  model
BP = 2.9462, df = 4, p-value = 0.5669

bptest(model2)

    studentized Breusch-Pagan test

data:  model2
BP = 2.3352, df = 3, p-value = 0.5058

• Pre model 1: BP = 2,9462, p = 0,5669
• Pre model 2: BP = 2,3352, p = 0,5058

Výsledky Breusch–Paganovho testu pre model 1 (p = 0.5669) aj model 2 (p = 0.5058) naznačujú, že nemáme dostatok dôkazov na zamietnutie nulovej hypotézy homoskedasticity. Rozptyl rezíduí sa javí ako približne konštantný a nevykazuje systematickú závislosť od vysvetľujúcich premenných.

Z toho možno konštatovať, že reziduá oboch modelov spĺňajú predpoklad homoskedasticity, čo indikuje, že odhady regresných koeficientov sú efektívne a nie je potrebné aplikovať korekcie na heteroskedasticitu.