Úloha_10

1. Úvod

V tejto analýze budeme skúmať multikolinearitu v modeli ekonomických ukazovateľov.

Budeme pracovať s regresným modelom, kde ako závislú premennú použijeme hodnotu akciového indexu a ako nezávislé premenné ostatné ekonomické ukazovatele.

2. Východiskový model a údaje

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

udaje <- read.csv("economic_indicators_dataset_2010_2023.csv", 
                  dec = ".", 
                  sep = ",", 
                  header = TRUE)

str(udaje)

'data.frame':   500 obs. of  7 variables:
 $ Date                 : chr  "2010-01-31" "2010-01-31" "2010-01-31" "2010-02-28" ...
 $ Country              : chr  "Brazil" "France" "USA" "Brazil" ...
 $ Inflation.Rate....   : num  1.23 6.76 7.46 5.43 0.69 6.1 8.61 3.13 0.05 7.2 ...
 $ GDP.Growth.Rate....  : num  0.69 2.59 4.84 0.31 -0.52 9.9 4.43 4.82 -4.78 -1.48 ...
 $ Unemployment.Rate....: num  10.48 4.27 2.64 8.26 11.92 ...
 $ Interest.Rate....    : num  7.71 7.39 6.39 6.09 -0.51 8.38 6.11 -0.66 3.85 8.22 ...
 $ Stock.Index.Value    : num  21749 10040 13129 23305 16413 ...

udaje$Date <- as.Date(udaje$Date, format = "%Y-%m-%d")

udaje_2020 <- udaje[format(udaje$Date, "%Y") == "2020", ]

sapply(udaje_2020, function(x) sum(is.na(x)))

                 Date               Country    Inflation.Rate....   GDP.Growth.Rate.... Unemployment.Rate....     Interest.Rate....     Stock.Index.Value 
                    0                     0                     0                     0                     0                     0                     0 

if(any(is.na(udaje_2020))) {
  column_medians <- sapply(udaje_2020[, c("Inflation.Rate....", "GDP.Growth.Rate....", 
                                          "Unemployment.Rate....", "Interest.Rate....", 
                                          "Stock.Index.Value")], 
                          median, na.rm = TRUE)
  
  for(col in names(column_medians)) {
    na_index <- is.na(udaje_2020[[col]])
    if(any(na_index)) {
      udaje_2020[[col]][na_index] <- column_medians[col]
    }
  }
}

colnames(udaje_2020) <- c("Date", "Country", "Inflation_Rate", "GDP_Growth_Rate", 
                         "Unemployment_Rate", "Interest_Rate", "Stock_Index_Value")

udaje <- udaje_2020
rm(udaje_2020)

summary(udaje[, 3:7])

 Inflation_Rate  GDP_Growth_Rate  Unemployment_Rate Interest_Rate    Stock_Index_Value
 Min.   :0.180   Min.   :-4.220   Min.   : 2.070    Min.   :-0.970   Min.   : 1626    
 1st Qu.:1.885   1st Qu.:-0.220   1st Qu.: 4.075    1st Qu.: 3.217   1st Qu.:11628    
 Median :5.310   Median : 3.040   Median : 6.660    Median : 5.205   Median :22372    
 Mean   :5.051   Mean   : 2.640   Mean   : 6.608    Mean   : 5.088   Mean   :21297    
 3rd Qu.:7.838   3rd Qu.: 5.987   3rd Qu.: 8.473    3rd Qu.: 7.968   3rd Qu.:30324    
 Max.   :9.900   Max.   : 8.890   Max.   :11.910    Max.   : 9.900   Max.   :39613    

Všetky premenné majú plnú informačnosť (žiadne chýbajúce hodnoty) a vykazujú primeranú variabilitu

3. Odhad základného regresného modelu

model <- lm(Stock_Index_Value ~ Inflation_Rate + GDP_Growth_Rate + 
             Unemployment_Rate + Interest_Rate,
           data = udaje)

summary(model)

Call:
lm(formula = Stock_Index_Value ~ Inflation_Rate + GDP_Growth_Rate + 
    Unemployment_Rate + Interest_Rate, data = udaje)

Residuals:
     Min       1Q   Median       3Q      Max 
-21735.1  -9038.9    605.6   9265.7  19096.1 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)        33518.7     7152.5   4.686 3.06e-05 ***
Inflation_Rate      -429.8      584.8  -0.735    0.467    
GDP_Growth_Rate     -176.1      444.8  -0.396    0.694    
Unemployment_Rate   -868.6      632.7  -1.373    0.177    
Interest_Rate       -756.0      583.9  -1.295    0.203    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11600 on 41 degrees of freedom
Multiple R-squared:  0.07305,   Adjusted R-squared:  -0.01738 
F-statistic: 0.8078 on 4 and 41 DF,  p-value: 0.5274

