R Notebook

library(knitr)
library(kableExtra)

rm(list=ls())
# Load data
udaje <- read.csv("udaje/Life_Expectancy_Data.csv", stringsAsFactors = FALSE)

# Filter for Year == 2015
udaje2015 <- subset(udaje, Year == 2015)
# udaje2015 <- subset(udaje, Country == "Slovakia" | Country == "Czechia" | Country == "Poland" | Country == "Hungary" | Country == "Latvia" | Country == "Lithuania" | Country == "Croatia" | Country == "Slovenia" | Country == "Austria" | Country == "Serbia" | Country == "Montenegro" | Country == "Ukraine" | Country == "Bulgaria" | Country == "Romania" | Country == "Moldova")

udaje2015 <- subset(udaje2015,  Country == "Poland" | Country == "Hungary" | Country == "Latvia" | Country == "Lithuania" | Country == "Croatia" | Country == "Slovenia" | Country == "Austria" | Country == "Serbia" | Country == "Montenegro"  | Country == "Ukraine" | Country == "Bulgaria" | Country == "Romania" | Country == "Moldova" |  Country == "Finland" | Country == "Sweden" | Country == "Denmark" | Country == "Estonia" )

# Filter for postcommunist european countries



# Select required columns + Country
udaje2015 <- udaje2015[, c("Country", "Year", "Life.expectancy", "BMI", "GDP", "Schooling")]

# Set row names to Country
rownames(udaje2015) <- udaje2015$Country

# Remove Country column from data (optional, since now row names contain it)
udaje2015$Country <- NULL
udaje2015 <- subset(udaje2015, select = -Year)
udaje2015

NA

## ============================
## 1) Preparation of the data
## ============================

# We assume you already have:
#   udaje  = data.frame with columns: Life.expectancy, BMI, GDP, Schooling
#   rownames(udaje) = country names

# Remove rows with missing values (if any)
udaje_complete <- na.omit(udaje2015)

# Standardize variables (very important when scales differ!)
udaje_scaled <- scale(udaje_complete)
#udaje_scaled
#summary(udaje_scaled)

Hierarchická zhluková analýza pracuje s mierami vzdialenosti medzi pozorovaniami. Aby boli tieto vzdialenosti porovnateľné, je potrebné, aby všetky premenné boli definované na rovnakej škále. Používame pritom tzv. z-škálovanie, pričom transformované \(z\) hodnoty (skóre) vypočítame nasledovne:

\[z = \frac{x-\mu}{\sigma}\]

kde \(\mu\) je stredná hodnota a \(\sigma\) je štandardná odchýlka pozorovaní \(x\).¹

Touto operáciou získame škálované pozorovania, pričom ich rozloženie je znázornené nasledovne

Tentokrát uletené hodnoty nevylúčime, nakoľko nám definujú jednu konkrétnu krajinu.

Pri zhlukovej analýze je mimoriadne dôležitá korelačná analýza jednotlivých premenných, ktorévyužívame. Vysoká korelácia medzi niektorými z nich môže pri zhlukovaní zvýhodňovať korelované premenné, preto pri korelácii vyššej ako 0.8 jednu z korelovaných premenných vylúčime.

library(knitr)
library(kableExtra)
cor_mat <- cor(udaje_scaled, use = "pairwise.complete.obs") 
cor_mat <- round(cor_mat, 2)
kable(cor_mat, 
      caption = "Correlation Matrix (rounded to 2 decimals)",
      booktabs = TRUE) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE,
    position = "center"
  )

Correlation Matrix (rounded to 2 decimals)

	Life.expectancy	BMI	GDP	Schooling
Life.expectancy	1.00	-0.20	0.03	0.70
BMI	-0.20	1.00	0.18	0.19
GDP	0.03	0.18	1.00	-0.09
Schooling	0.70	0.19	-0.09	1.00

Každej krajine v údajovom data.frame zodpovedá jeden riadok pozorovaní jednotlivých premenných (= 1 krajina). Vzdialenosť medzi dvomi krajinami \(i\) a \(j\) sa potom vypočíta ako

