Projekt
Yuliia Lysytsia
1. Inštalácia potrebných balíčkov
2. Načítanie knižníc
library(zoo)## Warning: пакет 'zoo' был собран под R версии 4.5.2##
## Присоединяю пакет: 'zoo'## Следующие объекты скрыты от 'package:base':
##
## as.Date, as.Date.numericlibrary(tseries)## Warning: пакет 'tseries' был собран под R версии 4.5.2## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(lmtest)## Warning: пакет 'lmtest' был собран под R версии 4.5.2library(sandwich)## Warning: пакет 'sandwich' был собран под R версии 4.5.2library(car)## Warning: пакет 'car' был собран под R версии 4.5.2## Загрузка требуемого пакета: carData3. Načítanie údajov (súbor musí byť v pracovnom priečinku Posit Cloud)
udaje <- read.csv("economic_indicators_dataset_2010_2023.csv",
dec = ".", sep = ",", header = TRUE, stringsAsFactors = FALSE)4. Kontrola názvov stĺpcov
print("Názvy stĺpcov:")## [1] "Názvy stĺpcov:"print(names(udaje))## [1] "Date" "Country" "Inflation.Rate...."
## [4] "GDP.Growth.Rate...." "Unemployment.Rate...." "Interest.Rate...."
## [7] "Stock.Index.Value"5. Prevod Date na Date triedu a vytvorenie stĺpca Year
udaje$Date_parsed <- as.Date(udaje$Date, format = "%Y-%m-%d")Teraz vytvoríme Year
udaje$Year <- as.numeric(format(udaje$Date_parsed, "%Y"))Rýchla kontrola dostupných rokov
print("Dostupné roky v dátach:")## [1] "Dostupné roky v dátach:"print(sort(unique(udaje$Year)))## [1] 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 20236. Výber údajov pre rok 2015
udaje.2015 <- subset(udaje, Year == 2015)7. Výber relevantných stĺpcov podľa tvojich názvov
# Definujeme názvy stĺpcov, ktoré nás zaujímajú
stock_col <- "Stock.Index.Value"
gdp_col <- "GDP.Growth.Rate...."
interest_col <- "Interest.Rate...."
infl_col <- "Inflation.Rate...."
# Overíme, ktoré stĺpce skutočne existujú v dátach
available_cols <- c(stock_col, gdp_col, interest_col, infl_col)
existing_cols <- available_cols[available_cols %in% names(udaje.2015)]
print("Použité stĺpce:")## [1] "Použité stĺpce:"print(existing_cols)## [1] "Stock.Index.Value" "GDP.Growth.Rate...." "Interest.Rate...."
## [4] "Inflation.Rate...."# Vytvoríme dataframe len s týmito stĺpcami
udaje.2015_sel <- udaje.2015[, existing_cols, drop = FALSE]8. Prevod všetkých vybraných stĺpcov na numerické (ak ešte nie sú)
# Konvertujeme každý stĺpec individuálne na numerický
for (col in existing_cols) {
udaje.2015_sel[[col]] <- as.numeric(as.character(udaje.2015_sel[[col]]))
}9. Kontrola NA / prázdnych stĺpcov pred boxplotom
na_counts <- sapply(udaje.2015_sel, function(x) sum(is.na(x)))
non_na_counts <- sapply(udaje.2015_sel, function(x) sum(!is.na(x)))
print("Počet NA v každom stĺpci:")## [1] "Počet NA v každom stĺpci:"print(na_counts)## Stock.Index.Value GDP.Growth.Rate.... Interest.Rate.... Inflation.Rate....
## 0 0 0 0print("Počet nenulových hodnôt v každom stĺpci:")## [1] "Počet nenulových hodnôt v každom stĺpci:"print(non_na_counts)## Stock.Index.Value GDP.Growth.Rate.... Interest.Rate.... Inflation.Rate....
## 32 32 32 32# Ak niektorý stĺpec obsahuje len NA -> vylúčime ho z ďalších krokov
cols_with_data <- names(udaje.2015_sel)[non_na_counts > 0]
if (length(cols_with_data) == 0) {
stop("Všetky vybrané stĺpce pre vybraný rok sú NA. Skontroluj dáta.")
}
udaje.2015_sel <- udaje.2015_sel[, cols_with_data, drop = FALSE]10. Doplnenie chýbajúcich hodnôt mediánom
for (col in names(udaje.2015_sel)) {
if (sum(!is.na(udaje.2015_sel[[col]])) > 0) { # kontrola, či sú nejaké non-NA hodnoty
med <- median(udaje.2015_sel[[col]], na.rm = TRUE)
udaje.2015_sel[[col]][is.na(udaje.2015_sel[[col]])] <- med
}
}11. Boxploty
numeric_cols <- names(udaje.2015_sel)[sapply(udaje.2015_sel, is.numeric)]
if (length(numeric_cols) == 0) {
stop("Žiadne numerické stĺpce na vykreslenie.")
}
# Dynamicky nastaviť rozloženie grafov podľa počtu stĺpcov
plot_rows <- ceiling(length(numeric_cols) / 2)
par(mfrow = c(plot_rows, 2))
par(mar = c(4, 4, 2, 1))
for (col in numeric_cols) {
vals <- udaje.2015_sel[[col]]
if (all(is.finite(vals))) {
boxplot(vals, main = col, xlab = "Hodnota", col = "lightblue")
} else {
warning(paste("Stĺpec", col, "nemá konečné hodnoty. Preskakujem."))
}
}
mtext("Boxploty vybraných premenných (rok 2015)", outer = TRUE, line = -1, cex = 1.2, font = 2)
par(mfrow = c(1, 1))Štatistické hypotézy
Pre regresný model testujeme nasledovné štatistické hypotézy:
Hlavné hypotézy:
- Hypotéza o vplyve HDP na akciový index:
- H₀: β_GDP = 0 (Rast HDP nemá vplyv na akciový index)
- H₁: β_GDP ≠ 0 (Rast HDP má vplyv na akciový index)
- Hypotéza o vplyve úrokovej sadzby:
- H₀: β_Interest = 0 (Úroková sadzba nemá vplyv na akciový index)
- H₁: β_Interest ≠ 0 (Úroková sadzba má vplyv na akciový index)
- Hypotéza o vplyve inflácie:
- H₀: β_Inflation = 0 (Inflácia nemá vplyv na akciový index)
- H₁: β_Inflation ≠ 0 (Inflácia má vplyv na akciový index)
Celková hypotéza modelu: - H₀: β₁ = β₂ = β₃ = 0 (Žiadna z premenných nevysvetľuje variabilitu akciového indexu) - H₁: Aspoň jeden β ≠ 0 (Asi jedna premenná vysvetľuje variabilitu akciového indexu)
Očakávané smerové účinky: - GDP Growth: očakávame pozitívny vplyv (+) - Interest Rate: očakávame negatívny vplyv (-) - Inflation Rate: vplyv nejednoznačný (+/-) “)
12. Regresný model
# Skontrolujeme, či máme aspoň Stock Index a jednu vysvetľujúcu premennú
if (!("Stock.Index.Value" %in% names(udaje.2015_sel))) {
stop("Stĺpec 'Stock Index Value' nie je dostupný po filtrovaní.")
}
# Zostavíme formulu dynamicky len z dostupných vysvetľujúcich premenných
response <- "Stock.Index.Value"
predictors <- setdiff(names(udaje.2015_sel), response)
if (length(predictors) == 0) {
stop("Žiadne vysvetľujúce premenné dostupné pre regresiu.")
}
formula_text <- paste(response, "~", paste(predictors, collapse = " + "))
model <- lm(as.formula(formula_text), data = udaje.2015_sel)
print(summary(model))##
## Call:
## lm(formula = as.formula(formula_text), data = udaje.2015_sel)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22884.0 -6508.6 -291.9 9787.0 17806.9
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 25760.4 5217.1 4.938 3.29e-05 ***
## GDP.Growth.Rate.... 523.6 547.4 0.957 0.347
## Interest.Rate.... -928.3 652.8 -1.422 0.166
## Inflation.Rate.... 243.6 664.0 0.367 0.716
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 12040 on 28 degrees of freedom
## Multiple R-squared: 0.09753, Adjusted R-squared: 0.00084
## F-statistic: 1.009 on 3 and 28 DF, p-value: 0.403613. Diagnostické grafy
par(mfrow = c(2, 2))
plot(model)
par(mfrow = c(1, 1))14. Testy rezíduí a odľahlých hodnôt
jb_test <- jarque.bera.test(residuals(model))
print(jb_test)##
## Jarque Bera Test
##
## data: residuals(model)
## X-squared = 1.9994, df = 2, p-value = 0.368print(outlierTest(model))## No Studentized residuals with Bonferroni p < 0.05
## Largest |rstudent|:
## rstudent unadjusted p-value Bonferroni p
## 182 -2.250795 0.032746 NA15. Alternatívny model
# Skúsime model bez krajných hodnôt
if (nrow(udaje.2015_sel) > 10) {
# Odstránime vplyvné body
cooks_dist <- cooks.distance(model)
influential <- cooks_dist > (4 / nrow(udaje.2015_sel))
if (sum(influential) > 0) {
udaje.2015_clean <- udaje.2015_sel[!influential, ]
model_clean <- lm(as.formula(formula_text), data = udaje.2015_clean)
print("Model po odstránení vplyvných pozorovaní:")
print(summary(model_clean))
}
}## [1] "Model po odstránení vplyvných pozorovaní:"
##
## Call:
## lm(formula = as.formula(formula_text), data = udaje.2015_clean)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20974 -4867 -1410 8841 16668
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 27477.5 4934.4 5.569 6.64e-06 ***
## GDP.Growth.Rate.... 915.6 540.4 1.694 0.1017
## Interest.Rate.... -1228.9 624.5 -1.968 0.0594 .
## Inflation.Rate.... 206.7 620.7 0.333 0.7417
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11250 on 27 degrees of freedom
## Multiple R-squared: 0.1944, Adjusted R-squared: 0.1048
## F-statistic: 2.171 on 3 and 27 DF, p-value: 0.1146Správa z analýzy (rok 2015)
Cieľom analýzy bolo preskúmať vplyv makroekonomických premenných na hodnotu akciového indexu. Použité premenné: Stock Index Value (závislá), GDP Growth Rate (%), Interest Rate (%), Inflation Rate (%).
Doplnenie chýbajúcich hodnôt: medián príslušnej premennej. Regresný model: pozri vyššie výpis summary().
Interpretácia: - Ak je koeficient pri raste HDP pozitívny a štatisticky významný -> rast HDP zvyšuje akciový index. - Ak je koeficient pri úrokovej sadzbe negatívny -> vyššie úrokové sadzby znižujú hodnotu akcií. - Inflácia často má slabší alebo nejednoznačný vplyv.
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)## Warning: пакет 'ggplot2' был собран под R версии 4.5.2rm(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....
## Min. :0.000 Min. :-5.000 Min. : 2.000 Min. :-0.980
## 1st Qu.:2.525 1st Qu.:-1.170 1st Qu.: 4.258 1st Qu.: 2.027
## Median :5.205 Median : 2.580 Median : 6.865 Median : 4.975
## Mean :5.085 Mean : 2.415 Mean : 6.907 Mean : 4.698
## 3rd Qu.:7.710 3rd Qu.: 5.445 3rd Qu.: 9.502 3rd Qu.: 7.353
## Max. :9.990 Max. : 9.930 Max. :11.970 Max. :10.000
## Stock.Index.Value
## Min. : 1017
## 1st Qu.:11588
## Median :20996
## Mean :20926
## 3rd Qu.:30825
## Max. :39982Imputá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_impBoxploty
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 nebolo 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.6877Lineá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-06Hodnota 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|:
## rstudent unadjusted p-value Bonferroni p
## 25 -1.876638 0.061157 NAJedno 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)## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
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.375Po 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)## Warning in log(GDP.Growth.Rate.... + 1): созданы NaN
## Warning in log(GDP.Growth.Rate.... + 1): созданы NaN## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 132 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 132 rows containing missing values or values outside the scale range
## (`geom_point()`).## `geom_smooth()` using formula = 'y ~ x'
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.5669bptest(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.
Úvod
V tejto úlohe skúmame, ako makroekonomické ukazovatele – inflácia, rast HDP, miera nezamestnanosti a úrokové sadzby – ovplyvňujú akciový index v Kanade.
Cieľom je:
odhadnúť lineárne a nelineárne regresné modely,
overiť správnosť špecifikácie modelu (RESET test, C+R ploty),
preskúmať efekty šokových období pomocou dummy premenných,
zistiť, či je vhodná transformácia závislej premennej (Box-Cox test).
Výsledky nám umožnia lepšie pochopiť vzťahy medzi makroekonomickými indikátormi a vývojom akciového trhu.
library(zoo)
library(tseries)
library(lmtest)
library(sandwich)
library(carData)
library(cowplot)
library(ggplot2)
library(tidyverse)## Warning: пакет 'tibble' был собран под R версии 4.5.2## Warning: пакет 'tidyr' был собран под R версии 4.5.2## Warning: пакет 'readr' был собран под R версии 4.5.2## Warning: пакет 'purrr' был собран под R версии 4.5.2## Warning: пакет 'stringr' был собран под R версии 4.5.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ lubridate 1.9.4 ✔ tibble 3.3.1
## ✔ purrr 1.2.1 ✔ tidyr 1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::recode() masks car::recode()
## ✖ purrr::some() masks car::some()
## ✖ lubridate::stamp() masks cowplot::stamp()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(car)
library(MASS)##
## Присоединяю пакет: 'MASS'
##
## Следующий объект скрыт от 'package:dplyr':
##
## selectlibrary(readr)Načítanie a príprava údajov
data <- read_csv("economic_indicators_dataset_2010_2023.csv") %>%
rename(
Inflation_Rate = `Inflation Rate (%)`,
GDP_Growth = `GDP Growth Rate (%)`,
Unemployment_Rate = `Unemployment Rate (%)`,
Interest_Rate = `Interest Rate (%)`,
Stock_Index_Value = `Stock Index Value`
) %>%
mutate(Date = as.Date(Date),
Year = year(Date),
Quarter = quarter(Date)) %>%
arrange(Date)## Rows: 500 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Country
## dbl (5): Inflation Rate (%), GDP Growth Rate (%), Unemployment Rate (%), In...
## date (1): Date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Vypočítame kvartálne log-returns ako závislú premennú
data <- data %>%
group_by(Country) %>%
mutate(Return = 100 * (log(Stock_Index_Value) - log(lag(Stock_Index_Value)))) %>%
ungroup() %>%
filter(!is.na(Return))
# Lagované vysvetľujúce premenné
data <- data %>%
group_by(Country) %>%
mutate(
Inflation_Lag1 = lag(Inflation_Rate),
GDP_Lag1 = lag(GDP_Growth),
Unemployment_Lag1 = lag(Unemployment_Rate),
Interest_Lag1 = lag(Interest_Rate)
) %>%
ungroup() %>%
filter(!is.na(Inflation_Lag1))
# Vyberieme jednu krajinu - Canada
data_country <- data %>% filter(Country == "Canada")Základná lineárna regresia
Odhadli sme základný lineárny regresný model, kde závislou premennou je Return (kvartálna výnosnosť akciového indexu), a vysvetľujúcimi premennými sú lagované makroekonomické ukazovatele (Inflácia, GDP, Nezamestnanosť, Úroková sadzba).
Cieľom je overiť, či tieto premenné štatisticky významne ovplyvňujú výnosy akciového trhu.
model1 <- lm(Return ~ Inflation_Lag1 + GDP_Lag1 +
Unemployment_Lag1 + Interest_Lag1,
data = data_country)
summary(model1)##
## Call:
## lm(formula = Return ~ Inflation_Lag1 + GDP_Lag1 + Unemployment_Lag1 +
## Interest_Lag1, data = data_country)
##
## Residuals:
## Min 1Q Median 3Q Max
## -237.459 -80.935 2.865 71.876 286.813
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -55.2698 68.0659 -0.812 0.422
## Inflation_Lag1 8.0565 6.3979 1.259 0.215
## GDP_Lag1 -1.8043 4.7543 -0.380 0.706
## Unemployment_Lag1 1.5725 6.1796 0.254 0.800
## Interest_Lag1 0.4398 5.6816 0.077 0.939
##
## Residual standard error: 126.1 on 40 degrees of freedom
## Multiple R-squared: 0.05268, Adjusted R-squared: -0.04205
## F-statistic: 0.5561 on 4 and 40 DF, p-value: 0.6958Žiadny z koeficientov nie je štatisticky významný (p-hodnoty všetky > 0.2) -> to znamená, že na tomto základnom lineárnom modeli žiadna premenná nevysvetľuje výnosy akcií výraznejšie.
Intercept = -55.27, tiež neštatisticky významný, slúži len ako posun regresnej priamky.
R² = 0.0527, Adjusted R² = -0.042 → model vysvetľuje len ~5 % variability výnosov, čo je veľmi nízke.
F-test (p = 0.696) → model ako celok nie je štatisticky významný.
Reziduá - veľký rozsah -237 až 287 → vysoká volatilita výnosov, model nezachytáva ich dynamiku -> to naznačuje, že lineárna špecifikácia bez nelineárnych členov, interakcií alebo šokových premenných je nedostatočná.
Ramsey RESET test
RESET test slúži na overenie správnosti špecifikácie lineárneho modelu. Testuje, či sme nezanedbali nelineárne vzťahy alebo interakcie medzi vysvetľujúcimi premennými.
H0 (nulová hypotéza): model je správne špecifikovaný (žiadne chýbajúce nelineárne členy).
H1 (alternatívna hypotéza): model je nesprávne špecifikovaný (chýbajú nelineárne členy alebo interakcie).
resettest(model1)##
## RESET test
##
## data: model1
## RESET = 0.078107, df1 = 2, df2 = 38, p-value = 0.925P-hodnota je veľmi vysoká (> 0.05) -> takže nemáme dôkaz proti nulovej hypotéze.
Model teda formálne nie je nesprávne špecifikovaný -> t.j. pridanie vyšších mocnín vysvetľujúcich premenných by štatisticky významne nezlepšilo fit modelu.
Reziduálny graf
Reziduálny graf (Residuals vs. Fitted) slúži na vizuálne overenie predpokladu linearity, homoskedasticity a náhodnosti rezíduí. Chceme zistiť, či reziduá majú nejaký štruktúrovaný vzor, ktorý by naznačoval, že model nezachytil všetky vzťahy medzi premennými.
plot(model1, which = 1)
- Reziduá sa javia náhodne rozptýlené okolo nuly → predpoklad linearity a správnej špecifikácie modelu je formálne splnený.
Nenachádza sa žiadne zakrivenie ani heteroskedasticita → model nezanedbáva systematické nelineárne vzťahy.
Existence niekoľkých extrémnych bodov (outlierov) môže ovplyvniť presnosť odhadu, ale celkovo graf podporuje platnosť lineárnej špecifikácie.
C + R plot (Component + Residual)
C+R plot (Component + Residual) umožňuje vizuálne posúdiť nelineárne vzťahy medzi jednotlivou vysvetľujúcou premennou a závislou premennou po zohľadnení ostatných premenných v modeli.
crPlots(model1)
#### C + R plot – Inflation_Lag1
Vzťah medzi premennou a závislou premennou -> takmer lineárny, žiadne zakrivenie.
Poloha bodov -> väčšina bodov blízko modrej a ružovej línie, rozptýlenie náhodné. To naznačuje, že lagovaná inflácia nemá významný nelineárny efekt na výnosy kanadského akciového trhu.
Outliery -> veľmi málo extrémnych hodnôt, neovplyvňujú celkový vzťah.
Model nezanedbáva nelineárny efekt lagovanej inflácie, lineárna špecifikácia je vhodná.
C + R plot – GDP_Lag1
Vzťah medzi GDP_Lag1 a výnosom akcií je prevažne lineárny.
Jemné zakrivenie ružovej línie môže naznačovať malý nelineárny efekt pri vyšších hodnotách. To znamená, že pri veľmi vysokom raste HDP by výnosy akciového indexu mohli reagovať mierne odlišne, čo je dôležité pri analýze extrémnych hospodárskych období.
Lineárna špecifikácia pre GDP_Lag1 je vhodná, nelineárne efekty sú minimálne.
C + R plot – Unemployment_Lag1
Vzťah medzi lagovanou nezamestnanosťou a výnosom akcií je takmer lineárny, bez výrazného zakrivenia.
Malé odchýlky ružovej línie môžu naznačovať mierny nelineárny efekt pri nižších hodnotách nezamestnanosti. To ukazuje, že pri nízkej nezamestnanosti malé zmeny môžu spôsobiť disproporčne väčší efekt na výnosy, čo zdôrazňuje citlivosť kanadského trhu na zamestnanosť.
Lineárna špecifikácia pre Unemployment_Lag1 je vhodná, žiadne zásadné nelineárne efekty sa neprejavujú.
C + R plot – Interest_Lag1
Vzťah medzi lagovanou úrokovou sadzbou a výnosom akcií je takmer lineárny, bez výrazného zakrivenia.
Jemné odchýlky ružovej línie naznačujú mierny nelineárny efekt pri stredných hodnotách úrokovej sadzby. To znamená, že stredné úrokové sadzby môžu mať mierne odlišný vplyv na výnosy, zatiaľ čo veľmi nízke alebo vysoké sadzby pôsobia menej citlivo.
Lineárna špecifikácia pre Interest_Lag1 je vhodná, nelineárne efekty sú minimálne.
Kvadratické členy pre nelineárne vzťahy
Pridanie kvadratických členov (štvorcových členov vysvetľujúcich premenných) slúži na testovanie, či medzi lagovanými makroekonomickými premennými a výnosom akcií existujú nelineárne vzťahy. Ak by sa ukázalo, že kvadratické členy sú štatisticky významné, znamenalo by to, že jednoduchý lineárny model nezachytáva celú dynamiku a je potrebné uvažovať nelineárnu transformáciu premenných.
model_quad <- lm(Return ~ Inflation_Lag1 + I(Inflation_Lag1^2) +
GDP_Lag1 + I(GDP_Lag1^2) +
Unemployment_Lag1 + I(Unemployment_Lag1^2) +
Interest_Lag1 + I(Interest_Lag1^2),
data = data_country)
summary(model_quad)##
## Call:
## lm(formula = Return ~ Inflation_Lag1 + I(Inflation_Lag1^2) +
## GDP_Lag1 + I(GDP_Lag1^2) + Unemployment_Lag1 + I(Unemployment_Lag1^2) +
## Interest_Lag1 + I(Interest_Lag1^2), data = data_country)
##
## Residuals:
## Min 1Q Median 3Q Max
## -249.006 -76.237 8.876 70.055 262.579
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -152.50966 151.14907 -1.009 0.320
## Inflation_Lag1 20.14300 32.34168 0.623 0.537
## I(Inflation_Lag1^2) -0.96354 3.10208 -0.311 0.758
## GDP_Lag1 -0.01206 6.98346 -0.002 0.999
## I(GDP_Lag1^2) -0.23363 1.37210 -0.170 0.866
## Unemployment_Lag1 21.55821 41.38986 0.521 0.606
## I(Unemployment_Lag1^2) -1.58305 3.02474 -0.523 0.604
## Interest_Lag1 29.94504 23.72780 1.262 0.215
## I(Interest_Lag1^2) -3.31045 2.57956 -1.283 0.208
##
## Residual standard error: 129.1 on 36 degrees of freedom
## Multiple R-squared: 0.1057, Adjusted R-squared: -0.09308
## F-statistic: 0.5317 on 8 and 36 DF, p-value: 0.8247anova(model1, model_quad)resettest(model_quad)##
## RESET test
##
## data: model_quad
## RESET = 0.0075459, df1 = 2, df2 = 34, p-value = 0.9925Reziduá a koeficienty
- Kvadratické členy nie sú štatisticky významné (všetky p > 0,2), R² sa prakticky nezmenilo. Pridanie nelineárnych členov nevysvetľuje výnos akcií lepšie.
ANOVA – porovnanie s lineárnym modelom
- F = 0.5332, p = 0.7121 → rozšírenie modelu o kvadratické členy neprinieslo zlepšenie kvality modelu.
RESET test
- p-value = 0.9925 → model nie je nesprávne špecifikovaný ani s kvadratickými členmi.
Pre Kanadu lineárny model vystačuje; prítomnosť významnej nelinearity sa nepotvrdila, pridanie kvadratických členov neprinieslo žiadny užitočný efekt.
Dummy premenná pre šokové kvartály
Skúmame, či špecifické kvartály (Q3–Q4) majú významný vplyv na výnosy akcií v Kanade prostredníctvom dummy premennej Shock. Cieľom je overiť, či tieto kvartály zvyšujú alebo znižujú Return nezávisle od makroekonomických premenných.
data_country <- data_country %>%
mutate(Shock = ifelse(Year == 2020 & Quarter <= 2, 1, 0))
model_dummy <- lm(Return ~ Inflation_Lag1 + GDP_Lag1 +
Unemployment_Lag1 + Interest_Lag1 + Shock,
data = data_country)
summary(model_dummy)##
## Call:
## lm(formula = Return ~ Inflation_Lag1 + GDP_Lag1 + Unemployment_Lag1 +
## Interest_Lag1 + Shock, data = data_country)
##
## Residuals:
## Min 1Q Median 3Q Max
## -236.655 -81.431 0.882 72.074 287.214
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -55.9578 69.1165 -0.810 0.423
## Inflation_Lag1 8.1559 6.5220 1.251 0.219
## GDP_Lag1 -1.6979 4.8816 -0.348 0.730
## Unemployment_Lag1 1.4405 6.3371 0.227 0.821
## Interest_Lag1 0.5521 5.8159 0.095 0.925
## Shock 17.7495 135.1299 0.131 0.896
##
## Residual standard error: 127.6 on 39 degrees of freedom
## Multiple R-squared: 0.0531, Adjusted R-squared: -0.0683
## F-statistic: 0.4374 on 5 and 39 DF, p-value: 0.8197anova(model_quad, model_dummy)resettest(model_dummy)##
## RESET test
##
## data: model_dummy
## RESET = 0.09522, df1 = 2, df2 = 37, p-value = 0.9094Koeficient pre Shock: 17,75, p = 0,896 → efekt nie je štatisticky významný, kvartály Q3–Q4 nemajú zjavný vplyv.
R² a F-test: R² = 0,0531, F-test p = 0,8197 → model vysvetľuje len malú časť variability, pridanie Shock nezlepšilo vysvetľujúcu schopnosť.
Porovnanie s predchádzajúcim modelom: ANOVA ukazuje, že pridaním dummy premenné sa model nezlepšil (F = 0,7053, p = 0,5551).
RESET test: p = 0,9094 → model stále nevykazuje nedostatok špecifikácie ani nezachytené nelineárne vzťahy.
Šokové kvartály nemajú významný efekt na výnosy akcií v Kanade, model lineárnej špecifikácie je adekvátny.
Box-Cox transformácia
Box–Cox transformácia slúži na overenie, či by transformácia závislej premennej mohla zlepšiť lineárnu špecifikáciu modelu, napríklad znížiť heteroskedasticitu alebo zvýšiť predikčnú schopnosť modelu. Hľadáme optimálnu hodnotu parametra λ, ktorá ukáže, či je vhodná transformácia alebo sa dá ponechať pôvodná forma premennej.
# Box-Cox transformácia na úrovni Stock_Index_Value
model_boxcox <- lm(Stock_Index_Value ~ Inflation_Lag1 + GDP_Lag1 +
Unemployment_Lag1 + Interest_Lag1 + Shock,
data = data_country)
boxcox(model_boxcox, lambda = seq(-2, 2, 0.1)) 
- Maximum log Likelihood je približne pri λ ≈ 0,8–0,9, čo naznačuje, že optimálna transformácia by bola veľmi blízka pôvodnej mierke.
- Horizontálna čiara predstavuje 95% interval; z nej vyplýva, že všetky hodnoty λ medzi približne 0,4 a 1,3 sú štatisticky prijateľné.
To znamená, že pôvodná forma premennej Stock_Index_Value (λ ≈ 1) je vhodná a transformácia nie je nutná.
Stock_Index_Value môže zostať v pôvodnej podobe, lineárny model je vhodný bez transformácie.
Záver
Analýza pre Kanadu ukázala, že lagované makroekonomické premenné – inflácia, rast HDP, miera nezamestnanosti a úroková sadzba – majú len veľmi slabý vplyv na výnosy akciového indexu.
Lineárne modely, kvadratické členy ani zahrnutie dummy pre šokové kvartály neviedli k významnému zlepšeniu predikcie.
Reziduá sú rozptýlené náhodne, C+R ploty a Box–Cox transformácia potvrdzujú vhodnosť lineárnej špecifikácie bez transformácie závislej premennej.
Celkovo modely vysvetľujú len malú časť variability výnosov, čo naznačuje, že ďalšie faktory mimo analyzovaných makroekonomických premenných môžu mať väčší vplyv na pohyb akciového indexu v Kanade.
Klastrová analýza ekonomických ukazovateľov - rok 2010
Úvod
Predkladaná analýza sa zameriava na skúmanie makroekonomických ukazovateľov vybraných krajín za rok 2010 s cieľom identifikovať prirodzené zoskupenia krajín podľa ich ekonomického profilu. Sledované premenné zahŕňajú infláciu, tempo rastu HDP, mieru nezamestnanosti, úrokovú sadzbu a hodnotu akciového indexu, ktoré spoločne charakterizujú ekonomickú stabilitu a rastový potenciál krajiny.
Použitím zhlukovej analýzy je možné rozdeliť krajiny do homogénnych skupín, odhaliť vzory podobnosti a identifikovať odlišné krajiny. Výsledky poskytujú cenné informácie pre porovnávaciu ekonomickú štatistiku, politické rozhodovanie a ďalšie ekonometrické modelovanie.
Načítanie knižníc a príprava údajov
library(tidyverse)
library(cluster)
library(factoextra)## Warning: пакет 'factoextra' был собран под R версии 4.5.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa# Načítanie dát
data <- read.csv("economic_indicators_dataset_2010_2023.csv")
# Prehľad názvov stĺpcov
colnames(data) <- c("Date", "Country", "Inflation", "GDP_Growth", "Unemployment", "Interest", "StockIndex")
# Prevod Date na dátum
data$Date <- as.Date(data$Date)
# Výber dát za rok 2010
data_2010 <- data %>%
filter(format(Date, "%Y") == "2010")Priemer za rok pre každú krajinu
Na základe údajov za rok 2010 sme vypočítali priemerné hodnoty sledovaných ekonomických ukazovateľov pre jednotlivé krajiny. Napríklad Austrália dosahuje infláciu 6,89%, rast HDP 6,38%, nezamestnanosť 9,17%, úrokovú sadzbu 1,51% a hodnotu akciového indexu 17726,16. Podobne Brazília má infláciu 6,26%, rast HDP 2,13% a nezamestnanosť 7,77%.
data_country <- data_2010 %>%
group_by(Country) %>%
summarise(
Inflation = round(mean(Inflation, na.rm = TRUE), 2),
GDP_Growth = round(mean(GDP_Growth, na.rm = TRUE), 2),
Unemployment = round(mean(Unemployment, na.rm = TRUE), 2),
Interest = round(mean(Interest, na.rm = TRUE), 2),
StockIndex = round(mean(StockIndex, na.rm = TRUE), 2)
)
print(data_country)## # A tibble: 10 × 6
## Country Inflation GDP_Growth Unemployment Interest StockIndex
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Australia 6.89 6.38 9.17 1.51 17726.
## 2 Brazil 6.26 2.13 7.77 5.13 21318.
## 3 Canada 4.95 1.04 8 5.32 14733.
## 4 China 5.12 6.29 6.58 3.22 7262.
## 5 France 7.1 0.01 6.36 4.11 15535.
## 6 Germany 4.44 -3.83 4.07 3.92 31765.
## 7 India 6.77 7.09 7.27 6.52 25717.
## 8 Japan 8.85 4.03 10.7 6.7 21079.
## 9 UK 6.39 4.18 9.4 4.66 20325.
## 10 USA 5.84 2.26 5.15 4.32 7985.Analýza priemerov umožňuje rýchlo porovnať ekonomický stav krajín. Vidíme, že krajiny ako India a Japonsko vykazujú vysoké hodnoty úrokovej sadzby a rastu HDP, zatiaľ čo napríklad USA má relatívne nízku infláciu a hodnotu akciového indexu. Tieto údaje slúžia ako podklad pre ďalšie kroky analýzy, vrátane výpočtu korelačnej matice a zhlukovej analýzy, ktoré odhalia vzájomné podobnosti a rozdiely medzi krajinami.
Korelačná matica
Korelačná matica vypočítaná pre vybrané ekonomické ukazovatele ukazuje vzťahy medzi nimi. Hodnoty korelačných koeficientov sú zaokrúhlené na dve desatinné miesta.
Z matice vyplýva, že inflácia je silne kladne korelovaná s mierou nezamestnanosti (r = 0,70) a stredne s rastom HDP (r = 0,42). Naopak, hodnota akciového indexu je relatívne nezávislá od ostatných premenných, pričom najvyššia korelácia je so stock indexom a úrokovou sadzbou (r = 0,30). Rast HDP má mierne zápornú koreláciu so stock indexom (r = -0,33) a takmer nulovú s úrokovou sadzbou.
cor_matrix <- cor(data_country[, -1])
cor_matrix_rounded <- round(cor_matrix, 2)
print(cor_matrix_rounded)## Inflation GDP_Growth Unemployment Interest StockIndex
## Inflation 1.00 0.42 0.70 0.35 0.07
## GDP_Growth 0.42 1.00 0.57 -0.01 -0.33
## Unemployment 0.70 0.57 1.00 0.23 0.00
## Interest 0.35 -0.01 0.23 1.00 0.30
## StockIndex 0.07 -0.33 0.00 0.30 1.00Celkovo korelačná matica indikuje, že medzi niektorými ukazovateľmi existujú stredné až silné vzťahy, ale žiadna dvojica premenných nie je extrémne vysoko korelovaná, čo umožňuje ich súčasné použitie pri zhlukovej analýze bez potreby redukcie dimenzionality.
Matica vzdialenosti medzi krajinami
Matica vzdialeností ukazuje, do akej miery sa ekonomické profily krajín navzájom líšia.
Najväčšia vzdialenosť je medzi Nemeckom a Čínou (23502,86), čo odráža výrazné rozdiely v ekonomickej štruktúre, raste HDP a hodnote akciového indexu. Naopak, relatívne malá vzdialenosť je medzi Brazíliou a Japonskom (239,04), čo naznačuje podobnosť vybraných ukazovateľov medzi týmito dvoma krajinami.
data_numeric <- data_country[, -1]
dist_matrix <- dist(data_numeric, method = "euclidean")
dist_matrix <- as.matrix(dist_matrix)
rownames(dist_matrix) <- data_country$Country
colnames(dist_matrix) <- data_country$Country
dist_matrix_rounded <- round(dist_matrix, 2)
print(dist_matrix_rounded)## Australia Brazil Canada China France Germany India
## Australia 0.00 3591.45 2993.00 10464.41 2190.82 14038.46 7990.54
## Brazil 3591.45 0.00 6584.44 14055.86 5782.26 10447.00 4399.09
## Canada 2993.00 6584.44 0.00 7471.42 802.19 17031.44 10983.53
## China 10464.41 14055.86 7471.42 0.00 8273.60 24502.86 18454.95
## France 2190.82 5782.26 802.19 8273.60 0.00 16229.26 10181.35
## Germany 14038.46 10447.00 17031.44 24502.86 16229.26 0.00 6047.92
## India 7990.54 4399.09 10983.53 18454.95 10181.35 6047.92 0.00
## Japan 3352.46 239.04 6345.44 13816.86 5543.26 10686.01 4638.09
## UK 2598.60 992.85 5591.59 13063.01 4789.41 11439.85 5391.94
## USA 9741.39 13332.84 6748.40 723.03 7550.58 23779.84 17731.93
## Japan UK USA
## Australia 3352.46 2598.60 9741.39
## Brazil 239.04 992.85 13332.84
## Canada 6345.44 5591.59 6748.40
## China 13816.86 13063.01 723.03
## France 5543.26 4789.41 7550.58
## Germany 10686.01 11439.85 23779.84
## India 4638.09 5391.94 17731.93
## Japan 0.00 753.86 13093.84
## UK 753.86 0.00 12339.99
## USA 13093.84 12339.99 0.00Matica vzdialeností poskytuje cenný podklad pre zhlukovú analýzu, keďže krajiny s menšími vzdialenosťami sa pravdepodobne zoskupia do rovnakých klastrov.
Hierarchické zhlukovanie (Wardova metóda)
Na základe dendrogramu hierarchického zhlukovania možno pozorovať nasledujúce:
Krajiny sa rozdeľujú do triedy troch hlavných klastrov, čo je vyznačené červenou rezacou čiarou.
Jeden klaster tvorí Nemecko samostatne, čo naznačuje, že jeho ekonomický profil je výrazne odlišný od ostatných krajín.
Druhý klaster obsahuje Indiu a Japonsko, ktoré sú si navzájom bližšie, pravdepodobne kvôli podobným hodnotám vybraných ekonomických premenných (úrokové sadzby, HDP rast).
Tretí klaster zahŕňa Francúzsko, Kanadu, Brazíliu, UK, Austráliu, Čínu a USA, pričom niektoré krajiny v tomto klasteri sú bližšie k sebe (Brazilia a UK alebo China a USA), čo naznačuje väčšiu podobnosť v ekonomickom profile.
# z-škálovanie
data_scaled <- scale(data_numeric)
hc <- hclust(dist(data_scaled, method = "euclidean"), method = "ward.D2")
plot(hc, labels = data_country$Country, main = "Hierarchické zhlukovanie - Wardova metóda (2010)", cex = 0.8)
rect.hclust(hc, k = 3, border = "red") 
Celková interpretácia ukazuje, že dendrogram efektívne oddeľuje krajiny s výrazne odlišnými ekonomickými charakteristikami a zoskupuje krajiny s podobnými ukazovateľmi do spoločných klastrov.
Príslušnosť krajín do klastrov
Klaster 1 tvoria hlavne rozvinuté krajiny Západu a ďalšie významné ekonomiky ako Austrália, Brazília, Kanada, Čína, Francúzsko, Veľká Británia a USA. Tento klaster predstavuje krajiny s vysokou ekonomickou vyspelosťou alebo veľkým globálnym významom.
Klaster 2 obsahuje Nemecko, ktoré je zároveň vyspelou západnou ekonomikou, ale odlišuje sa od väčšiny ostatných krajín západu, pravdepodobne kvôli špecifickým ekonomickým alebo štrukturálnym faktorom.
Klaster 3 tvoria India a Japonsko, krajiny, ktoré sú buď rozvíjajúce sa ekonomiky s vysokým rastovým potenciálom (India), alebo vysoko vyspelé, ale odlišné ekonomické systémy a kultúrne štruktúry (Japonsko).
clusters <- cutree(hc, k = 3)
data_country$cluster <- as.factor(clusters)
print(data_country[, c("Country", "cluster")])## # A tibble: 10 × 2
## Country cluster
## <chr> <fct>
## 1 Australia 1
## 2 Brazil 1
## 3 Canada 1
## 4 China 1
## 5 France 1
## 6 Germany 2
## 7 India 3
## 8 Japan 3
## 9 UK 1
## 10 USA 1Deskriptívne štatistiky výsledkov
Vnútro- a medziklastrová variabilita
Na základe výsledkov môžeme konštatovať, že vnútroklastrová variabilita je relatívne nízka u väčšiny premenných, čo naznačuje dobrú homogenitu v rámci klastrov. Výnimku tvorí premenná Unemployment, ktorá má vyššiu vnútroklastrovú variabilitu a nižšiu medzi-klastrovú variabilitu (Prop_Between = 0,44), čo znamená, že nie je tak dobrým separátorom ako ostatné premenné. Naopak, premenné StockIndex, GDP_Growth a Inflation vykazujú vyššiu medzi-klastrovú variabilitu (Prop_Between ≥ 0,57), čo indikuje ich silnú schopnosť rozlišovať jednotlivé klastry.
tss <- apply(data_scaled, 2, function(x) sum((x - mean(x))^2))
wss <- sapply(1:3, function(k) {
cluster_data <- data_scaled[data_country$cluster == k, , drop = FALSE]
apply(cluster_data, 2, function(x) sum((x - mean(x))^2))
})
if (is.vector(wss)) wss <- matrix(wss, nrow = 1)
bss <- tss - rowSums(wss)
prop_between <- bss / tss
vn_deskriptiv <- data.frame(
Variable = colnames(data_scaled),
TSS = round(tss, 2),
WSS = round(rowSums(wss), 2),
BSS = round(bss, 2),
Prop_Between = round(prop_between, 2)
)
print(vn_deskriptiv)## Variable TSS WSS BSS Prop_Between
## Inflation Inflation 9 3.85 5.15 0.57
## GDP_Growth GDP_Growth 9 3.72 5.28 0.59
## Unemployment Unemployment 9 5.01 3.99 0.44
## Interest Interest 9 4.43 4.57 0.51
## StockIndex StockIndex 9 3.48 5.52 0.61Centroidy klastrov
Na základe Centroidy klastrov môžeme pozorovať charakteristiky jednotlivých klastrov:
Klastre sú relatívne odlišné vo všetkých premenných, čo potvrdzuje predchádzajúci výsledok Prop_Between.
Klaster 1: stredná inflácia (6,08%), mierny rast HDP (3,18%), vysoká nezamestnanosť (7,49%), úroková miera 4,04% a najnižšia hodnota StockIndex (14983,37).
Klaster 2: nižšia inflácia (4,44%), záporný rast HDP (-3,83%), najnižšia nezamestnanosť (4,07%), úrok 3,92% a najvyšší StockIndex (31764,61).
Klaster 3: najvyššia inflácia (7,81%), vysoký rast HDP (5,56%), vysoká nezamestnanosť (8,97%), úrok 6,61% a stredný StockIndex (23397,65).
centroids <- data_country %>%
group_by(cluster) %>%
summarise(
Inflation_mean = mean(Inflation),
GDP_Growth_mean = mean(GDP_Growth),
Unemployment_mean = mean(Unemployment),
Interest_mean = mean(Interest),
StockIndex_mean = mean(StockIndex)
)
print(centroids)## # A tibble: 3 × 6
## cluster Inflation_mean GDP_Growth_mean Unemployment_mean Interest_mean
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 1 6.08 3.18 7.49 4.04
## 2 2 4.44 -3.83 4.07 3.92
## 3 3 7.81 5.56 8.97 6.61
## # ℹ 1 more variable: StockIndex_mean <dbl>Celkovo je zrejmé, že jednotlivé klastry sa odlišujú predovšetkým v GDP_Growth, Unemployment a StockIndex, pričom klaster 2 predstavuje negatívny ekonomický rast s nízkou nezamestnanosťou, klaster 1 stabilnú ekonomiku s vysokou nezamestnanosťou a klaster 3 dynamickú ekonomiku s vysokou infláciou a úrokmi.
Záver
Na základe vykonanej analýzy makroekonomických ukazovateľov možno konštatovať, že sledované premenné Inflation, GDP_Growth, Unemployment, Interest a StockIndex poskytujú cenné informácie o ekonomickej stabilite a raste krajín.
Analýza odhalila významné vzory a rozdiely medzi ekonomikami, čo umožňuje lepšie porozumenie ich ekonomického profilu a poskytuje podklady pre porovnávaciu štatistiku, politické rozhodovanie a ďalšie ekonometrické modelovanie.
Econometrics in R
Úvod a údaje
Rozhodla som sa modelovať infláciu v USA ako funkciu troch vysvetľujúcich premenných:
GDP_Growth — hospodársky rast
Unemployment — miera nezamestnanosti
Interest_Rate — úroková sadzba
Hypotézy:
H1: Vyšší hospodársky rast znižuje infláciu.
H2: Vyššia nezamestnanosť vedie k nižšiemu inflačnému tlaku.
H3: Vyššia úroková sadzba znižuje infláciu.
Príprava databázy
# Načítanie knižníc
library(zoo)
library(tseries)
library(lmtest)
library(sandwich)
library(car)
library(dplyr)
library(magrittr)##
## Присоединяю пакет: 'magrittr'## Следующий объект скрыт от 'package:purrr':
##
## set_names## Следующий объект скрыт от 'package:tidyr':
##
## extractlibrary(ggplot2)
rm(list = ls())# Načítanie údajov
data <- read.csv("economic_indicators_dataset_2010_2023.csv",
dec = ".", sep = ",", header = TRUE)
# Dátum
data$Date <- as.Date(data$Date)
# Výber USA a užitočných premenných
dataUSA <- data %>%
dplyr::filter(Country == "USA") %>%
dplyr::select(Date,
Inflation.Rate....,
GDP.Growth.Rate....,
Unemployment.Rate....,
Interest.Rate....
) %>%
dplyr::arrange(Date)
# Premenovanie
colnames(dataUSA) <- c("Date","Inflation","GDP_Growth","Unemployment","Interest_Rate")Lineárna regresia
model <- lm(Inflation ~ GDP_Growth + Unemployment + Interest_Rate,
data = dataUSA)
summary(model)##
## Call:
## lm(formula = Inflation ~ GDP_Growth + Unemployment + Interest_Rate,
## data = dataUSA)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.5414 -2.4185 0.3282 2.1848 4.7028
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.52358 1.37798 4.734 1.68e-05 ***
## GDP_Growth -0.05513 0.10357 -0.532 0.5967
## Unemployment -0.25459 0.14127 -1.802 0.0772 .
## Interest_Rate 0.09603 0.12259 0.783 0.4369
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.928 on 53 degrees of freedom
## Multiple R-squared: 0.09918, Adjusted R-squared: 0.04819
## F-statistic: 1.945 on 3 and 53 DF, p-value: 0.1335Odhadnutý lineárny regresný model vykazuje nízku celkovú vysvetľujúcu silu, o čom svedčí koeficient determinácie (R-squared) 0.099, čo znamená, že premenné spolu vysvetľujú len 9,9 % variability inflácie. Celkový model nie je štatisticky významný (p-hodnota F-štatistiky = 0,134).
Posúdenie hypotéz:
H1: Záporný koeficient (-0,055) je v súlade s hypotézou, no je štatisticky nevýznamný (p=0,597). Hypotéza sa nepotvrdzuje.
H2: Záporný koeficient (-0,255) je v súlade s Phillipsovej krivkou a je slabo významný na hladine 10% (p=0,077). Hypotéza je obmedzene podporená.
H3: Kladný koeficient (0,096) je v priamom protiklade s hypotézou a je štatisticky nevýznamný (p=0,437). Hypotéza sa nepotvrdzuje.
Autokorelácia rezíduí
Graf znázorňuje porovnanie empirických (skutočných) hodnôt inflácie v USA s fitovanými hodnotami.
dataUSA <- dataUSA %>%
mutate(fitted = fitted(model))
ggplot(dataUSA, aes(x = Date, y = Inflation)) +
geom_point(color = "blue", size = 2) +
geom_line(aes(y = fitted), color = "red", size = 1) +
labs(title = "Inflation USA: Empirical vs Fitted values",
x = "Date", y = "Inflation (%)") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
- Empirické hodnoty -> dosahujú rozsah 0,0 % až 9,7 % – prejavujú vysokú volatilitu.
Fitované hodnoty -> prevažne sa pohybujú okolo priemeru ~5,0 %, čo naznačuje silnú tendenciu k priemeru.
Kľúčové Zlyhanie -> model podceňuje infláciu po roku 2020; skutočné hodnoty sú nad 9,0 %, zatiaľ čo model predikuje len 5,0 % – 6,5 %.
Čiže model je neefektívny a má nízku presnosť pri zachytávaní extrémnych inflačných šokov.
ACF graf
Graf zobrazuje koreláciu medzi rezíduami (chybami modelu) v rôznych časových oneskoreniach (Lag).
Ide o kľúčový test, ktorý určuje, či model zachytil celú časovú závislosť dát.
res <- residuals(model)
acf(res, lag.max = 12, main = "ACF of residuals")
- Empirické hodnoty -> pri oneskoreniach \(Lag \ge 1\) je zjavné, že existuje výrazná negatívna korelácia pri \(Lag = 1\) (približne \(–0,4\)).
- Kľúčové Zlyhanie -> pretože stĺpec pri \(Lag = 1\) presahuje dolnú signifikačnú hranicu, rezíduá nie sú nezávislé.
To znamená, že chyba modelu v jednom období silne ovplyvňuje chybu v nasledujúcom období.
- Ďalšie oneskorenia -> všetky ostatné oneskorenia (\(Lag = 2, 3, 4, ...\)) sa nachádzajú vo vnútri signifikačných limitov.
Je zrejmé, že koeficient autokorelácie pre posun (\(Lag\) \(k=1\)) je štatisticky významný, keďže jeho hodnota (približne \(-0,4\)) prekračuje dolnú hranicu konfidenčného intervalu (intervalu spoľahlivosti), ktorá je približne \(-0,3\). Ostatné koeficienty sú nevýznamné.
Durbin–Watson test
dwtest(model)##
## Durbin-Watson test
##
## data: model
## DW = 2.8521, p-value = 0.9996
## alternative hypothesis: true autocorrelation is greater than 0- Štatistika \(\text{DW} = 2.8521\) je výrazne vyššia ako hodnota 2.
To indikuje prítomnosť štatisticky významnej negatívnej autokorelácie prvého rádu v rezíduách modelu.
6. Breusch–Godfrey test
bgtest(model, order = 1)##
## Breusch-Godfrey test for serial correlation of order up to 1
##
## data: model
## LM test = 12.326, df = 1, p-value = 0.0004467Zistená hodnota p-value (\(0.0004467\)) je extrémne nízka, t. j. je výrazne nižšia ako štandardná hladina významnosti \(\alpha = 0,05\) (alebo \(\alpha = 0,01\)).
Zamietame nulovú hypotézu o absencii sériovej korelácie. Existuje štatisticky vysoko významná autokorelácia prvého rádu v rezíduách.
Koyckova transformácia
dataUSA <- dataUSA %>%
mutate(Inflation_lag1 = lag(Inflation))
model_koyck <- lm(Inflation ~ GDP_Growth + Unemployment + Interest_Rate +
Inflation_lag1,
data = dataUSA)
summary(model_koyck)##
## Call:
## lm(formula = Inflation ~ GDP_Growth + Unemployment + Interest_Rate +
## Inflation_lag1, data = dataUSA)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.5476 -2.0242 0.3046 1.8316 4.9636
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.67947 1.68796 5.734 5.33e-07 ***
## GDP_Growth -0.08743 0.09804 -0.892 0.37667
## Unemployment -0.33972 0.13907 -2.443 0.01808 *
## Interest_Rate -0.01099 0.11972 -0.092 0.92724
## Inflation_lag1 -0.40149 0.13029 -3.082 0.00332 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.735 on 51 degrees of freedom
## (1 пропущенное наблюдение удалено)
## Multiple R-squared: 0.2342, Adjusted R-squared: 0.1742
## F-statistic: 3.9 on 4 and 51 DF, p-value: 0.007722dwtest(model_koyck)##
## Durbin-Watson test
##
## data: model_koyck
## DW = 2.2805, p-value = 0.8605
## alternative hypothesis: true autocorrelation is greater than 0Hodnota \(p=0,007722\) (z F-testu) potvrdzuje, že je model ako celok štatisticky významný na úrovni \(\alpha=0,01\).
Model vysvetľuje približne \(17,42\%\) variability inflácie (Adjusted \(R^2\)). Táto hodnota je relatívne nízka.
Štatisticky významné sú premenné Nezamestnanosť (\(\text{Unemployment}\), \(p=0,018\)) a Oneskorená inflácia (\(\text{Inflation_lag1}\), \(p=0,003\)). Rast HDP a Úroková sadzba nie sú významné.
Hodnota \(\text{DW} = 2,2805\) je blízka hodnote 2. To signalizuje, že zahrnutie oneskorenej premennej výrazne zlepšilo špecifikáciu modelu a znížilo autokoreláciu rezíduí (v porovnaní s predchádzajúcim modelom).
Model je štatisticky významný a úspešne korigoval problém autokorelácie, avšak jeho celková prediktívna schopnosť je obmedzená (\(R^2 \approx 17\%\)).
Newey–West robustné štandardné chyby
coeftest(model, vcov = NeweyWest(model))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.523581 1.223244 5.3330 2.035e-06 ***
## GDP_Growth -0.055135 0.083573 -0.6597 0.51229
## Unemployment -0.254587 0.113666 -2.2398 0.02932 *
## Interest_Rate 0.096029 0.106435 0.9022 0.37101
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Intercept (Priesečník):
- Koeficient je vysoko štatisticky významný (\(p < 0.001\)), čo naznačuje, že inflácia má nejakú základnú úroveň, aj keď sú všetky vysvetľujúce premenné nulové.
Unemployment (Nezamestnanosť):
- Koeficient \(-0.254587\) je štatisticky významný (\(p = 0.02932\), t. j. \(p < 0.05\)).To naznačuje, že negatívny vzťah medzi nezamestnanosťou a infláciou (podobný Phillipsovej krivke) zostáva významný aj po korekcii na autokoreláciu a heteroskedasticitu.
Nevýznamné premenné:
- GDP_Growth (\(p = 0.51229\)) a Interest_Rate (\(p = 0.37101\)) zostávajú štatisticky nevýznamné. Ich vplyv na infláciu nie je možné štatisticky odlíšiť od nuly, aj keď sú použité robustné chyby.
Záver
Analýza potvrdila, že pôvodný model inflácie bol neadekvátny z dôvodu nízkej vysvetľujúcej sily (\(R^2 \approx 10\%\)) a silnej negatívnej autokorelácie v rezíduách (\(\text{DW}=2,85\)). Zavedenie oneskorenej inflácie (\(\text{Inflation_lag1}\)) problém autokorelácie úspešne eliminovalo (\(\text{DW}=2,28\)), čím sa model stal štatisticky významným.
Model vysvetľuje iba \(17,42\%\) variability inflácie a jedinou robustne významnou premennou je Nezamestnanosť (potvrdenie Phillipsovej krivky), zatiaľ čo \(\text{GDP_Growth}\) a \(\text{Interest_Rate}\) sú nevýznamné. Model je validný, ale má obmedzenú prediktívnu schopnosť a potvrdzuje len negatívny vzťah s nezamestnanosťou.
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....
## 0 0 0
## GDP.Growth.Rate.... Unemployment.Rate.... Interest.Rate....
## 0 0 0
## Stock.Index.Value
## 0if(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
## Min. :0.180 Min. :-4.220 Min. : 2.070 Min. :-0.970
## 1st Qu.:1.885 1st Qu.:-0.220 1st Qu.: 4.075 1st Qu.: 3.217
## Median :5.310 Median : 3.040 Median : 6.660 Median : 5.205
## Mean :5.051 Mean : 2.640 Mean : 6.608 Mean : 5.088
## 3rd Qu.:7.838 3rd Qu.: 5.987 3rd Qu.: 8.473 3rd Qu.: 7.968
## Max. :9.900 Max. : 8.890 Max. :11.910 Max. : 9.900
## Stock_Index_Value
## Min. : 1626
## 1st Qu.:11628
## Median :22372
## Mean :21297
## 3rd Qu.:30324
## Max. :39613Vš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.5274Zá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
## Inflation_Rate 1.000 -0.037 -0.122
## GDP_Growth_Rate -0.037 1.000 0.011
## Unemployment_Rate -0.122 0.011 1.000
## Interest_Rate -0.042 0.080 -0.299
## Interest_Rate
## Inflation_Rate -0.042
## GDP_Growth_Rate 0.080
## Unemployment_Rate -0.299
## Interest_Rate 1.000Korelač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.113964Vš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.520011Condition 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.4458model_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.6775cat("Upravený R² pôvodného modelu:", round(summary(model)$adj.r.squared, 4), "\n")## Upravený R² pôvodného modelu: -0.0174cat("Upravený R² modelu bez inflácie:", round(summary(model_no_inflation)$adj.r.squared, 4), "\n")## Upravený R² modelu bez inflácie: -0.0062cat("Upravený R² modelu bez úrokovej sadzby:", round(summary(model_no_interest)$adj.r.squared, 4), "\n")## Upravený R² modelu bez úrokovej sadzby: -0.0338Vynechaní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.5274vif_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.766056model_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.6569Model 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)## Model R2 Adj_R2 AIC BIC
## Pôvodný model Pôvodný model 0.0731 -0.0174 998.23 1009.20
## Bez inflácie Bez inflácie 0.0608 -0.0062 996.83 1005.98
## Bez úrokovej sadzby Bez úrokovej sadzby 0.0352 -0.0338 998.08 1007.22
## Škálovaný model Škálovaný model 0.0731 -0.0174 998.23 1009.20Vš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.