Základný regresný model vykazuje nízku explanačnú silu (R² = 0,073) a nie je štatisticky významný ako celok (p-hodnota F-testu = 0,527). Žiadny z regresných koeficientov nie je štatisticky významný na bežných hladinách významnosti, čo naznačuje problém so špecifikáciou modelu alebo prítomnosťou multikolinearity.

4. Korelačná matica

Korelačná matica nám pomôže identifikovať párové lineárne vzťahy medzi premennými.

Intuitívne pravidlo hovorí, že ak absolútna hodnota korelácie medzi dvoma premennými presahuje 0.8 (prísnejšie 0.9), môže to signalizovať problém multikolinearity.

xvars <- udaje[, c("Inflation_Rate", "GDP_Growth_Rate", 
                   "Unemployment_Rate", "Interest_Rate")]

korelacna_matica <- round(cor(xvars), 3)
korelacna_matica

                  Inflation_Rate GDP_Growth_Rate Unemployment_Rate Interest_Rate
Inflation_Rate             1.000          -0.037            -0.122        -0.042
GDP_Growth_Rate           -0.037           1.000             0.011         0.080
Unemployment_Rate         -0.122           0.011             1.000        -0.299
Interest_Rate             -0.042           0.080            -0.299         1.000

Korelačná matica neindikuje silné lineárne vzťahy medzi vysvetľujúcimi premennými, keďže všetky korelačné koeficienty sú blízke nule.

Jedinou mierne výraznejšou koreláciou je negatívny vzťah medzi mierou nezamestnanosti a úrokovou sadzbou (-0,299), čo ešte nepredstavuje kritickú hodnotu pre multikolinearitu.

5. Grafická analýza vzťahov medzi premennými

pairs(xvars,
      main = "Scatterplotová matica – ekonomické premenné",
      pch = 19,
      col = "blue",
      cex = 0.6)

Z diagramu vidíme, že medzi väčšinou párov premenných neexistuje silný, jasný lineárny vzťah, pretože body sú roztrúsené náhodne v každom grafe.

6. VIF (Variance Inflation Factor)

VIF je priamym indikátorom multikolinearity pre každú vysvetľujúcu premennú:

• VIF < 5: nízka multikolinearita

• 5 ≤ VIF < 10: mierna multikolinearita

• VIF ≥ 10: vysoká multikolinearita

vif_hodnoty <- vif(model)
vif_hodnoty

   Inflation_Rate   GDP_Growth_Rate Unemployment_Rate     Interest_Rate 
         1.022993          1.008591          1.121780          1.113964 

Všetky hodnoty VIF sú výrazne pod kritickou hranicou 5, čo potvrdzuje, že medzi vysvetľujúcimi premennými neexistuje problém multikolinearity.

Najvyššiu hodnotu VIF (1,12) má premenná Unemployment_Rate, čo však stále predstavuje minimálne zvýšenie rozptylu odhadov v dôsledku korelácie s inými premennými.

7. Condition Number (číslo podmienenosti)

Condition number posudzuje celkovú mieru multikolinearity v modeli:

• < 10: nízka multikolinearita

• 10–30: mierna multikolinearita

• 30–100: vysoká multikolinearita

X <- model.matrix(model)[, -1]
XtX <- t(X) %*% X
vlastne_hodnoty <- eigen(XtX)$values

condition_number <- sqrt(max(vlastne_hodnoty) / min(vlastne_hodnoty))
condition_number

[1] 3.520011

Condition number 3,52 výrazne pod hranicou 10 potvrdzuje absenciu multikolinearity v modeli.

Takáto nízka hodnota indikuje, že matica dizajnu je dobre podmienená a odhady regresných koeficientov sú numericky stabilné.

8. Riešenia multikolinearity

8.1 Vynechanie premennej

Skúsme postupne vynechať premenné s najvyšším VIF.

model_no_inflation <- lm(Stock_Index_Value ~ GDP_Growth_Rate + 
                          Unemployment_Rate + Interest_Rate,
                        data = udaje)
summary(model_no_inflation)

Call:
lm(formula = Stock_Index_Value ~ GDP_Growth_Rate + Unemployment_Rate + 
    Interest_Rate, data = udaje)

Residuals:
   Min     1Q Median     3Q    Max 
