Happiness score report
Miriama Škulcová
library(zoo)##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(tseries)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(lmtest)
library(sandwich)
library(car)## Loading required package: carDatarm(list=ls())Úvod do problému, stanovenie hypotéz
Rozhodla som sa modelovať world hapiness score Score v závislosti od troch premenných: GDP per capita, Social support a Healthy life expectancy
Moja hypotéza hovorí o štatisticky významnom vplyve všetkých troch premenných, pričom u všetkých premenných by malo ísť o pozitívny vplyv.
Lineárna regresia
Model odhadujeme príkazom lm()
udaje <- read.csv("2019 (1).csv")
udaje <- udaje[c("Social.support","GDP.per.capita","Healthy.life.expectancy","Score")]
model <- lm(Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,data=udaje)
summary(model)##
## Call:
## lm(formula = Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,
## data = udaje)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.7018 -0.4155 -0.0520 0.4535 1.3369
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.1350 0.2116 10.088 < 2e-16 ***
## Social.support 1.3219 0.2483 5.324 3.58e-07 ***
## GDP.per.capita 0.8098 0.2358 3.434 0.000766 ***
## Healthy.life.expectancy 1.2977 0.3661 3.544 0.000523 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.588 on 152 degrees of freedom
## Multiple R-squared: 0.7263, Adjusted R-squared: 0.7209
## F-statistic: 134.5 on 3 and 152 DF, p-value: < 2.2e-16par(mfrow = c(2, 2))
plot(model)
par(mfrow = c(1, 1))Residuals vs. fitted
Rezíduá sú rozložené približne symetricky okolo nulovej osi, čo znamená že model nevykazuje systematickú chybu. Červená LOESS krivka nie je úplne rovná – vidno mierne zakrivenie: vľavo ide nadol, v strede mierne stúpa a vpravo opäť klesá. Rozptyl bodov okolo osi sa zdá byť pomerne konštantný. Na grafe je vidno zopár bodov (napr. 102, 148, 130), ktoré sa nachádzajú ďalej od väčšiny pozorovaní — tie môžu predstavovať potenciálne odľahlé hodnoty
Q-Q plot
V strednej časti grafu (okolie kvantilov −1 až +1) body veľmi dobre kopírujú diagonálu, čo znamená, že väčšina rezíduí má rozdelenie veľmi blízke k normálnemu. Na oboch koncoch (najmä vľavo dole a vpravo hore) sa body mierne odchyľujú od priamky – to naznačuje menšie odchýlky od normality v chvostoch rozdelenia.
Scale location plot
Body sú rozptýlené pomerne rovnomerne, bez jasného vzoru alebo lievikovitého tvaru. Červená LOESS krivka je relatívne rovná, čo potvrdzuje, že rozptyl rezíduí zostáva približne konštantný naprieč predikovanými hodnotami. Niekoľko bodov (napr. 102, 148) má vyššie hodnoty, ale nie sú extrémne – preto nepredstavujú závažný problém.
Residuals vs leverage
Väčšina bodov je sústredená vľavo (leverage < 0.05), čo znamená, že väčšina pozorovaní má nízky pákový efekt a teda nízky vplyv na odhady modelu. Niekoľko bodov (napr. 155, 102) leží ďalej vpravo – tieto majú vyšší leverage, teda ich prediktorové hodnoty sú nezvyčajné. Rezíduá sa pohybujú prevažne v rozmedzí −2 až +2, čo je akceptovateľné a naznačuje, že žiadne pozorovanie nemá extrémne chyby.
udaje$log_GDP <- log(udaje$GDP.per.capita + 0.001)
model2 <- lm(Score ~ +1 + I(log_GDP) + Healthy.life.expectancy,data=udaje)
summary(model2)##
## Call:
## lm(formula = Score ~ +1 + I(log_GDP) + Healthy.life.expectancy,
## data = udaje)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.6165 -0.4897 0.1038 0.4994 1.5870
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.06054 0.25328 12.084 <2e-16 ***
## I(log_GDP) 0.12449 0.08904 1.398 0.164
## Healthy.life.expectancy 3.28529 0.31544 10.415 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6968 on 153 degrees of freedom
## Multiple R-squared: 0.6132, Adjusted R-squared: 0.6081
## F-statistic: 121.3 on 2 and 153 DF, p-value: < 2.2e-16Zhrnutie
Model možno považovať za stabilný a dobre prispôsobený dátam. Premenné GDP per capita, Social support a Healthy life expectancy významne a pozitívne ovplyvňujú celkové skóre spokojnosti obyvateľov, pričom neboli zistené zásadné problémy s nelinearitou
Heteroskedasticita
library(ggplot2)
library(patchwork) # install.packages("patchwork")
p1 <- ggplot(udaje, aes(x = GDP.per.capita, y = resid(model)^2)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(x = "GDP per capita",
y = "Squared Residuals",
title = "Sqiared Residuals vs GDP") +
theme_minimal()
p2 <- ggplot(udaje, aes(x = Social.support, y = resid(model)^2)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(x = "Social support",
y = "Squared Residuals",
title = "Squared Residuals vs Social support") +
theme_minimal()
p3 <- ggplot(udaje, aes(x = Healthy.life.expectancy, y = resid(model)^2)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(
x = "Healthy life expectancy",
y = "Squared Residuals",
title = "Squared Residuals vs Healthy life expectancy"
) +
theme_minimal()
# Combine side by side
p1/p2 + p3## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
library(ggplot2)
library(patchwork) # install.packages("patchwork") – ak ešte nemáš
p1 <- ggplot(udaje, aes(x = log(GDP.per.capita), y = resid(model2)^2)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(
x = "log(GDP per capita)",
y = "Squared Residuals",
title = "Residuals vs log(GDP per capita)"
) +
theme_minimal()
p2 <- ggplot(udaje, aes(x = Social.support, y = resid(model2)^2)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(
x = "Social support",
y = "Squared Residuals",
title = "Residuals vs Social support"
) +
theme_minimal()
p3 <- ggplot(udaje, aes(x = Healthy.life.expectancy, y = resid(model2)^2)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "loess", se = FALSE, color = "red") +
labs(
x = "Healthy life expectancy",
y = "Squared Residuals",
title = "Residuals vs Healthy life expectancy"
) +
theme_minimal()
p1 / p2 + p3## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_smooth()`).## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
# Install (if not yet installed)
# install.packages("lmtest")
# Load the package
library(lmtest)
# Run the Breusch–Pagan test
bptest(model)##
## studentized Breusch-Pagan test
##
## data: model
## BP = 2.0697, df = 3, p-value = 0.5581# Install (if not yet installed)
# install.packages("lmtest")
# Load the package
library(lmtest)
# Run the Breusch–Pagan test
bptest(model2)##
## studentized Breusch-Pagan test
##
## data: model2
## BP = 3.7267, df = 2, p-value = 0.1552#install.packages("sandwich")
#install.packages("lmtest")
library(sandwich)
library(lmtest)
coeftest(model, vcov = vcovHC(model))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.13505 0.25751 8.2911 5.527e-14 ***
## Social.support 1.32189 0.25902 5.1034 9.829e-07 ***
## GDP.per.capita 0.80982 0.22698 3.5678 0.0004819 ***
## Healthy.life.expectancy 1.29767 0.36483 3.5569 0.0005008 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Zhrnutie
Vo všetkých špecifikáciách vychádza HDP na obyvateľa ako stabilne pozitívny a vysoko štatisticky významný determinant vysvetľovanej premennej. Rovnako aj sociálna opora a zdravá dĺžka života majú pozitívnu a významnú asociáciu s výsledkom modelu. To naznačuje, že krajiny s vyšším ekonomickým výkonom, lepšími sociálnymi väzbami a dlhšou očakávanou dĺžkou života majú systematicky vyššie hodnoty analyzovaného ukazovateľa (pravdepodobne spokojnosti či kvality života).
Z diagnostiky reziduí (grafy „Squared Residuals vs…“) nevyplývajú závažné známky heteroskedasticity. Trendové línie (červené krivky) sú pomerne ploché a neukazujú systematický nárast rozptylu s hodnotami vysvetľujúcich premenných. Výsledky Breusch-Pagan testu (p-hodnoty 0.5581 a 0.1552) potvrdzujú, že nulovú hypotézu homoskedasticity nemožno zamietnuť.
V modeloch nie sú zahrnuté ďalšie potenciálne faktory (napr. inštitucionálna kvalita, kultúrne rozdiely, geografické efekty), ktoré by mohli ovplyvniť výsledky.
Model je štatisticky konzistentný, s dobrým správaním reziduí a bez významnej heteroskedasticity. Výsledky naznačujú, že ekonomická úroveň (HDP), sociálna podpora a zdravie sú robustne pozitívne asociované s hodnotami cieľovej premennej. Tieto faktory tvoria kľúčové pilierové oblasti blahobytu, ktoré sa navzájom posilňujú.
Ďalší výskum by mal zahŕňať dlhšie časové obdobie alebo panelové dáta, aby bolo možné overiť kauzálny smer vzťahov a posúdiť dlhodobé efekty ekonomických a sociálnych determinantov.
Špecifikácia modelu
# Compute column medians
column_medians <- sapply(udaje, median, na.rm = TRUE)
# Impute missing values with column medians
udaje_imputed <- udaje
for (col in names(udaje)) {
udaje_imputed[[col]][is.na(udaje_imputed[[col]])] <- column_medians[col]
}
udaje <- udaje_imputed
udaje <- udaje
################################################################################
# ZAKLADNA REGRESIA
################################################################################
attach(udaje)
model <- lm(Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,data=udaje)
summary(model)##
## Call:
## lm(formula = Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,
## data = udaje)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.7018 -0.4155 -0.0520 0.4535 1.3369
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.1350 0.2116 10.088 < 2e-16 ***
## Social.support 1.3219 0.2483 5.324 3.58e-07 ***
## GDP.per.capita 0.8098 0.2358 3.434 0.000766 ***
## Healthy.life.expectancy 1.2977 0.3661 3.544 0.000523 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.588 on 152 degrees of freedom
## Multiple R-squared: 0.7263, Adjusted R-squared: 0.7209
## F-statistic: 134.5 on 3 and 152 DF, p-value: < 2.2e-161. Test RESET (test chyby špecifikácie Ramseyho regresnej rovnice - Ramsey Reset Test)
# Suppose your model is:
model <- lm(Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,data=udaje)
# RESET test from 'lmtest' package:
library(lmtest)
resettest(model)##
## RESET test
##
## data: model
## RESET = 18.302, df1 = 2, df2 = 150, p-value = 7.725e-08Nepríjmame alternatívnu hypotézu, keďže nám p hodnota vyšla vyššia ako 0.05. ## Grafická analýza
plot(model, which = 1)
car::crPlots(model)
Najväčší odklon môžeme vidieť u premennej GDP per Capita a Healthy life
expectancy.
- Porovnanie základného a modifikovaného modelu
model <- lm(Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy)
model_schooling_kvadr <- lm(Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy+ I(GDP.per.capita^2) + I(Healthy.life.expectancy^2) )
summary(model_schooling_kvadr)##
## Call:
## lm(formula = Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy +
## I(GDP.per.capita^2) + I(Healthy.life.expectancy^2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.44862 -0.35031 -0.03075 0.40568 1.39628
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.0419 0.3056 9.954 < 2e-16 ***
## Social.support 1.5211 0.2383 6.383 2.05e-09 ***
## GDP.per.capita -0.7955 0.5532 -1.438 0.15252
## Healthy.life.expectancy -0.7585 0.9948 -0.762 0.44698
## I(GDP.per.capita^2) 0.8324 0.3085 2.698 0.00777 **
## I(Healthy.life.expectancy^2) 1.6832 0.7776 2.165 0.03200 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.554 on 150 degrees of freedom
## Multiple R-squared: 0.7603, Adjusted R-squared: 0.7523
## F-statistic: 95.15 on 5 and 150 DF, p-value: < 2.2e-16Model ukazuje, že skóre (Score) je najvýraznejšie a štatisticky vysvetlené premennou Social.support, ktorá má silný pozitívny a vysoko signifikantný vplyv – keď Social.support stúpne o jednu jednotku, očakávané skóre sa zvýši približne o 1.52 bodu (pri fixných ostatných premenných). Premenné GDP.per.capita a Healthy.life.expectancy v lineárnej forme nie sú signifikantné, ale ich kvadratické členy sú signifikantné, čo znamená, že ich vzťah k Score je nelineárny. Konkrétne: koeficienty pri GDP^2 a HLE^2 sú kladné, zatiaľ čo lineárne členy sú záporné, čo naznačuje U-tvar – pri nízkych hodnotách môže byť efekt negatívny, ale pri vyšších hodnotách sa otáča do pozitívneho smeru. Intercept 3.04 predstavuje odhadovanú hodnotu Score pri nulových hodnotách všetkých vysvetľujúcich premenných (čo má skôr technický význam). Model ako celok vysvetľuje približne 76 % variability v závislej premennej (R² = 0.7603) a je vysoko signifikantný (p < 2e-16), čo znamená, že zvolená špecifikácia má pomerne silnú prediktívnu schopnosť. Reziduá sú relatívne malé a rovnomerne rozložené, čo naznačuje dobrú zhodu modelu s dátami.
anova(model, model_schooling_kvadr)Kvadratické členy prinášajú významné dodatočné vysvetlenie variability v závislej premennej Score, a preto je Model 2 štatisticky lepšou voľbou než čistý lineárny Model 1.
resettest(model_schooling_kvadr)##
## RESET test
##
## data: model_schooling_kvadr
## RESET = 4.3272, df1 = 2, df2 = 148, p-value = 0.014926. Transformácia pomocou dummy premennej a lineárnej lomenej funkcie
udaje$DUM <- ifelse(udaje$Social.support < 27, 0, 1)
modelD_auto <- lm(Score ~ +1 + DUM + Social.support + GDP.per.capita + Healthy.life.expectancy,data = udaje)
summary(modelD_auto)##
## Call:
## lm(formula = Score ~ +1 + DUM + Social.support + GDP.per.capita +
## Healthy.life.expectancy, data = udaje)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.7018 -0.4155 -0.0520 0.4535 1.3369
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.1350 0.2116 10.088 < 2e-16 ***
## DUM NA NA NA NA
## Social.support 1.3219 0.2483 5.324 3.58e-07 ***
## GDP.per.capita 0.8098 0.2358 3.434 0.000766 ***
## Healthy.life.expectancy 1.2977 0.3661 3.544 0.000523 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.588 on 152 degrees of freedom
## Multiple R-squared: 0.7263, Adjusted R-squared: 0.7209
## F-statistic: 134.5 on 3 and 152 DF, p-value: < 2.2e-16Model naznačuje, že premennú DUM nie je možné odhadnúť, pretože vykazuje perfektnú lineárnu závislosť od ostatných zahrnutých vysvetľujúcich premenných. Inými slovami, informácia obsiahnutá v DUM je v plnom rozsahu determinovaná kombináciou premenných Social.support, GDP per capita a Healthy life expectancy, takže DUM neprináša do modelu žiadnu dodatočnú variabilitu. Z tohto dôvodu ju odhadovací algoritmus v R automaticky vyhodnotil ako singulárnu a vyradil z regresnej rovnice. Model sa preto v skutočnosti odhadol bez tejto premennej a jej koeficient nie je možné interpretovať. Ostatné premenné zostávajú štatisticky významné, avšak DUM neprispieva k zlepšeniu vysvetľovacej schopnosti modelu, keďže neobsahuje žiadnu nezávislú informáciu nad rámec už zahrnutých kovariátov.
modelD_sklon <- lm(Score ~ +1 + I(DUM*Social.support) + Social.support + GDP.per.capita + Healthy.life.expectancy,data = udaje)
summary(modelD_sklon)##
## Call:
## lm(formula = Score ~ +1 + I(DUM * Social.support) + Social.support +
## GDP.per.capita + Healthy.life.expectancy, data = udaje)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.7018 -0.4155 -0.0520 0.4535 1.3369
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.1350 0.2116 10.088 < 2e-16 ***
## I(DUM * Social.support) NA NA NA NA
## Social.support 1.3219 0.2483 5.324 3.58e-07 ***
## GDP.per.capita 0.8098 0.2358 3.434 0.000766 ***
## Healthy.life.expectancy 1.2977 0.3661 3.544 0.000523 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.588 on 152 degrees of freedom
## Multiple R-squared: 0.7263, Adjusted R-squared: 0.7209
## F-statistic: 134.5 on 3 and 152 DF, p-value: < 2.2e-16anova(model, modelD_sklon)resettest(modelD_sklon)##
## RESET test
##
## data: modelD_sklon
## RESET = 18.18, df1 = 2, df2 = 149, p-value = 8.617e-08Zhluková analýza
library(knitr)
library(kableExtra)rm(list=ls())
udaje <- read.csv("2019 (1).csv", stringsAsFactors = FALSE)
udaje <- subset(udaje)
udaje <- subset(udaje,
Country.or.region == "Finland" | Country.or.region == "Denmark" | Country.or.region == "Norway" |
Country.or.region == "Iceland" | Country.or.region == "Netherlands" | Country.or.region == "Switzerland" |
Country.or.region == "Sweden" | Country.or.region == "New Zealand" | Country.or.region == "Canada" |
Country.or.region == "Austria" | Country.or.region == "Australia" | Country.or.region == "Costa Rica" |
Country.or.region == "Israel" | Country.or.region == "Luxembourg" | Country.or.region == "United Kingdom" |
Country.or.region == "Ireland" | Country.or.region == "Germany"
)
udaje <- udaje[, c("Country.or.region", "Score", "Social.support", "GDP.per.capita", "Healthy.life.expectancy")]
rownames(udaje) <- udaje$Country.or.region
udaje$Country.or.region <- NULL
udaje$Score <- c(7.769,7.6,7.554,7.494,7.488,7.48,7.343,7.307,7.278,7.246,7.228,7.167,7.139,7.09,7.054,7.021,6.985)Table 1.
udajeTabuľka vybraných údajov
# =======================================================
## 1) Príprava údajov a data.frame so šlálovanými údajmi
## ======================================================
udaje_complete <- na.omit(udaje)
udaje_scaled <- scale(udaje_complete)Obr. 1.
num_vars <- as.data.frame(udaje_scaled)
num_plots <- ncol(num_vars)
par(mfrow = c(ceiling(sqrt(num_plots)), ceiling(num_plots / ceiling(sqrt(num_plots)))))
par(mar = c(4, 4, 2, 1))
for (col in names(num_vars)) {
boxplot(num_vars[[col]],
main = col,
col = "lightblue",
horizontal = TRUE)
}
mtext("Boxploty numerických premenných", outer = TRUE, cex = 1.3, font = 2)
V premennej score je medián mierne pod nulou. Väčšina hodnôt sa nachádza
medzi približne –0.8 a +0.7. Na grafe nie je vidno žiadne extrémne
odľahlé hodnoty. V premennej Social Support je medián mierne nad nulou.
Väčšina hodnôt leží medzi asi –0.7 a +0.7 a údaje sú pomerne symetricky
rozložené. Premenná GDP per capita je najkoncentrovanejšia premenná zo
všetkých. Viditeľné sú outliery na oboch stranách. V premennej Healthy
life expectancy nie je jasne vidieť extrémne hodnoty, výber pôsobí
kompaktný a symetrický.
Tab. 2
cor_mat <- cor(udaje_scaled, use="pairwise.complete.obs")
cor_mat <- round(cor_mat,2)
print(cor_mat)## Score Social.support GDP.per.capita
## Score 1.00 0.63 0.05
## Social.support 0.63 1.00 0.30
## GDP.per.capita 0.05 0.30 1.00
## Healthy.life.expectancy 0.14 0.23 0.42
## Healthy.life.expectancy
## Score 0.14
## Social.support 0.23
## GDP.per.capita 0.42
## Healthy.life.expectancy 1.00Korelácie medzi sledovanými premennými sú prevažne slabé až stredné. Najsilnejší vzťah sa ukázal medzi premennými Score a Social.support (r = 0.63), čo naznačuje, že vyššia úroveň sociálnej podpory výraznejšie súvisí s vyšším skóre šťastia. Stredná korelácia sa objavila aj medzi GDP.per.capita a Healthy.life.expectancy (r = 0.42), čo odráža, že ekonomicky silnejšie krajiny majú spravidla dlhšiu očakávanú dĺžku zdravého života. Ostatné vzťahy sú len slabé: Score má veľmi nízku väzbu na HDP (r = 0.05) a len miernu na zdravú dĺžku života (r = 0.14), pričom aj väzby sociálnej podpory na ďalšie premenné zostávajú slabé. Celkovo teda medzi premennými neexistujú veľmi silné lineárne vzťahy, s výnimkou spojitosti skóre so sociálnou podporou.
Tab. 3
## ============================
## 3) Distance matrix
## ============================
rownames(udaje_scaled) <- c("Fin", "Den", "Nor", "Ice", "Net", "Swi", "Swe", "NZe", "Can", "Aus", "Aut", "Cos", "Isr", "Lux", "UKi", "Ire", "Ger")
dist_mat <- round(dist(udaje_scaled, method = "euclidean"), 2)
dist_mat## Fin Den Nor Ice Net Swi Swe NZe Can Aus Aut Cos Isr Lux UKi
## Den 0.98
## Nor 2.42 1.67
## Ice 2.26 1.69 1.24
## Net 1.90 1.09 1.89 2.26
## Swi 3.48 2.71 1.55 2.25 2.36
## Swe 2.88 2.06 2.34 2.77 1.02 2.17
## NZe 2.77 1.99 1.97 1.64 1.76 1.95 1.68
## Can 3.54 2.69 2.22 2.50 2.02 1.35 1.39 1.25
## Aus 3.41 2.57 2.66 3.04 1.58 2.21 0.58 1.74 1.16
## Aut 3.33 2.45 1.89 1.91 2.05 1.54 1.73 0.83 0.85 1.63
## Cos 4.73 4.54 5.72 5.48 4.02 5.66 3.78 4.23 4.53 3.77 4.74
## Isr 4.22 3.46 3.51 3.66 2.59 2.70 1.68 2.08 1.42 1.18 1.99 3.54
## Lux 4.43 3.52 3.09 3.84 2.71 2.93 2.20 3.19 2.56 2.10 2.68 5.37 2.95
## UKi 3.33 2.54 3.04 2.88 2.02 3.25 1.76 1.78 2.23 1.74 1.94 3.47 2.21 2.68
## Ire 3.68 2.78 2.74 2.93 2.32 3.15 2.16 2.40 2.54 2.19 2.15 4.77 2.99 1.79 1.44
## Ger 4.29 3.55 4.04 4.27 2.63 3.89 1.96 3.01 2.78 1.76 2.98 3.17 2.12 2.37 1.69
## Ire
## Den
## Nor
## Ice
## Net
## Swi
## Swe
## NZe
## Can
## Aus
## Aut
## Cos
## Isr
## Lux
## UKi
## Ire
## Ger 2.22Obr. 2. Hierarchické zhlukovanie - dendogram. Červená čiara určuje rez definujúci tri klastre.
## ============================
## 4) Hierarchical klastering
## ============================
hc <- hclust(dist_mat, method = "ward.D2")
plot(hc, labels = rownames(udaje_scaled),
main = "Hierarchical klastering of countries (Ward.D2)",
xlab = "", sub = "")
k <- 3
h_cut <- hc$height[length(hc$height) - (k - 1)]
abline(h = h_cut, col = "red", lwd = 2, lty = 2)
klaster_membership <- cutree(hc, k = k)
udaje_klasters <- data.frame(
Country = rownames(udaje_complete),
udaje_complete,
klaster = factor(klaster_membership)
)Tab.4. Príslušnosť krajín do klastrov.
data_prac <- data.frame(cbind(udaje_klasters$Country, udaje_klasters$klaster))
colnames(data_prac) <- c("Country","klaster")
data_pracVykonaná klastrová analýza rozdelila sledované krajiny do troch odlišných klastrov. Prvý klaster tvoria severské krajiny – Fínsko, Dánsko, Nórsko a Island – ktoré patria medzi najvyspelejšie a najstabilnejšie spoločnosti s vysokou životnou úrovňou a sociálnou podporou; preto sa prirodzene zoskupili do samostatnej a homogénnej skupiny. Druhý klaster zahŕňa väčšinu ostatných krajín tradičného Západu, ako sú Holandsko, Švajčiarsko, Švédsko, Nový Zéland, Kanada, Rakúsko, Austrália, Izrael, Luxembursko, Spojené kráľovstvo, Írsko a Nemecko. Tento klaster predstavuje veľkú skupinu ekonomicky silných a rozvinutých krajín, ktoré si navzájom vykazujú vysokú mieru podobnosti v hodnotených ukazovateľoch. Tretí klaster pozostáva iba z Kostariky, ktorá sa od ostatných krajín odlišuje natoľko, že vytvorila samostatnú skupinu; jej profil je špecifický kombináciou nižšieho hospodárskeho výkonu, ale zároveň relatívne vysokého subjektívneho hodnotenia kvality života. Celkovo analýza ukazuje jasné oddelenie severských krajín, kompaktný blok západných ekonomík a samostatné postavenie Kostariky ako netypického prípadu.
Deskriptívne štatistiky výsledkov
Tab. 5. Vysvetlenie vnútroklastrovej variability z hľadiska jednotlivých premenných
## ============================
## 5) Variability measures
## ============================
ssq <- function(x, m) sum((x - m)^2)
var_names <- colnames(udaje_scaled)
TSS <- sapply(var_names, function(v) ssq(udaje_scaled[, v], mean(udaje_scaled[, v])))
WSS <- sapply(var_names, function(v) {
x <- udaje_scaled[, v]
tapply(x, klaster_membership, function(z) ssq(z, mean(z))) |> sum()
})
BSS <- TSS - WSS
ss_table <- data.frame(
Variable = var_names,
TSS = TSS,
WSS = WSS,
BSS = BSS,
Prop_Between = BSS / TSS
)
ss_tableVýsledky analýzy rozptylu ukazujú, ako dobre zvolené klastre odlišujú jednotlivé premenné. Premenná Social.support má najvyšší podiel medzi-skupinového rozptylu (Prop_Between = 0.62), čo znamená, že klastre sa v úrovni sociálnej podpory od seba najvýraznejšie líšia a táto premenná najlepšie odráža štruktúru klasifikácie. Nasledujú premenné Score (0.57) a GDP.per.capita (0.55), ktoré takisto pomerne dobre oddeľujú skupiny krajín, hoci o niečo slabšie než sociálna podpora. Naopak, premenná Healthy.life.expectancy vykazuje najnižší podiel medzi-skupinovej variability (0.32), čo naznačuje, že dĺžka zdravého života rozlišuje klastre najmenej a jej hodnoty sú medzi skupinami relatívne podobné. Celkovo teda platí, že vytvorené klastre sú najlepšie vysvetlené úrovňou sociálnej podpory a najhoršie očakávanou dĺžkou zdravého života.
attach(udaje)## The following objects are masked from udaje (pos = 5):
##
## GDP.per.capita, Healthy.life.expectancy, Score, Social.supportudaje <- data.frame(cbind(udaje,udaje_klasters$klaster))
colnames(udaje) <- c("Score","Healthy.life.expectancy","GDP.per.capita","Social.support","klaster")Multikolinearita
Odhad základného regresného modelu
model <- lm(Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,data=udaje)
summary(model)##
## Call:
## lm(formula = Score ~ +1 + Social.support + GDP.per.capita + Healthy.life.expectancy,
## data = udaje)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.3225 -0.1127 0.0056 0.1447 0.2839
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.9023 2.3689 1.225 0.2422
## Social.support 0.5286 2.3102 0.229 0.8226
## GDP.per.capita -0.3272 0.4572 -0.716 0.4869
## Healthy.life.expectancy 2.8355 0.9497 2.986 0.0105 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.191 on 13 degrees of freedom
## Multiple R-squared: 0.4177, Adjusted R-squared: 0.2833
## F-statistic: 3.108 on 3 and 13 DF, p-value: 0.06349*Opis bol už vyššie v práci.
Korelačná matica
xvars <- udaje[, c("Social.support", "GDP.per.capita", "Healthy.life.expectancy")]
round(cor(xvars), 3)## Social.support GDP.per.capita Healthy.life.expectancy
## Social.support 1.000 0.420 0.231
## GDP.per.capita 0.420 1.000 0.302
## Healthy.life.expectancy 0.231 0.302 1.000Korelačná analýza odhalila stredne silnú pozitívnu závislosť medzi sociálnou podporou a HDP na obyvateľa (r = 0,420), čo naznačuje, že bohatšie krajiny majú tendenciu dosahovať vyššiu úroveň sociálnej podpory. Slabšia pozitívna korelácia sa prejavila medzi sociálnou podporou a zdravou dĺžkou života (r = 0,231), ako aj medzi HDP na obyvateľa a zdravou dĺžkou života (r = 0,302). Medzi vysvetľujúcimi premennými sa nepreukázala silná korelácia, čo znamená, že riziko výraznej multikolinearity v modeli je nízke.
pairs(xvars,
main = "Scatterplotová matica – premenné Social support, GDP, Healthy life expectancy")
VIF
library(car)
vif(model)## Social.support GDP.per.capita Healthy.life.expectancy
## 1.231522 1.283012 1.116366V tomto prípade nespĺňajú naše dáta ani prísne ani menej prísne kritérium.
Condition number
X <- model.matrix(model)[, -1]
XtX <- t(X) %*% X
eig <- eigen(XtX)
condition_number <- sqrt(max(eig$values) / min(eig$values))
condition_number## [1] 77.24144V tomto prípade daný indikátor nepresahuje hodnotu 100, čo znamená, že nesignalizuje prítomnosť multikolinearity. Preto ju nemusíme ďalej riešiť.