library (readxl)
library(broom)
library(knitr)
library(kableExtra)
library(ggplot2)Econometrics in R – cvičenie 4
Prvé zoznámenie s lineárnou regresiou
install.packages(c("knitr", "rmarkdown", "broom", "kableExtra", "ggplot2", "readxl"))1 Predmet výskumu
V tomto cvičení ukážem, ako môžeme pomocou R odhadnúť a aj interpretovať lineárnu regresiu na údajoch z databázy, ktorá je zamearaná na pracovné podmienky, spokojnosť zamestnancov a ich úmysel odísť zo zamestnania.
Postupovať budeme nasledovne:
Súvisí vyššia spokojnosť s finančným ohodnotením a nižšou mierou pracovnej demotivácie ? - Grafické znázornenie tejto závislosti - Odhad regresnej priamky a jej interpretácia - Pridanie ďalších vysvetľujúcich premenných - Predikcia
2 Príprava údajov
2.1 Načítanie databázy
cesta <- "udaje/HR_Attrition_R_ready_final.xlsx"
if (!file.exists(cesta)) {
cesta <- "HR_Attrition_R_ready_final.xlsx"}
if (!file.exists(cesta)) {
stop("Vložte Excel súbor do podpriečinka udaje alebo vedľa QMD dokumentu.")
}
udaje <- read_excel(cesta)
udaje <- as.data.frame(udaje)
names(udaje) <- make.names(trimws(names(udaje)), unique = TRUE)udaje.reg <- data.frame(
Respondent = seq_len(nrow(udaje)),
Vek = udaje[[1]],
LowMotivation = udaje[[19]],
Compensation = udaje[[8]],
WorkLifeBalance = udaje[[13]],
JobSatisfaction = udaje[[11]]
)head(udaje.reg) |>
kable(
format = "html",
digits = 2,
row.names = FALSE,
capion = "Prvých šesť respondentov vo vybraných údajoch"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Respondent | Vek | LowMotivation | Compensation | WorkLifeBalance | JobSatisfaction |
|---|---|---|---|---|---|
| 1 | 26-35 year | 3 | 3 | 3 | 3 |
| 2 | 26-35 year | 2 | 4 | 4 | 4 |
| 3 | 46-55 year | 4 | 4 | 4 | 4 |
| 4 | more than 56 year | 2 | 4 | 4 | 4 |
| 5 | 26-35 year | 2 | 2 | 3 | 4 |
| 6 | 26-35 year | 4 | 2 | 4 | 4 |
Tabuľka zobrazuje prvých šesť respondentov z databázy, ich vekovú skupinu a odpovede na otázky, ktoré sa týkajú pracovnej motivácie a spokojnosti v práci. Ide o spokojnosť s finančným ohodnotením, rovnováhu medzi osobným a pracovným životom, spokojnosť s vykonávanou prácou a mieru pracovnej motivácie. Každý riadok predstavuje jedného respondenta, pričom údaje zachytávajú odpovede respondentov v určitom období a nie ich zmeny v priebehu času.
2.2 Prehľad premenných
| Premenná | Význam |
|---|---|
| Respondent | Poradové číslo respondenta. |
| Vek | Veková skupina respondenta. |
| LowMotivation | Miera nízkej pracovnej motivácie. |
| Compensation | Spokojnosť s finančným ohodnotením. |
| WorkLifeBalance | Spokojnosť s rovnováhou medzi pracovným a osobným životom. |
| JobSatisfaction | Spokojnosť s vykonávanou prácou. |
2.3 Chýbajúce hodnoty
Skôr, ako začneme s regresnou analýzou potrebujeme zistiť, či v našich údajoch nechýbajú nejaké hodnoty.
chybajuce <- data.frame(
Premenna = names(udaje.reg),
Pocet_NA = colSums(is.na(udaje.reg))
)
chybajuce |>
kable(
format = "html",
col.names = c("Premenná", "Počet chýbajúcich hodnôt"),
row.names = FALSE,
caption = "Počet chýbajúcich hodnôt vo vybraných premenných"
) |>
kable_styling(
bootstrap_options = "striped",
full_width = FALSE
)| Premenná | Počet chýbajúcich hodnôt |
|---|---|
| Respondent | 0 |
| Vek | 0 |
| LowMotivation | 0 |
| Compensation | 0 |
| WorkLifeBalance | 0 |
| JobSatisfaction | 0 |
Z tabuľky môžeme vidieť, že v žiadnej premennej sa nevyskytli nejaké chýbajúce hodnoty. Údaje sú tým pádom úplné a môžeme ich použiť pri analýze.
2.4 Opisná štatistika
premenne <- c(
"LowMotivation",
"Compensation",
"WorkLifeBalance",
"JobSatisfaction"
)
opis <- data.frame(
Premenna = premenne,
Minimum = sapply(udaje.reg[premenne], min),
Median = sapply(udaje.reg[premenne], median),
Priemer = sapply(udaje.reg[premenne], mean),
Maximum = sapply(udaje.reg[premenne], max)
)
opis |>
kable(
format = "html",
digits = 2,
row.names = FALSE,
col.names = c(
"Premenná",
"Minimum",
"Medián",
"Priemer",
"Maximum"
),
caption = "Opisná štatistika vybraných premenných"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Premenná | Minimum | Medián | Priemer | Maximum |
|---|---|---|---|---|
| LowMotivation | 1 | 2 | 2.75 | 5 |
| Compensation | 1 | 3 | 3.34 | 5 |
| WorkLifeBalance | 1 | 4 | 3.51 | 5 |
| JobSatisfaction | 2 | 4 | 3.51 | 5 |
Z tabuľky môžeme vidieť, že priemerná miera pracovnej motivácie je 2,75. Spokojnosť s finančným ohodnotením bola v primere 3,34 a spokojnosť s rovnováhou medzi osobným a pracovným životom, rovnako ako aj spokojnosť s vykonávanou prácou dosiahli priemer 3,51.
2.5 Graf
Pomocou bodového grafu zobrazíme vzťah medzi spokojnosťou s finančným ohodnotením a mierou pracovnej motivácie.
graf_odmenovanie <- ggplot(
udaje.reg,
aes(x = Compensation, y = LowMotivation)
) +
geom_jitter(
width = 0.18,
height = 0.18,
color = "#d94f8a",
size = 1.8,
alpha = 0.45
) +
labs(
x = "Spokojnosť s finančným ohodnotením",
y = "Miera nízkej pracovnej motivácie"
) +
scale_x_continuous(breaks = 1:5) +
scale_y_continuous(breaks = 1:5) +
theme_minimal(base_size = 13)
graf_odmenovanie
Graf zobrazuje vzťah medzi spokojnosťou s finančným ohodnotením a mierou pracovnej motivácie. Obidve premenné sú hodnotené na Likertovej škále od 1 do 5, preto viacerí respondenti môžu mať rovnaké odpovede. Body sme preto mierne rozptýlili aby bolo vidieť ich rozloženie.
2.6 Jednoduchá linerárna regresia
Pomocou jednoduchej lineárnej regresie budeme skúmať, či spokojnosť s finančným ohodnotením súvisí s mierou pracovnej motivácie.
2.6.1 Zápis modelu
\[ LowMotivation_i = \beta_0 + \beta_1 \cdot Compensation_i + u_i \]
2.6.2 Odhad modelu pomocou lm()
model1 <- lm(
LowMotivation ~ Compensation,
data = udaje.reg
)
vysledky1 <- tidy(model1)
vysledky1[c("term", "estimate")] |>
kable(
format = "html",
digits = 3,
row.names = FALSE,
col.names = c(
"Člen modelu",
"Odhad koeficienta"
),
caption = "Výsledky jednoduchej lineárnej regresie"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Člen modelu | Odhad koeficienta |
|---|---|
| (Intercept) | 4.732 |
| Compensation | -0.593 |
Z výsledkov jednoduchej lineárnej regresie vidíme, že vyššia spokojnosť s finančným ohodnotením súvisí s nižšou mierou pracovnej demotivácie. Koeficient pri premennej Compensation má hodnotu - 0,593, čo znamená, že keď sa zvýši spokojnosť s finančným ohodnotením, tak miera pracovnej demotivácie sa zníži v priemere o 0,593 bodu. Zamestnanci, ktorí sú spokojní so svojim finančným ohodnotením majú teda tendenciu uvádzať nižšiu mieru pracovnej demotivácie. Konštanta 4,732 je konštanta, ktrú model vypočítal keď by spokojnosť s finančným ohodnotením bola 0. Respondenti ale hodnotili spokojnosť pomocou Likertovej škály na stupici od 1 do 5, a preto má hodnota v tomto prípade iba matematický význam.
2.6.3 Regresná priamka v grafe
Do nášho povodného grafu pridáme regresnú priamku, ktorá lepšie znázorní vzťah medzi medzi spokojnosťou s finančným ohodnotením a mierou nízkej pracovnej motivácie.
graf_odmenovanie +
geom_abline(
intercept = coef(model1)["(Intercept)"],
slope = coef(model1)["Compensation"],
color = "#a61c63",
linewidth = 1.2
)
Regresná priamka má klesajúci charakter, čo znamená že s rastúcou spokojnosťou s finančným ohodnotením sa znižuje miera pracovnej demotivácie. Z grafu zároveň vidíme, že odpovede respondentov sa od priamky odlišujú, pretože motiváciu ovplyvňujú aj ďalšie faktory.
2.7 Viacnásobná lineárna regresia
Doterau sme skúmali vzťah medzi spokojnosťou s finančným ohodnotením a nízkou pracovnou motiváciou. Teraz pridáme do modelu ďalšie dva faktory, ktoré môžu vplávať na motiváciu.
Budeme teda praovať s týmito premennými : - LowMotivation - miera nízkej pracovnej motivácie (vysvetlená premenná) - Compensation - spokojnosť s finančným ohodnotením - WorkLifeBalance - spokojnosť s rovnováhou medzi osobným a pracovným životom - JobSatisfaction - spokojnosť s vykonávanou prácou
2.7.1 Zápis modelu
\[ LowMotivation_i = \beta_0 + \beta_1 Compensation_i + \beta_2 WorkLifeBalance_i + \beta_3 JobSatisfaction_i + u_i \] ### Odhadn modelu pomocou lm()
model <- lm(
LowMotivation ~
Compensation +
WorkLifeBalance +
JobSatisfaction,
data = udaje.reg
)
vysledky <- tidy(model)
vysledky[c("term", "estimate")] |>
kable(
format = "html",
digits = 3,
row.names = FALSE,
col.names = c(
"Člen modelu",
"Odhad koeficienta"
),
caption = "Výsledky viacnásobnej lineárnej regresie"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Člen modelu | Odhad koeficienta |
|---|---|
| (Intercept) | 5.312 |
| Compensation | -0.337 |
| WorkLifeBalance | -0.145 |
| JobSatisfaction | -0.264 |
Výsledky viacnásobnej lineárnej regresie ukazujú, že všetky tri faktory, ktoré sme skúmali majú záporný vzťah mierou nízkej pracovnej motivácie. Pri zvýšení spokojnosti s finančným ohodnotením o jeden bod sa predpokladaná miera pracovnej demotivácie zníži o 0,337 bodu, za predpokladu, že ostatné faktory zostanú nezmenené. Pri zvýšení spokojnosti s rovnováhou medzi pracovným a osobným životom o jeden bod predpokladáme, že miera pracovnej demotivácie sa zníži o 0,145 bodu a pri zvýšení spokojnosti s vykonávanou prácou o 0,264 bodu. Aj pri týchto dvoch faktoroch predpokladáme, že ti zvyšné zostávajú nezmenené.
Najväčší záporný koeficient má premenná spokojnosť s finančným ohodnotením (- 0,337). Keď porovnáme s jednoduchou regresiou, kde dosahovala hodnotu - 0,593, tak jej hodnota sa znížila. Je to preto, lebo vo viacnásobnom modeli zohľadňujeme ďalšie dva faktory.
3 Stručný súhrn modelu pomocou glance()
suhrn <- glance(model)
suhrn[c("nobs", "r.squared", "sigma")] |>
kable(
format = "html",
digits = 3,
row.names = FALSE,
col.names = c(
"Počet respondentov",
"R²",
"Odhad SD chyby"
),
caption = "Základné charakteristiky viacnásobného modelu"
) |>
kable_styling(
bootstrap_options = "striped",
full_width = FALSE
)| Počet respondentov | R² | Odhad SD chyby |
|---|---|---|
| 526 | 0.397 | 0.757 |
Do viacnásobnej regresnej analýzy bolo zahrnutých 526 respondentov. Hodnota R² je 0,397, čo znamená, že model vysvetľuje cca 39,7% rozdielov v miere nízkej pracovnej motivácie. Zvyšnú časť (60,3%) už model nevysvetľuje, vzhľadom k tomu, že pracovná motivácia môže súvisieť aj s ďalšími faktormi. Odhas smerodajnej odchýlky chyby je 0,757, čo znamená, že skutočné hodnotenia respondentov sa od hodnôt, ktoré model predpovedá odlišujú o približne 0,76 bodu.
4 Skutočná hodnota, predikcia, rezíduum
V tejto časti porovnáme skutočné hodnotenia respondentov s tými, ktoré vypočítal náš model.
porovnanie <- data.frame(
Respondent = udaje.reg$Respondent,
Skutocnost = udaje.reg$LowMotivation,
Predikcia = fitted(model),
Reziduum = residuals(model)
)
head(porovnanie, 8) |>
kable(
format = "html",
digits = 2,
row.names = FALSE,
col.names = c(
"Respondent",
"Skutočnosť",
"Predikcia",
"Rezíduum"
),
caption = "Skutočné a predikované hodnoty pracovnej demotivácie"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Respondent | Skutočnosť | Predikcia | Rezíduum |
|---|---|---|---|
| 1 | 3 | 3.07 | -0.07 |
| 2 | 2 | 2.33 | -0.33 |
| 3 | 4 | 2.33 | 1.67 |
| 4 | 2 | 2.33 | -0.33 |
| 5 | 2 | 3.15 | -1.15 |
| 6 | 4 | 3.00 | 1.00 |
| 7 | 2 | 3.07 | -1.07 |
| 8 | 4 | 3.00 | 1.00 |
Tabuľka porovnáva skutočné hodnotenia prvých ôsmich respondentov s hodnotami, ktoré vypočítal náš regresný model. Môžeme vidieť, že predikované hodnoty sa od tých skutočných líšia. Napríklad, keď si zoberieme tretieho respondenta, tak jeho skutočná hodnota bola 4 a model predikoval hodnotu 2,33. Rozdiel (rezíduum) je teda 1,67. Keďže je kladný, tak skutočná hodnota je vyššia ako predikovaná. V prípade záporného rezídia by to bolo opačne.
5 Predikcia pre zadanú hodnotu
Pomocou jednoduchého regresného modelu vypočítame predpokladanú mieru pracovnej motivácie pri rôznych úrovniach spokojnosti s finančným ohodnotením. Použijeme pri tom hodnoty 2, 3 a 4 na päťbodovej Likertovej škále.
nove_udaje <- data.frame(
Compensation = c(2, 3, 4)
)
nove_udaje$Predikcia <- predict(
model1,
newdata = nove_udaje
)
nove_udaje |>
kable(
format = "html",
digits = 2,
row.names = FALSE,
col.names = c(
"Spokojnosť s finančným ohodnotením",
"Predikcia pracovnej demotivácie"
),
caption = "Predikcie jednoduchého regresného modelu"
) |>
kable_styling(
bootstrap_options = "striped",
full_width = FALSE
)| Spokojnosť s finančným ohodnotením | Predikcia pracovnej demotivácie |
|---|---|
| 2 | 3.55 |
| 3 | 2.95 |
| 4 | 2.36 |
Tabuľka zobrazuje predpokladanú mieru nízkej pracovnej motivácie pri rôznych úrovniach spokojnosti s finančným ohodnotením. Pri spokojnosti na úrovni 2 model predpovedá pracovnú demotiváciu 3,55, pri úrovni 3 je to 2,95 a pri úrovni 4 hodnotu 2,36. Z výsledkov môžeme vidieť, že pri rastúcej spokojnosti s finančným ohodnotením klesá predpokladaná miera pracovnej demotivácie. V tomto prípade ide o hodnoty, ktoré vypočítal model a nie skutočné odpovede.
6 Malé cvičenie
6.1 Úloha 1
Vysvetľovanou premennou je Life.expectancy, ktorá predstavuje očakávanú dĺžku života.
Vysvetľujúcimi premennými sú :
- Schooling - priemerný počet rokov vzdelávania
- BMI - index telesnej hmotnosti
- GDP - hrubý domáci produkt na obyvateľa
Regresný model skúma, ako tieto tri premenné súvisia s očakávanou dĺžkou života.
6.2 Úloha 2
cesta_who <- "udaje/Life Expectancy Data.csv"
udaje_who <- read.csv(cesta_who)
names(udaje_who) <- make.names(
trimws(names(udaje_who)),
unique = TRUE
)
udaje_who_2015 <- subset(
udaje_who,
Year == 2015
)
head(udaje_who_2015) Country Year Status Life.expectancy Adult.Mortality
1 Afghanistan 2015 Developing 65.0 263
17 Albania 2015 Developing 77.8 74
33 Algeria 2015 Developing 75.6 19
49 Angola 2015 Developing 52.4 335
65 Antigua and Barbuda 2015 Developing 76.4 13
81 Argentina 2015 Developing 76.3 116
infant.deaths Alcohol percentage.expenditure Hepatitis.B Measles BMI
1 62 0.01 71.27962 65 1154 19.1
17 0 4.60 364.97523 99 0 58.0
33 21 NA 0.00000 95 63 59.5
49 66 NA 0.00000 64 118 23.3
65 0 NA 0.00000 99 0 47.7
81 8 NA 0.00000 94 0 62.8
under.five.deaths Polio Total.expenditure Diphtheria HIV.AIDS GDP
1 83 6 8.16 65 0.1 584.2592
17 0 99 6.00 99 0.1 3954.2278
33 24 95 NA 95 0.1 4132.7629
49 98 7 NA 64 1.9 3695.7937
65 0 86 NA 99 0.2 13566.9541
81 9 93 NA 94 0.1 13467.1236
Population thinness..1.19.years thinness.5.9.years
1 33736494 17.2 17.3
17 28873 1.2 1.3
33 39871528 6.0 5.8
49 2785935 8.3 8.2
65 NA 3.3 3.3
81 43417765 1.0 0.9
Income.composition.of.resources Schooling
1 0.479 10.1
17 0.762 14.2
33 0.743 14.4
49 0.531 11.4
65 0.784 13.9
81 0.826 17.36.2.1 Úloha 2 - Regresia medzi GDP a Life expectancy
- Kontrola chýbajúcich hodnôt
colSums(is.na(
udaje_who_2015[, c("Life.expectancy", "GDP")]
))Life.expectancy GDP
0 29 - Doplnenie chýbajúcich hodnôt
median_gdp <- median(
udaje_who_2015$GDP,
na.rm = TRUE
)
udaje_who_2015$GDP[
is.na(udaje_who_2015$GDP)
] <- median_gdp
colSums(is.na(
udaje_who_2015[, c("Life.expectancy", "GDP")]
))Life.expectancy GDP
0 0 Pri kontrola údajov za rok 2015 sme zistili, že pri očakávanej dĺžke života nechýbajú žiadne hodnoty, zatiaľ čo pri GDP chýbalo 29 hodnôt. Tieto údaje sme doplnili mediánom, aby sme do regresnej analýzy mohli zahrnúť všetky krajiny.
6.2.2 Úloha 2 - Odhad regresného modelu
Pomocou jednoduchej lineárnej rovnice budeme teraz skúmať, či výška GDP na obyvateľa súvisí očakávanou dĺžkou života v jednotlivých krajinách v roku 2015.
model_gdp <- lm(
Life.expectancy ~ GDP,
data = udaje_who_2015
)
vysledky_gdp <- tidy(model_gdp)
vysledky_gdp[c("term", "estimate")] |>
kable(
format = "html",
digits = 8,
row.names = FALSE,
col.names = c(
"Člen modelu",
"Odhad koeficienta"
),
caption = "Výsledky jednoduchej regresie medzi HDP a očakávanou dĺžkou života"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Člen modelu | Odhad koeficienta |
|---|---|
| (Intercept) | 69.5516932 |
| GDP | 0.0003173 |
Výsledky ukazujú, že vzťah medzi GDP na obyvateľa a očakávanou dĺžkou života je kladný. Koeficient pri premennej GDP má hodnotu 0,0003173, čo znamená, že pri zvýšení GDP na obyvateľa o 1 000 jednotiek sa podľa modelu očakáva že dĺžka života sa zvýši o cca 0,32 roka. Krajiny s vyšším GDP na obyvateľa majú teda podľa nášho modelu tendenciu dosahovať vyššiu očakávanú dĺžku života.
6.2.3 Úloha 2 - Bodový graf s regresnou priamkou
graf_gdp <- ggplot(
udaje_who_2015,
aes(x = GDP, y = Life.expectancy)
) +
geom_point(
color = "#d94f8a",
size = 2,
alpha = 0.7
) +
geom_abline(
intercept = coef(model_gdp)["(Intercept)"],
slope = coef(model_gdp)["GDP"],
color = "#a61c63",
linewidth = 1.2
) +
labs(
x = "HDP na obyvateľa",
y = "Očakávaná dĺžka života (roky)"
) +
theme_minimal(base_size = 13)
graf_gdp
Graf ukazuje vzťah medzi GDP na obyvateľa a očakávanou dĺžkou života v jednotlivých krajinách v roku 2015. Regresná priamka má stúpajúci charakter, čo znamená, že s rasúcim GDP na obyvateľa rastie aj predpokladaná dĺžka života.
6.3 Úloha 3 - Porovnanie jednoduchej a viacnásobnej regresie
# Príprava údajov
udaje_skola <- udaje_who_2015
# Doplnenie chýbajúcich hodnôt mediánom
for (premenna in c("Schooling", "BMI", "GDP")) {
udaje_skola[[premenna]][
is.na(udaje_skola[[premenna]])
] <- median(udaje_skola[[premenna]], na.rm = TRUE)
}
# Jednoduchá regresia
model1_who <- lm(
Life.expectancy ~ Schooling,
data = udaje_skola
)
# Viacnásobná regresia
model_who <- lm(
Life.expectancy ~ BMI + GDP + Schooling,
data = udaje_skola
)
# Výsledky oboch modelov
vysledky_porovnanie <- data.frame(
Model = c("Jednoduchá regresia", "Viacnásobná regresia"),
Koeficient_Schooling = c(
coef(model1_who)["Schooling"],
coef(model_who)["Schooling"]
)
)
vysledky_porovnanie |>
kable(
format = "html",
digits = 4,
row.names = FALSE,
col.names = c("Model", "Koeficient Schooling"),
caption = "Porovnanie koeficientu vzdelávania"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Model | Koeficient Schooling |
|---|---|
| Jednoduchá regresia | 2.2263 |
| Viacnásobná regresia | 1.9210 |
V jednoduchej regresii dosiahl koeficien premennej schooling hodnotu 2,2263 čo znamená, že jeden rok vzdelávania navyše súvisí s vyššou očakávanou dĺžkou života približne o 2,23 roka. Vo viacnásobnej regresii sa tento koeficient znížil na 1,9210 pretože model už zohľadňuje aj GDP a BMI. Čiže pri rovnakých hodnotách GDP a BMI jeden rok vzdelávania navyše súvisí s vyššou očakávanou životnosťou o cca 1,92 roka.
6.4 Úloha 4 - Predikcia očakávanej dĺžky života
Pomocou jednoduchého regresného modelu vypočítame predpokladanú dĺžku života pri priemernom počte vzdelávanie 13 rokov a výsledok overíme dosadením do regresnej rovnice
nove_udaje_who <- data.frame(
Schooling = 13
)
predikcia_13 <- predict(
model1_who,
newdata = nove_udaje_who
)
data.frame(
Schooling = 13,
Predikovana_dlzka_zivota = predikcia_13
) |>
kable(
format = "html",
digits = 2,
row.names = FALSE,
col.names = c(
"Počet rokov vzdelávania",
"Predpokladaná dĺžka života"
),
caption = "Predikcia očakávanej dĺžky života pri 13 rokoch vzdelávania"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Počet rokov vzdelávania | Predpokladaná dĺžka života |
|---|---|
| 13 | 71.76 |
6.4.1 Overenie ručným výpočtom
konstanta <- coef(model1_who)["(Intercept)"]
koeficient <- coef(model1_who)["Schooling"]
vysledok_rucne <- konstanta + koeficient * 13
data.frame(
Konstanta = konstanta,
Koeficient_Schooling = koeficient,
Rucny_vypocet = vysledok_rucne,
Predikcia_predict = as.numeric(predikcia_13)
) |>
kable(
format = "html",
digits = 4,
row.names = FALSE,
caption = "Overenie predikcie ručným výpočtom"
) |>
kable_styling(
bootstrap_options = "striped",
full_width = FALSE
)| Konstanta | Koeficient_Schooling | Rucny_vypocet | Predikcia_predict |
|---|---|---|---|
| 42.8157 | 2.2263 | 71.7581 | 71.7581 |
Pomocou jednoduchého regresného modelu sme vypočítali, že pri priemernom počte vzdelávania 13 rokov je predpkladaná dĺžka života približne 71,76 roka. Výsledok sme overeili aj dosadením do regresnej rovnice a získali sme rovnakú hodnotu.
6.5 Úloha 5 - Porovnanie skutočných a predikovaných hodnôt
porovnanie_who <- data.frame(
Krajina = udaje_skola$Country,
Skutocnost = udaje_skola$Life.expectancy,
Predikcia = fitted(model_who),
Reziduum = residuals(model_who)
)
# Jedna krajina s kladným rezíduom
kladne <- head(
porovnanie_who[porovnanie_who$Reziduum > 0, ],
1
)
# Jedna krajina so záporným rezíduom
zaporne <- head(
porovnanie_who[porovnanie_who$Reziduum < 0, ],
1
)
# Spojenie do jednej tabuľky
vybrane_krajiny <- rbind(kladne, zaporne)
vybrane_krajiny |>
kable(
format = "html",
digits = 2,
row.names = FALSE,
col.names = c(
"Krajina",
"Skutočná dĺžka života",
"Predikovaná dĺžka života",
"Rezíduum"
),
caption = "Príklady krajín s kladným a záporným rezíduom"
) |>
kable_styling(
bootstrap_options = c("striped", "hover"),
full_width = FALSE
)| Krajina | Skutočná dĺžka života | Predikovaná dĺžka života | Rezíduum |
|---|---|---|---|
| Afghanistan | 65.0 | 64.58 | 0.42 |
| Angola | 52.4 | 67.50 | -15.10 |
V Afganistane je skutočná očakávaná dĺžka života 65 rokov, zatiaľ čo model predpovedal 64,58 roka. Kladné rezíduum 0,42 znamená, že skutočná hodnota bola 0,42 roka vyššia ako tá predikovaná. V Angole naopak skutočná očakávaná dĺžka života bola 52,4 roka a model predpovedal 67,50 roka. Záporné rezíduum -15,10 teda znamená, že skutočná hodnota bola o 15,10 roka nižšia ako tá, ktorú model predpovedal.
6.6 Úloha 6
Keď je regresný koeficient kladný, znamená to, že medzi dvoma premennými je pozitívna závislosť. Neznamená to ale, že jedna premenná priamo spôsobuje zmenu druhej. Napríklad tie krajiny, ktoré majú vyššie GDP môžu mať aj vyššiu očakávanú dĺžku života, ale tá môže súvisieť aj s ďalšími faktormi, ako napríklad kvalitnejšia zdravotná starostlivosť, lepšie životné podmienky alebo výživa. Čiže regresia síce ukazuje vzťah medzi premennými, ale sama o sebe nehovorí o príčine ani následku.