Econometrics in R - cvičenie 5
Diana Hrušovská
S využitím databázy [student_exam_scores] database.
Pri ďalšej práci budeme používať knižnice
library(tidyverse)
library(GGally) # pairs
library(broom) # tidy model outputs
library(car) # VIF
library(caret) # RMSE, trainControl
library(report) # pre pekné reporty Úvod do problému, stanovenie hypotéz
Rozhodla som sa modelovať výsledné skúškové skóre študentov (exam_score) v závislosti od troch vysvetľujúcich premenných:
- počtu hodín štúdia (hours_studied),
- priemerného počtu hodín spánku (sleep_hours),
- a percentuálnej účasti na vyučovaní (attendance_percent).
Cieľom analýzy je overiť, ktoré z týchto faktorov majú štatisticky významný vplyv na dosiahnutý výsledok skúšky a ako silný tento vzťah je. Modelovanie prebehne pomocou viacnásobnej lineárnej regresie, pričom budeme skúmať, či sa zmeny v týchto premenných prejavia v zmene skúškového skóre.
Naša pracovná hypotéza predpokladá štatisticky významný vplyv všetkých troch vysvetľujúcich premenných. Zároveň sa očakáva nasledovný smer účinku jednotlivých faktorov:
Počet hodín štúdia (hours_studied): očakávame pozitívny vplyv – študenti, ktorí venujú viac času príprave, dosahujú lepšie výsledky. (kladné znamienko odhadovaného regresného koeficienta)
Počet hodín spánku (sleep_hours): predpokladáme pozitívny vplyv, keďže dostatok spánku zlepšuje koncentráciu a výkon. (kladné znamienko koeficienta)
Účasť na vyučovaní (attendance_percent): očakávame pozitívny vplyv, pretože pravidelná účasť na hodinách zvyšuje pochopenie látky a teda aj úspešnosť. (kladné znamienko koeficienta)
Formálne teda stanovujeme nasledovné hypotézy:
H₁: Premenné hours_studied, sleep_hours a attendance_percent majú štatisticky významný vplyv na exam_score.
H₀: Medzi exam_score a uvedenými vysvetľujúcimi premennými neexistuje štatisticky významný vzťah.
# Načítanie dát ----------------------------------------------------------
df <- read_csv("student_exam_scores.csv")
# Rýchly prehľad
glimpse(df)Rows: 200
Columns: 6
$ student_id <chr> "S001", "S002", "S003", "S004", "S005", "S006", "S007", "S008", "S009", "S010", "S011", "…
$ hours_studied <dbl> 8.0, 1.3, 4.0, 3.5, 9.1, 8.4, 10.8, 2.0, 5.6, 1.3, 3.4, 6.6, 1.3, 3.2, 8.1, 7.0, 3.4, 7.5…
$ sleep_hours <dbl> 8.8, 8.6, 8.2, 4.8, 6.4, 5.1, 6.0, 4.3, 5.9, 8.9, 5.3, 7.9, 6.3, 6.1, 8.8, 9.0, 6.8, 7.6,…
$ attendance_percent <dbl> 72.1, 60.7, 73.7, 95.1, 89.8, 58.5, 54.2, 75.8, 81.6, 66.8, 90.9, 87.6, 83.6, 61.2, 60.0,…
$ previous_scores <dbl> 45, 55, 86, 66, 71, 75, 88, 55, 84, 70, 81, 85, 71, 68, 90, 41, 45, 58, 54, 65, 84, 55, 5…
$ exam_score <dbl> 30.2, 25.0, 35.8, 34.0, 40.3, 35.7, 37.9, 18.3, 34.7, 24.7, 29.3, 35.1, 31.2, 30.2, 41.1,…summary(df) student_id hours_studied sleep_hours attendance_percent previous_scores exam_score
Length:200 Min. : 1.000 Min. :4.000 Min. : 50.30 Min. :40.0 Min. :17.10
Class :character 1st Qu.: 3.500 1st Qu.:5.300 1st Qu.: 62.20 1st Qu.:54.0 1st Qu.:29.50
Mode :character Median : 6.150 Median :6.700 Median : 75.25 Median :67.5 Median :34.05
Mean : 6.325 Mean :6.622 Mean : 74.83 Mean :66.8 Mean :33.95
3rd Qu.: 9.000 3rd Qu.:8.025 3rd Qu.: 87.42 3rd Qu.:80.0 3rd Qu.:38.75
Max. :12.000 Max. :9.000 Max. :100.00 Max. :95.0 Max. :51.30 # ukáž prvých 10 riadkov
print(head(df, 10))
# Čistenie a kontrola ---------------------------------------------------
# Skontrolujeme chýbajúce hodnoty
map_dfr(df, ~sum(is.na(.x))) %>% gather(var, missing) %>% print()
# Ak sú chýbajúce hodnoty a chceš ich odstrániť:
df <- df %>% drop_na()
df <- df %>% mutate(student_id = as.character(student_id))
# Prieskumná analýza (EDA) -----------------------------------------------
# Popisné štatistiky pre numerické premenné
num_vars <- df %>% select_if(is.numeric)
summary(num_vars) hours_studied sleep_hours attendance_percent previous_scores exam_score
Min. : 1.000 Min. :4.000 Min. : 50.30 Min. :40.0 Min. :17.10
1st Qu.: 3.500 1st Qu.:5.300 1st Qu.: 62.20 1st Qu.:54.0 1st Qu.:29.50
Median : 6.150 Median :6.700 Median : 75.25 Median :67.5 Median :34.05
Mean : 6.325 Mean :6.622 Mean : 74.83 Mean :66.8 Mean :33.95
3rd Qu.: 9.000 3rd Qu.:8.025 3rd Qu.: 87.42 3rd Qu.:80.0 3rd Qu.:38.75
Max. :12.000 Max. :9.000 Max. :100.00 Max. :95.0 Max. :51.30 # Histogramy (všetky numerické)
num_vars %>% gather(variable, value) %>%
ggplot(aes(x = value)) +
geom_histogram(bins = 30) +
facet_wrap(~variable, scales = "free") +
labs(title = "Histogramy numerických premenných")
# Boxploty proti exam_score pre vybrané prediktory
ggplot(df, aes(x = 1, y = exam_score)) +
geom_boxplot() +
labs(title = "Boxplot exam_score (všetky hodnoty)")
# Párové grafy / korelácie
GGally::ggpairs(df %>% select(-student_id))
# Korelačná matica
cor_mat <- cor(df %>% select_if(is.numeric))
print(round(cor_mat, 3)) hours_studied sleep_hours attendance_percent previous_scores exam_score
hours_studied 1.000 0.078 -0.031 0.069 0.777
sleep_hours 0.078 1.000 0.001 -0.194 0.188
attendance_percent -0.031 0.001 1.000 0.052 0.226
previous_scores 0.069 -0.194 0.052 1.000 0.431
exam_score 0.777 0.188 0.226 0.431 1.000# Vytvorenie lineárneho modelu -------------------------------------------
# Predpokladáme, že cieľová premenná je exam_score a ostatné sú prediktory
model <- lm(exam_score ~ hours_studied + sleep_hours + attendance_percent + previous_scores,
data = df)
# Rýchle zhrnutie modelu
summary(model)
Call:
lm(formula = exam_score ~ hours_studied + sleep_hours + attendance_percent +
previous_scores, data = df)
Residuals:
Min 1Q Median 3Q Max
-5.5455 -2.1818 -0.0847 2.3436 4.8390
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -2.14209 1.67079 -1.282 0.201
hours_studied 1.55526 0.06044 25.732 < 2e-16 ***
sleep_hours 0.95226 0.13243 7.191 1.34e-11 ***
attendance_percent 0.10839 0.01362 7.961 1.38e-13 ***
previous_scores 0.17728 0.01267 13.995 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.731 on 195 degrees of freedom
Multiple R-squared: 0.8414, Adjusted R-squared: 0.8382
F-statistic: 258.7 on 4 and 195 DF, p-value: < 2.2e-16# Upratané výsledky cez broom
tidy(model) # koeficienty s p-hodnotamiglance(model) # R^2, AIC, BIC, RMSE (residual sd), atď.augment(model) %>% head()
# Diagnostika modelu -----------------------------------------------------
# Reziduá vs fitted
plot(model, which = 1) # residuals vs fitted
# QQ plot - normálne rozdelenie reziduí
plot(model, which = 2) # QQ
# Cook's distance (influential points)
plot(model, which = 4)
# Multikolinearita (VIF)
car::vif(model) # >5 alebo >10 varovať hours_studied sleep_hours attendance_percent previous_scores
1.014944 1.048547 1.004142 1.050271 # Výpočet RMSE a ďalších metrík -----------------------------------------
preds <- predict(model, newdata = df)
rmse_val <- sqrt(mean((df$exam_score - preds)^2))
mae_val <- mean(abs(df$exam_score - preds))
r2 <- summary(model)$r.squared
cat("RMSE:", round(rmse_val,3), "MAE:", round(mae_val,3), "R2:", round(r2,3), "\n")RMSE: 2.697 MAE: 2.287 R2: 0.841 # Alternatívne: cross-validated RMSE cez caret (10-fold CV)
set.seed(123)
train_control <- trainControl(method = "cv", number = 10)
cv_model <- train(exam_score ~ hours_studied + sleep_hours + attendance_percent + previous_scores,
data = df,
method = "lm",
trControl = train_control)
print(cv_model)Linear Regression
200 samples
4 predictor
No pre-processing
Resampling: Cross-Validated (10 fold)
Summary of sample sizes: 180, 180, 180, 180, 180, 179, ...
Resampling results:
RMSE Rsquared MAE
2.771046 0.850901 2.3605
Tuning parameter 'intercept' was held constant at a value of TRUEcv_model$results
# Graf predikcie vs skutočnosť ------------------------------------------
df_plot <- df %>% mutate(predicted = preds)
ggplot(df_plot, aes(x = predicted, y = exam_score)) +
geom_point() +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
labs(title = "Predikované vs Skutočné exam_score",
x = "Predikované hodnoty",
y = "Skutočné hodnoty")
# Scatter s lineárnym fitom medzi konkrétnym prediktorom a exam_score
ggplot(df, aes(x = hours_studied, y = exam_score)) +
geom_point() +
geom_smooth(method = "lm", se = TRUE) +
labs(title = "Exam score vs Hours studied")
NA
NAInterpretácia konkrétneho grafu
Na grafe nižšie je znázornený vzťah medzi počtom hodín, ktoré študent venoval štúdiu (hours_studied), a jeho výsledným skóre na skúške (exam_score). Každý bod predstavuje jedného študenta, pričom na osi X je zobrazený počet hodín štúdia a na osi Y výsledné skóre. Do grafu bola pridaná aj regresná priamka, ktorá znázorňuje trend medzi oboma premennými.
Z grafu môžeme pozorovať, že so zvyšujúcim sa počtom hodín štúdia má exam_score tendenciu rásť. To znamená, že medzi týmito dvoma premennými existuje pozitívna lineárna závislosť – čím viac času študent venoval príprave, tým lepšie výsledky na skúške dosiahol. Regresná priamka má kladný smerový koeficient, čo potvrdzuje očakávanie z pracovnej hypotézy (H₁), že počet hodín štúdia má pozitívny vplyv na skúškové skóre.
Zároveň môžeme vidieť mierny rozptyl hodnôt okolo regresnej priamky, čo naznačuje, že aj keď štúdium významne ovplyvňuje výsledok, na výkone študenta sa môžu podieľať aj iné faktory – napríklad kvalita spánku, účinnosť učenia alebo priebežná aktivita počas semestra.
Q-Q plot
Čo ukazuje
- Os X: Teoretické kvantily – hodnoty, ktoré by sme
očakávali, ak by rezíduá boli dokonale normálne rozložené.
- Os Y: Štandardizované rezíduá – skutočné kvantily
vypočítané z dát nášho modelu.
- 45° prerušovaná čiara: Ideálny prípad – ak sú rezíduá normálne rozložené, body by mali ležať tesne pozdĺž tejto čiary.
Interpretácia konkrétneho grafu
Celkový tvar:
Väčšina bodov leží blízko priamky, čo naznačuje, že rezíduá sú
približne normálne rozložené. Predpoklad normality
modelových chýb sa teda javí ako vo veľkej miere splnený.
Krajné hodnoty (extrémy):
Na oboch koncoch grafu (vľavo dole a vpravo hore) možno pozorovať mierne
odchýlky od 45° čiary. To poukazuje na menšie odchýlky od
normality v chvostoch rozdelenia – teda niekoľko odľahlých
hodnôt alebo mierne ťažšie konce, než by mal ideálny normálny tvar.
Stredná oblasť:
V strednej časti grafu (približne v intervale −1 až +1 kvantily) sa body
veľmi dobre zhodujú s teoretickou priamkou, čo znamená, že väčšina
rezíduí zodpovedá normálnemu rozdeleniu.
Na záver možno konštatovať, že model v zásade spĺňa
predpoklad normality rezíduí.
Mierne odchýlky v koncoch však naznačujú, že by sa mohol vyskytovať
menší počet odľahlých pozorovaní, čo si vyžaduje dodatočnú kontrolu
pomocou doplnkových testov (napr. Shapiro–Wilk test, analýza Cookovej
vzdialenosti).
Scale location plot
Interpretácia vášho konkrétneho grafu
Body sú rovnomerne rozptýlené pozdĺž osi X bez zreteľného vzoru, čo naznačuje, že rozptyl rezíduí je približne konštantný. Tento jav sa označuje ako homoskedasticita, teda predpoklad rovnakého rozptylu chýb pre všetky úrovne predikovaných hodnôt je vo všeobecnosti splnený.
Červená vyhladzovacia (LOESS) čiara je relatívne rovná a bez
výraznej krivky,
čo podporuje záver, že so zvyšujúcimi sa vyrovnanými hodnotami sa
variancia rezíduí systematicky nemení.
Niekoľko bodov je síce mierne vzdialených od hlavného zhluku (hodnoty
nad 1,5 na osi Y), avšak nejde o extrémne odľahlé pozorovania.
Celkovo teda môžeme konštatovať, že predpoklad konštantnej
variability (homoskedasticity) je splnený a model neprejavuje
žiadne závažné známky heteroskedasticity.
Interpretácia vášho konkrétneho grafu
Väčšina pozorovaní má nízky pákový efekt (hodnoty pod 0,05), čo
naznačuje, že jednotlivé body nemajú výrazný vplyv na tvar regresnej
priamky.
To je typické pre dobre rozložené údaje, kde žiadny študent nevyčnieva
extrémnymi hodnotami v premenných ako hours_studied,
sleep_hours alebo attendance_percent.
Jeden až dva body sa však mierne oddeľujú od ostatných (napr. v
oblasti pákového efektu okolo 0,2).
Ide o pozorovania so zvýšenou pákou, teda ich hodnoty
prediktorov sú ďalej od väčšiny údajov — napríklad študent s extrémne
nízkym počtom hodín spánku alebo veľmi vysokým počtom hodín štúdia.
Väčšina štandardizovaných rezíduí sa nachádza medzi hodnotami −2 a +2, čo znamená, že neexistujú žiadne závažné odľahlé hodnoty v závislej premennej (exam_score).
Kontúry Cookovej vzdialenosti ukazujú, že žiaden z bodov
neprekračuje hranice 0,5 či 1,0,
preto žiadne pozorovanie nemá výrazne neprimeraný vplyv
na odhady regresných koeficientov.
Celkovo možno konštatovať, že model nie je citlivý na jednotlivé pozorovania a nie sú prítomné extrémne vplyvné body, ktoré by mohli skresľovať výsledky regresie.
Conclusion
Premenné hours_studied a attendance_percent majú štatisticky významný pozitívny vplyv na výsledné skúškové skóre študentov – teda čím viac času študent venuje štúdiu a čím pravidelnejšie sa zúčastňuje vyučovania, tým vyššie skóre dosahuje.
Premenná sleep_hours sa ukázala ako menej významná, pričom jej vplyv na výsledok skúšky nebol jednoznačný – v modeli sa prejavuje s malým alebo neinterpretovateľným účinkom.
Rezíduá nevykazujú úplne dokonalé normálne rozdelenie, avšak vzhľadom na dostatočne veľký počet pozorovaní môžeme model považovať za spoľahlivý a vhodný na interpretáciu.
Z diagnostických grafov taktiež vyplýva, že v modeli sa
nepreukazujú žiadne výrazné nelinearity, heteroskedasticita ani vplyvné
pozorovania.
Model teda pomerne dobre vystihuje vzťah medzi študijnými návykmi a
výsledným skúškovým skóre.