Lineárna regresia
Nina Majdáková
2025-10-26
data<- read.csv("index.csv",check.names=FALSE)Stiahnutie knižníc:
# Balíčky
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(stringr)
library(forcats)
library(ggplot2)
library(broom)
library(gt)
# Funkcia pick_col
pick_col <- function(df, choices) intersect(choices, names(df))[1]#Správny výber stĺpca
fg_col <- pick_col(data, c("IndexFG", "Index finančnej gramotnosti"))
prijem_col <- pick_col(data, c("AkýjeVášmesačnýpríjem", "Aký je Váš mesačný príjem?"))# čo sa vybralo?
fg_col; prijem_col## [1] "IndexFG"## [1] "AkýjeVášmesačnýpríjem"# skuska
str(data[[fg_col]])## num [1:392] 10 9 10 4 1 9 9 6 9 8 ...head(unique(data[[prijem_col]]), 10)## [1] "1600€ a viac" "401 - 800€" "0 - 400€" "801 - 1000€" "1001 - 1200€"
## [6] "1201 - 1600€"Stredné hodnoty
Keďže v dotazníku respondenti neuvádzali presnú sumu, ale intervaly (napr. „401 – 800 €“), tak sme pomocou funkcie income_mid() premenili na stredy pásiem:
income_mid <- function(x) {
x <- as.character(x)
x <- stringr::str_squish(x)
x <- stringr::str_replace_all(x, "[–—]", "-")
x <- stringr::str_replace_all(x, "€", "")
dplyr::case_when(
x %in% c("0-400", "0 - 400") ~ 200,
x %in% c("401-800", "401 - 800") ~ 600.5,
x %in% c("801-1200", "801 - 1200") ~ 1000.5,
x %in% c("1201-1600", "1201 - 1600") ~ 1400.5,
stringr::str_detect(x, "^1600") ~ 1800, # "1600 a viac", "1600+"
TRUE ~ NA_real_
)
}library(readr)
reg_df <- data %>%
mutate(
FG_index = parse_number(as.character(.data[[fg_col]])),
Prijem_mid = income_mid(.data[[prijem_col]])
) %>%
filter(!is.na(FG_index), !is.na(Prijem_mid))
nrow(data); nrow(reg_df)## [1] 392## [1] 339summary(reg_df[, c("FG_index","Prijem_mid")])## FG_index Prijem_mid
## Min. : 1.000 Min. : 200.0
## 1st Qu.: 6.000 1st Qu.: 200.0
## Median : 8.000 Median : 600.5
## Mean : 7.422 Mean : 686.3
## 3rd Qu.: 9.000 3rd Qu.:1400.5
## Max. :10.000 Max. :1800.0var(reg_df$FG_index, na.rm = TRUE); var(reg_df$Prijem_mid, na.rm = TRUE)## [1] 4.197274## [1] 347172.1Hypotézy
Definujeme hypotézy:
H0: Neexistuje štatisticky významná
závislosť medzi úrovňou finančnej gramotnosti a mesačným príjmom.
H1: Existuje štatisticky významná závislosť
medzi úrovňou finančnej gramotnosti a mesačným príjmom.
Regresný model
Na analýzu vzťahu medzi úrovňou finančnej gramotnosti a výškou mesačného príjmu sme použili lineárnu regresiu. Ako nezávislá premenná bol zaradený index finančnej gramotnosti, zatiaľ čo závislou premennou bol mesačný príjem
stopifnot(nrow(reg_df) > 1)
model_fg_prijem <- lm(Prijem_mid ~ FG_index, data = reg_df)
summary(model_fg_prijem)##
## Call:
## lm(formula = Prijem_mid ~ FG_index, data = reg_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -540.3 -477.5 -118.8 681.1 1248.0
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 531.10 120.29 4.415 1.36e-05 ***
## FG_index 20.92 15.63 1.339 0.182
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 588.5 on 337 degrees of freedom
## Multiple R-squared: 0.005289, Adjusted R-squared: 0.002338
## F-statistic: 1.792 on 1 and 337 DF, p-value: 0.1816confint(model_fg_prijem)## 2.5 % 97.5 %
## (Intercept) 294.485856 767.71836
## FG_index -9.818684 51.65126anova(model_fg_prijem)## Analysis of Variance Table
##
## Response: Prijem_mid
## Df Sum Sq Mean Sq F value Pr(>F)
## FG_index 1 620659 620659 1.7919 0.1816
## Residuals 337 116723512 346361`
table(stringr::str_replace_all(stringr::str_squish(data[[prijem_col]]), "[–—]", "-"), useNA="ifany")##
## 0 - 400€ 1001 - 1200€ 1201 - 1600€ 1600€ a viac 401 - 800€ 801 - 1000€
## 152 28 39 49 99 25library(readr)
reg_df <- data %>%
mutate(
FG_index = readr::parse_number(as.character(.data[[fg_col]])),
raw_income = readr::parse_number(as.character(.data[[prijem_col]]))
) %>%
mutate(
Prijem_int = cut(raw_income,
breaks = c(-Inf, 400, 800, 1200, 1600, Inf),
labels = c("0 - 400€","401 - 800€","801 - 1200€","1201 - 1600€","1600€ a viac"),
include.lowest = TRUE, right = TRUE),
Prijem_mid = dplyr::case_when(
Prijem_int == "0 - 400€" ~ 200,
Prijem_int == "401 - 800€" ~ 600.5,
Prijem_int == "801 - 1200€" ~ 1000.5,
Prijem_int == "1201 - 1600€" ~ 1400.5,
Prijem_int == "1600€ a viac" ~ 1800,
TRUE ~ NA_real_
)
) %>%
filter(!is.na(FG_index), !is.na(Prijem_mid))#kontrola
nrow(data); nrow(reg_df)## [1] 392## [1] 392summary(reg_df[, c("FG_index","Prijem_mid")])## FG_index Prijem_mid
## Min. : 1.000 Min. : 200.0
## 1st Qu.: 6.000 1st Qu.: 200.0
## Median : 8.000 Median : 600.5
## Mean : 7.352 Mean : 678.9
## 3rd Qu.: 9.000 3rd Qu.:1000.5
## Max. :10.000 Max. :1400.5model_fg_prijem <- lm(Prijem_mid ~ FG_index, data = reg_df)
summary(model_fg_prijem)##
## Call:
## lm(formula = Prijem_mid ~ FG_index, data = reg_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -491.31 -477.22 -81.42 332.66 751.44
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 644.364 87.509 7.363 1.07e-12 ***
## FG_index 4.694 11.453 0.410 0.682
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 471.6 on 390 degrees of freedom
## Multiple R-squared: 0.0004306, Adjusted R-squared: -0.002132
## F-statistic: 0.168 on 1 and 390 DF, p-value: 0.6821confint(model_fg_prijem)## 2.5 % 97.5 %
## (Intercept) 472.31696 816.41194
## FG_index -17.82341 27.21213anova(model_fg_prijem)## Analysis of Variance Table
##
## Response: Prijem_mid
## Df Sum Sq Mean Sq F value Pr(>F)
## FG_index 1 37362 37362 0.168 0.6821
## Residuals 390 86735404 222398# GT tabuľka výsledkov
broom::tidy(model_fg_prijem, conf.int = TRUE) |>
dplyr::mutate(term = dplyr::recode(term,
"(Intercept)" = "Konštanta",
"FG_index" = "Index finančnej gramotnosti (1 bod)"
)) |>
gt::gt() |>
gt::fmt_number(columns = c(estimate, std.error, statistic, p.value, conf.low, conf.high), decimals = 3) |>
gt::cols_label(
term = "Premenná",
estimate = "Odhad",
std.error = "Št. chyba",
statistic = "t",
p.value = "p-hodnota",
conf.low = "95% CI – dol",
conf.high= "95% CI – hor"
) |>
gt::tab_header(title = gt::md("**Lineárna regresia: Mesačný príjem (stred pásma) ~ Index FG**")) |>
gt::opt_row_striping()| Lineárna regresia: Mesačný príjem (stred pásma) ~ Index FG | ||||||
| Premenná | Odhad | Št. chyba | t | p-hodnota | 95% CI – dol | 95% CI – hor |
|---|---|---|---|---|---|---|
| Konštanta | 644.364 | 87.509 | 7.363 | 0.000 | 472.317 | 816.412 |
| Index finančnej gramotnosti (1 bod) | 4.694 | 11.453 | 0.410 | 0.682 | −17.823 | 27.212 |
# Graf
ggplot(reg_df, aes(FG_index, Prijem_mid)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = TRUE) +
labs(
title = "Mesačný príjem (stred pásma) ~ Index finančnej gramotnosti",
x = "Index finančnej gramotnosti (0–100)",
y = "Mesačný príjem (EUR)"
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
summary(model_fg_prijem)##
## Call:
## lm(formula = Prijem_mid ~ FG_index, data = reg_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -491.31 -477.22 -81.42 332.66 751.44
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 644.364 87.509 7.363 1.07e-12 ***
## FG_index 4.694 11.453 0.410 0.682
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 471.6 on 390 degrees of freedom
## Multiple R-squared: 0.0004306, Adjusted R-squared: -0.002132
## F-statistic: 0.168 on 1 and 390 DF, p-value: 0.6821Výsledky
Výsledky ukázali, že koeficient pri premennej Index finančnej gramotnosti má kladné znamienko (β₁ = 4.694), čo naznačuje, že s rastúcou úrovňou finančnej gramotnosti sa zvyšuje aj mesačný príjem. Tento vzťah však nie je štatisticky významný (p = 0.682), pričom 95 % interval spoľahlivosti (−17.82; 27.21) obsahuje nulovú hodnotu.
Koeficient determinácie R² = 0.0004 naznačuje, že úroveň finančnej gramotnosti vysvetľuje len zanedbateľnú časť variability mesačných príjmov.
Z uvedeného vyplýva, že v rámci analyzovanej vzorky študentov FMUK sa nepotvrdila štatisticky významná lineárna závislosť medzi finančnou gramotnosťou a výškou mesačného príjmu. Napriek tomu má koeficient pozitívne znamienko, čo naznačuje, že študenti s vyššou finančnou gramotnosťou majú tendenciu dosahovať mierne vyššie príjmy.
Aj keď má regresný koeficient pozitívne znamienko (β₁ = 4.694), čo naznačuje, že vyššia úroveň finančnej gramotnosti môže byť spojená s mierne vyšším príjmom, tento vzťah nie je štatisticky významný.
Inými slovami, v analyzovanej vzorke študentov FMUK sa nepreukázalo, že by úroveň finančnej gramotnosti významne ovplyvňovala výšku ich mesačného príjmu.
Preto hypotézu H0 nezamietame a alternatívnu hypotézu H1 nepotvrdzujeme.
GRAFICKÁ ANALÝZA REZÍDUÍ
Výpočet rezíduí a predikcií
reg_df$rezidua <- residuals(model_fg_prijem)
reg_df$pred <- fitted(model_fg_prijem)1) Reziduá vs predikcie
ggplot(reg_df, aes(x = pred, y = rezidua)) +
geom_point(color = "#2E64A7", alpha = 0.6) +
geom_hline(yintercept = 0, color = "red", linewidth = 1) +
labs(
title = "Graf 1: Reziduá vs. Predikcie",
x = "Predikované hodnoty (ŷ)",
y = "Reziduá"
) +
theme_minimal()
Graf 1
Body v grafe sú rozmiestnené pomerne rovnomerne okolo nulovej osi bez viditeľného trendu. Nevyskytuje sa systematické zakrivenie ani výrazná asymetria, čo naznačuje, že predpoklad linearity modelu je splnený a model neobsahuje výraznú štruktúrnu chybu.Zároveň sa nevyskytujú extrémne odľahlé hodnoty, ktoré by ovplyvňovali odhad koeficientov.
2) QQ-plot (normalita rezíduí)
ggplot(reg_df, aes(sample = rezidua)) +
stat_qq(color = "#2E64A7") +
stat_qq_line(color = "red") +
labs(
title = "Graf 2: QQ-plot rezíduí",
x = "Teoretické kvantily",
y = "Empirické kvantily"
) +
theme_minimal()
Graf 2
Väčšina bodov sa nachádza v blízkosti červenej referenčnej priamky, čo naznačuje, že rozdelenie rezíduí sa približuje normálnemu rozdeleniu. Menšie odchýlky na koncoch grafu (v oblasti extrémnych hodnôt) sú bežné a nepredstavujú závažné porušenie predpokladu normality. Tento predpoklad možno teda považovať za približne splnený.
3) Histogram rezíduí
ggplot(reg_df, aes(x = rezidua)) +
geom_histogram(binwidth = 50, fill = "#2E64A7", color = "white", alpha = 0.8) +
labs(
title = "Graf 3: Histogram rezíduí",
x = "Reziduá",
y = "Frekvencia"
) +
theme_minimal()
Graf 3
Histogram zobrazuje viacero vrcholov, čo odráža skutočnosť, že príjem bol v dátach pôvodne kategorizovaný do intervalov. Napriek tomu je rozdelenie relatívne symetrické okolo nuly, bez extrémnych výkyvov. Preto možno predpokladať, že reziduá sú rozdelené približne symetricky, aj keď nie dokonale normálne.
4) Rozptyl rezíduí
ggplot(reg_df, aes(x = pred, y = sqrt(abs(rezidua)))) +
geom_point(color = "#2E64A7", alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(
title = "Graf 4: Scale-Location graf",
x = "Predikované hodnoty",
y = expression(sqrt("|Reziduá|"))
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
### Graf 4
Graf zobrazuje štandardizované reziduá voči predikovaným hodnotám. Červená krivka je relatívne vodorovná a nevykazuje rastúci ani klesajúci trend. To naznačuje, že rozptyl rezíduí je približne konštantný. Neexistujú dôkazy o tom, že by variabilita chýb rástla alebo klesala s úrovňou predikcie.
TEST HETEROSKEDASTICITY
Jedným z dôležitých predpokladov lineárneho regresného modelu je rovnomernosť rozptylu rezíduí, tzv. homoskedasticita.Tento predpoklad znamená, že variabilita chýb modelu by mala byť približne rovnaká pre všetky hodnoty predikcií. Ak by sa rozptyl chýb zvyšoval alebo znižoval v závislosti od úrovne predikovaných hodnôt, hovoríme o heteroskedasticite, ktorá môže ovplyvniť presnosť a spoľahlivosť odhadnutých koeficientov modelu.
Na overenie tohto predpokladu sme formulovali nasledovné hypotézy:
H0: Reziduá majú konštantný rozptyl
(homoskedasticita).
H1: Reziduá nemajú konštantný rozptyl – v
modeli je prítomná heteroskedasticita.
Na testovanie týchto hypotéz bol použitý Breusch–Paganov test, ktorý vyhodnocuje, či rozptyl rezíduí závisí od predikovaných hodnôt modelu.
library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericbptest(model_fg_prijem)##
## studentized Breusch-Pagan test
##
## data: model_fg_prijem
## BP = 0.89926, df = 1, p-value = 0.343Keďže p-hodnota (0.343) je vyššia ako stanovená hladina významnosti α = 0.05, nezamietame nulovú hypotézu H₀, ktorá predpokladá rovnomerný rozptyl rezíduí.
To znamená, že v modeli nebola zistená heteroskedasticita a rozptyl chýb možno považovať za konštantný.
Tento výsledok potvrdzuje, že predpoklady lineárnej regresie sú splnené a model je z tohto hľadiska štatisticky spoľahlivý.
NELINEÁRNE ŠPECIFIKÁCIE
Ramseyho RESET test – kontrola funkčnej formy
Budeme testovať hypotézu
Definujeme hypotézy:
H0: Model je správne špecifikovaný.
H1: Model je nesprávne špecifikovaný.
library(lmtest)
resettest(model_fg_prijem)##
## RESET test
##
## data: model_fg_prijem
## RESET = 0.42426, df1 = 2, df2 = 388, p-value = 0.6546Ramseyho RESET test skúma, či je lineárna funkčná forma modelu správne špecifikovaná. V našom prípade test ukázal hodnotu p = 0.6546, čo je výrazne viac ako hladina významnosti α = 0.05.
Preto nezamietame nulovú hypotézu H₀, podľa ktorej je model špecifikovaný správne.
To znamená, že na základe RESET testu nemáme dôkazy o tom, že by lineárna funkčná forma medzi finančnou gramotnosťou a príjmom bola nevhodná. Modelu pravdepodobne nechýbajú žiadne podstatné nelineárne transformácie ani ďalšie premenné.
Component + Residual (C+R) graf pre FG_index
C+R graf pomáha zistiť, či je vzťah medzi vysvetľujúcou premennou a závislou premennou približne lineárny, alebo má nelineárny tvar.
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recodecrPlots(model_fg_prijem)
C+R graf pre premennú FG_index ukazuje, že hladká krivka takmer presne
kopíruje lineárnu priamku. Nevyskytuje sa výrazné zakrivenie ani
odchýlky, ktoré by naznačovali nelineárny vzťah.
Tento graf teda podporuje správnosť lineárnej špecifikácie modelu a neindikuje potrebu doplniť kvadratický alebo iný nelineárny člen.
Rozšírený model s kvadratickým členom
Na základe RESET testu a C+R grafov môžeme vyskúšať nelineárnu špecifikáciu, kde pridáme kvadrát indexu finančnej gramotnosti:
model_fg_kvadr <- lm(Prijem_mid ~ FG_index + I(FG_index^2), data = reg_df)
summary(model_fg_kvadr)##
## Call:
## lm(formula = Prijem_mid ~ FG_index + I(FG_index^2), data = reg_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -501.68 -470.72 -77.87 336.74 737.09
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 691.842 182.515 3.791 0.000174 ***
## FG_index -12.355 58.630 -0.211 0.833207
## I(FG_index^2) 1.334 4.499 0.297 0.766988
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 472.1 on 389 degrees of freedom
## Multiple R-squared: 0.0006565, Adjusted R-squared: -0.004482
## F-statistic: 0.1278 on 2 and 389 DF, p-value: 0.8801Po doplnení kvadratického člena FG_index² sa ukázalo, že ani lineárny, ani kvadratický koeficient nie sú štatisticky významné (p = 0.833 a p = 0.766).
Upravený koeficient determinácie Adjusted R² sa dokonca znížil na hodnotu približne −0.0048, čo naznačuje zhoršenie modelu oproti pôvodnej verzii.
To znamená, že kvadratická úprava nepriniesla žiadne zlepšenie vysvetľovacej schopnosti modelu, a teda nelineárna špecifikácia nie je v tomto prípade vhodná.
Porovnanie lineárneho a kvadratického modelu – ANOVA
Teraz porovnáme pôvodný lineárny model a kvadratický model pomocou ANOVA testu:
anova(model_fg_prijem, model_fg_kvadr)## Analysis of Variance Table
##
## Model 1: Prijem_mid ~ FG_index
## Model 2: Prijem_mid ~ FG_index + I(FG_index^2)
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 390 86735404
## 2 389 86715804 1 19601 0.0879 0.767ANOVA test porovnal pôvodný lineárny model a model doplnený o kvadratický člen FG_index². Výsledok testu ukázal p = 0.767, čo je vysoko nad hladinou významnosti α = 0.05.
Preto nezamietame H₀ a konštatujeme, že kvadratický člen FG_index² štatisticky významne nezlepšuje model.
Jednoduchý lineárny model preto zostáva preferovanou špecifikáciou.
RESET test pre kvadratický model
resettest(model_fg_kvadr)##
## RESET test
##
## data: model_fg_kvadr
## RESET = 0.56647, df1 = 2, df2 = 387, p-value = 0.568RESET test aplikovaný na kvadratický model ukázal p = 0.568, čo opäť znamená, že nezamietame H₀ o správnej špecifikácii.
Túto úpravu však nemožno považovať za prínosnú, pretože model sa nezlepšil a koeficienty ostali štatisticky nevýznamné.
Box–Coxov test transformácie
library(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectboxcox(model_fg_prijem)
Box–Coxova transformácia ukázala, že maximum logaritmickej vierohodnosti sa nachádza pri hodnote λ približne medzi 0.8 a 1.2.
Najvhodnejšia transformácia závislej premennej je preto λ ≈ 1, čo znamená, že nie je potrebná žiadna transformácia príjmu (ani logaritmus, ani odmocnina).
Tento výsledok ďalej podporuje vhodnosť použitia pôvodného lineárneho modelu.
ZHRNUTIE
Na základe Ramseyho RESET testu, C+R grafov, kvadratického modelu, ANOVA testu a Box–Coxovej transformácie možno konštatovať, že lineárna špecifikácia modelu je v našich dátach primeraná a postačujúca.
RESET test s p = 0.6546 nepreukázal nesprávnu funkčnú formu. C+R grafy neukázali žiadne zakrivenia. Kvadratický model nepriniesol zlepšenie ani po stránke štatistickej významnosti, ani po stránke vysvetľovanej variability. ANOVA potvrdila, že doplnenie kvadratického člena FG_index² nezlepšuje model (p = 0.767). Box–Cox test ukázal, že nie je potrebná transformácia závislej premennej.
Záverom možno povedať, že najvhodnejší model opisujúci vzťah medzi finančnou gramotnosťou a mesačným príjmom je jednoduchý lineárny model.