-19631  -9196   -198   9168  20412 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)        30717.0     6018.6   5.104  7.6e-06 ***
GDP_Growth_Rate     -166.7      442.2  -0.377    0.708    
Unemployment_Rate   -803.5      623.0  -1.290    0.204    
Interest_Rate       -721.4      578.8  -1.246    0.220    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11530 on 42 degrees of freedom
Multiple R-squared:  0.06084,   Adjusted R-squared:  -0.006241 
F-statistic: 0.907 on 3 and 42 DF,  p-value: 0.4458

model_no_interest <- lm(Stock_Index_Value ~ Inflation_Rate + 
                         GDP_Growth_Rate + Unemployment_Rate,
                       data = udaje)
summary(model_no_interest)

Call:
lm(formula = Stock_Index_Value ~ Inflation_Rate + GDP_Growth_Rate + 
    Unemployment_Rate, data = udaje)

Residuals:
     Min       1Q   Median       3Q      Max 
-19751.7  -8326.5    -65.8   8458.3  18855.9 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)        27823.4     5685.2   4.894  1.5e-05 ***
Inflation_Rate      -368.7      587.6  -0.628    0.534    
GDP_Growth_Rate     -224.8      446.8  -0.503    0.618    
Unemployment_Rate   -616.0      606.7  -1.015    0.316    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11690 on 42 degrees of freedom
Multiple R-squared:  0.03515,   Adjusted R-squared:  -0.03377 
F-statistic:  0.51 on 3 and 42 DF,  p-value: 0.6775

cat("Upravený R² pôvodného modelu:", round(summary(model)$adj.r.squared, 4), "\n")

Upravený R² pôvodného modelu: -0.0174 

cat("Upravený R² modelu bez inflácie:", round(summary(model_no_inflation)$adj.r.squared, 4), "\n")

Upravený R² modelu bez inflácie: -0.0062 

cat("Upravený R² modelu bez úrokovej sadzby:", round(summary(model_no_interest)$adj.r.squared, 4), "\n")

Upravený R² modelu bez úrokovej sadzby: -0.0338 

Vynechaním premennej Inflation_Rate alebo Interest_Rate sa upravený koeficient determinácie ešte znížil, čo potvrdzuje neefektívnosť tohto prístupu.

Všetky alternatívne modely ostávajú štatisticky nevýznamné (p-hodnoty F-testu > 0,445) s negatívnymi upravenými R², čo naznačuje nevhodnosť špecifikácie modelu.

8.2 Škálovanie premenných

Centrovanie a škálovanie premenných môže pomôcť redukovať multikolinearitu.

udaje$Inflation_scaled <- scale(udaje$Inflation_Rate, center = TRUE, scale = TRUE)
udaje$GDP_scaled <- scale(udaje$GDP_Growth_Rate, center = TRUE, scale = TRUE)
udaje$Unemployment_scaled <- scale(udaje$Unemployment_Rate, center = TRUE, scale = TRUE)
udaje$Interest_scaled <- scale(udaje$Interest_Rate, center = TRUE, scale = TRUE)

model_scaled <- lm(Stock_Index_Value ~ Inflation_scaled + GDP_scaled + 
                    Unemployment_scaled + Interest_scaled,
                  data = udaje)

summary(model_scaled)

Call:
lm(formula = Stock_Index_Value ~ Inflation_scaled + GDP_scaled + 
    Unemployment_scaled + Interest_scaled, data = udaje)

Residuals:
     Min       1Q   Median       3Q      Max 
-21735.1  -9038.9    605.6   9265.7  19096.1 

Coefficients:
                    Estimate Std. Error t value Pr(>|t|)    
(Intercept)          21297.3     1709.9  12.455 1.61e-15 ***
Inflation_scaled     -1285.0     1748.6  -0.735    0.467    
GDP_scaled            -687.1     1736.2  -0.396    0.694    
Unemployment_scaled  -2513.8     1831.0  -1.373    0.177    
Interest_scaled      -2362.5     1824.6  -1.295    0.203    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11600 on 41 degrees of freedom
Multiple R-squared:  0.07305,   Adjusted R-squared:  -0.01738 
F-statistic: 0.8078 on 4 and 41 DF,  p-value: 0.5274

vif_scaled <- vif(model_scaled)
vif_scaled

   Inflation_scaled          GDP_scaled Unemployment_scaled     Interest_scaled 
           1.022993            1.008591            1.121780            1.113964 

Škálovaný model poskytuje úplne rovnaké štatistické výsledky ako pôvodný model (identické R², p-hodnoty a reziduálna smerodajná odchýlka).

Odhady koeficientov pre škálované premenné vyjadrujú vplyv zmeny o jednu smerodajnú odchýlku, pričom žiadna premenná nie je štatisticky významná. VIF hodnoty zostávajú nízke, čo opäť vylučuje multikolinearitu.

