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ý.