\[d^{ij} = \sqrt{\sum_k (x^i_k-x^j_k)^2}\] čo je známe ako Euklidovská vzdialenosť. Okrem toho sú v tejto súvislosti používané aj iné typy vzdialeností, čo my ale v našom príklade nezvažujeme. Dištančná matica potom obsahuje vzdialenosti medzi jednotlivymi prvkami (teda krajinami) ako je znázornené nižšie:

## ============================
## 3) Distance matrix
## ============================

# Euclidean distance on standardized data (most common choice)
dist_mat <- round(dist(udaje_scaled, method = "euclidean"),2)
dist_mat

           Austria Bulgaria Croatia Denmark Estonia Finland Hungary Latvia Lithuania Montenegro Poland Romania Serbia Slovenia
Bulgaria      4.08                                                                                                            
Croatia       3.37     0.93                                                                                                   
Denmark       4.87     4.37    3.80                                                                                           
Estonia       4.33     1.56    1.43    2.95                                                                                   
Finland       4.08     2.25    1.76    2.16    0.91                                                                           
Hungary       3.41     0.80    0.55    3.85    1.39    1.85                                                                   
Latvia        3.38     1.10    0.98    3.78    1.43    1.90    0.48                                                           
Lithuania     3.47     1.49    1.42    3.66    1.53    1.96    0.93   0.48                                                    
Montenegro    3.99     0.40    0.69    4.10    1.32    1.96    0.75   1.10      1.52                                          
Poland        3.28     1.48    0.95    3.10    1.09    1.25    0.79   0.73      0.87       1.30                               
Romania       4.52     2.66    2.69    5.09    2.97    3.45    2.73   2.72      2.98       2.51   2.92                        
Serbia        4.85     2.73    2.81    5.22    3.05    3.55    2.91   2.95      3.25       2.57   3.13    0.47                
Slovenia      5.07     4.44    3.88    2.90    3.37    2.93    4.12   4.12      4.24       4.06   3.60    3.64   3.66         
Sweden        3.84     1.91    1.25    2.91    1.22    0.99    1.63   1.89      2.17       1.54   1.35    3.05   3.09     2.94
Ukraine       4.76     0.91    1.74    4.62    1.71    2.58    1.45   1.49      1.67       1.14   1.95    2.71   2.77     4.71
           Sweden
Bulgaria         
Croatia          
Denmark          
Estonia          
Finland          
Hungary          
Latvia           
Lithuania        
Montenegro       
Poland           
Romania          
Serbia           
Slovenia         
Sweden           
Ukraine      2.49

Princíp zhlukovania

Wardova metóda patrí medzi aglomeratívne hierarchické zhlukovacie prístupy, ktoré postupne spájajú objekty do väčších klastrov. Jej základnou myšlienkou je minimalizovať nárast vnútornej variability pri každom spojení dvoch klastrov.

Pre klaster \(A\) s veľkosťou \(n_A\) a klaster \(B\) s veľkosťou \(n_B\) označme \(SSE(A)\) a \(SSE(B)\) ako súčet štvorcov odchýlok pozorovaní vnútri každého klastru (angl. ).

Wardova metóda vyberá na zlúčenie tie dva klastry, ktoré minimalizujú nárast

\[\Delta(A,B) = SSE(C) - SSE(A) - SSE(B),\]

kde \(C\) je nový klaster vzniknutý spojením \(A\) a~\(B\).
Teda ide o metódu, ktorá sa snaží vytvoriť čo najkompaktnejšie a čo najhomogénnejšie klastry v zmysle minimálnej vnútornej variability.

Implementácia v prostredí vychádza priamo z pôvodnej definície Wardovej metódy, ktorá pracuje so štvorcovou Euklidovskou vzdialenosťou. Nech \(d(i,j)\) je Euklidovská vzdialenosť medzi centroidmi klastrov \(i\) a~\(j\), pričom \(n_i\) a \(n_j\) označujú veľkosti týchto klastrov.