8.3 Condition Number po škálovaní

X_scaled <- model.matrix(model_scaled)[, -1]
XtX_scaled <- t(X_scaled) %*% X_scaled
vlastne_hodnoty_scaled <- eigen(XtX_scaled)$values

condition_number_scaled <- sqrt(max(vlastne_hodnoty_scaled) / min(vlastne_hodnoty_scaled))
condition_number_scaled

[1] 1.418303

Škálovanie premenných znížilo condition number z 3,52 na 1,42, čo predstavuje optimálnu numerickú kondicionovanosť matice dizajnu.

Hodnota blízka 1 potvrdzuje, že škálované premenné sú takmer ortogonálne, čo eliminuje akékoľvek problémy s numerickou presnosťou výpočtov.

8.4 Transformácia premenných

Namiesto škálovania môžeme premenné transformovať tak, aby sme zachovali ich interpretovateľnosť.

apply(udaje[, 3:6], 2, var)

   Inflation_Rate   GDP_Growth_Rate Unemployment_Rate     Interest_Rate 
         8.940401         15.233400          8.375555          9.766056 

model_interaction <- lm(Stock_Index_Value ~ Inflation_Rate * GDP_Growth_Rate + Unemployment_Rate + Interest_Rate,
                        data = udaje)
summary(model_interaction)

Call:
lm(formula = Stock_Index_Value ~ Inflation_Rate * GDP_Growth_Rate + 
    Unemployment_Rate + Interest_Rate, data = udaje)

Residuals:
   Min     1Q Median     3Q    Max 
-21432  -9047   1040   9365  19234 

Coefficients:
                               Estimate Std. Error t value Pr(>|t|)    
(Intercept)                    34557.37    7784.06   4.440 6.92e-05 ***
Inflation_Rate                  -541.48     667.60  -0.811    0.422    
GDP_Growth_Rate                 -472.46     938.10  -0.504    0.617    
Unemployment_Rate               -894.89     643.67  -1.390    0.172    
Interest_Rate                   -800.99     603.27  -1.328    0.192    
Inflation_Rate:GDP_Growth_Rate    55.04     152.87   0.360    0.721    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 11720 on 40 degrees of freedom
Multiple R-squared:  0.07605,   Adjusted R-squared:  -0.03945 
F-statistic: 0.6584 on 5 and 40 DF,  p-value: 0.6569

Model s interakčným členom medzi infláciou a rastom HDP má ešte nižší upravený R² (-0,039) a zostáva štatisticky nevýznamný (p = 0,657).

Interakčný člen nie je štatisticky významný (p = 0,721), čo naznačuje, že tento typ transformácie nezlepšuje explanačnú silu modelu.

9. Porovnanie modelov

models <- list("Pôvodný model" = model,
               "Bez inflácie" = model_no_inflation,
               "Bez úrokovej sadzby" = model_no_interest,
               "Škálovaný model" = model_scaled)

comparison <- data.frame(
  Model = names(models),
  R2 = sapply(models, function(m) round(summary(m)$r.squared, 4)),
  Adj_R2 = sapply(models, function(m) round(summary(m)$adj.r.squared, 4)),
  AIC = round(sapply(models, AIC), 2),
  BIC = round(sapply(models, BIC), 2)
)

print(comparison)

Všetky štyri modely majú negatívne upravené R², čo znamená, že sú horšie ako model s iba konštantou.

Model bez premennej Inflation_Rate má najvyšší upravený R² (-0,0062) a najnižšie informačné kritériá AIC a BIC, čo ho činí relatívne najlepšou, avšak stále nevhodnou špecifikáciou.

10. Zhrnutie a závery

Hlavné zistenia z analýzy:

• Multikolinearita nebola identifikovaná - všetky diagnostické nástroje (korelačná matica, VIF < 1,13, condition number = 3,52) konzistentne potvrdzujú absenciu multikolinearity medzi vysvetľujúcimi premennými.

• Základný problém modelu nie je v multikolinearite - nízka explanačná sila modelov (negatívne upravené R²) a štatistická nevýznamnosť jednotlivých premenných naznačujú, že problém spočíva v nevhodnej špecifikácii modelu alebo vo výbere premenných.

• Škálovanie premenných zlepšilo numerickú stabilitu (condition number klesol na 1,42), ale nezmenilo štatistické vlastnosti modelu.

Nízka explanačná sila a štatistická nevýznamnosť modelu s negatívnym upraveným R² naznačujú, že zvolené ekonomické premenné (inflácia, rast HDP, nezamestnanosť, úroková sadzba) nedokážu adekvátne vysvetliť variabilitu akciových indexov.