Ward.D2 vyhodnocuje nárast vnútornej variability pri spojení klastrov \(i\) a \(j\) podľa vzorca:

\[d_{\text{ward.D2}}^{\,2}(i,j) = \frac{2\, n_i n_j}{n_i + n_j} \, d(i,j)^2.\]

Tento výraz predstavuje presný nárast súčtu štvorcov odchýlok () po spojení dvoch klastrov. Vďaka tejto vlastnosti je považovaná za metódu, ktorá najvernejšie implementuje Wardov pôvodný algoritmus.

## ============================
## 4) Hierarchical clustering
## ============================

# Ward’s method
hc <- hclust(dist_mat, method = "ward.D2")

# Plot dendrogram
plot(hc, labels = rownames(udaje_scaled),
     main = "Hierarchical clustering of countries (Ward.D2)",
     xlab = "", sub = "")

# Number of clusters
k <- 3

# Compute cut height for a red line
h_cut <- hc$height[length(hc$height) - (k - 1)]

# Add horizontal red line showing the cut
abline(h = h_cut, col = "red", lwd = 2, lty = 2)

# Cluster assignment
cluster_membership <- cutree(hc, k = k)

# Add cluster labels to original data
udaje_clusters <- data.frame(
  Country  = rownames(udaje_complete),
  udaje_complete,
  Cluster = factor(cluster_membership)
)

cbind(udaje_clusters$Country, udaje_clusters$Cluster)

      [,1]         [,2]
 [1,] "Austria"    "1" 
 [2,] "Bulgaria"   "1" 
 [3,] "Croatia"    "1" 
 [4,] "Denmark"    "2" 
 [5,] "Estonia"    "1" 
 [6,] "Finland"    "1" 
 [7,] "Hungary"    "1" 
 [8,] "Latvia"     "1" 
 [9,] "Lithuania"  "1" 
[10,] "Montenegro" "1" 
[11,] "Poland"     "1" 
[12,] "Romania"    "3" 
[13,] "Serbia"     "3" 
[14,] "Slovenia"   "2" 
[15,] "Sweden"     "1" 
[16,] "Ukraine"    "1" 

## ============================
## 5) Intra- (within) cluster variability
##    and inter- (between) cluster variability
## ============================

# Helper: function to compute sum of squares around a given mean
ssq <- function(x, m) sum((x - m)^2)

# ---- Total sum of squares (TSS) per variable ----
var_names <- colnames(udaje_scaled)
TSS <- sapply(var_names, function(v) {
  x <- udaje_scaled[, v]
  ssq(x, mean(x))
})

# ---- Within-cluster sum of squares (WSS) per variable ----
WSS <- sapply(var_names, function(v) {
  x <- udaje_scaled[, v]
  tapply(x, cluster_membership, function(z) ssq(z, mean(z))) |> sum()
})

# ---- Between-cluster sum of squares (BSS) per variable ----
BSS <- TSS - WSS

# Put it together in a nice table
ss_table <- data.frame(
  Variable = var_names,
  TSS = TSS,
  WSS = WSS,
  BSS = BSS,
  Prop_Between = BSS / TSS  # proportion of variance explained by clusters
)

ss_table

NA

## ============================
## 6) Cluster descriptive statistics
## ============================

# Means of original variables by cluster
cluster_means <- aggregate(. ~ Cluster, data = udaje_clusters[ , -1], FUN = mean)  # -1 removes Country
cluster_means

# Standard deviations by cluster (optional)
cluster_sds <- aggregate(. ~ Cluster, data = udaje_clusters[ , -1], FUN = sd)
cluster_sds

## ============================
## 7) (Optional) Silhouette widths
##    – how well each country fits its cluster
## ============================

# install.packages("cluster")  # if not installed
# library(cluster)

# sil <- silhouette(cluster_membership, dist_mat)
# plot(sil, main = "Silhouette plot for hierarchical clustering")
# summary(sil)

---

1. Predpokladáme, že súbor údajov už neobsahuje NA (teda chýbajúce) hodnoty.↩︎