Zhluková analýza
Terézia Bartáková (s pomocou ChatGPT)
Úvod
Klastrová (zhluková) analýza patrí medzi najpoužívanejšie metódy exploratívnej štatistiky. V praxi sa využíva všade tam, kde je potrebné rozdeliť pozorovania do homogénnych celkov - napríklad pri segmentácii zákazníkov v marketingu, identifikácii podobných krajín v makroekonomických ukazovateľoch, hodnotenízdravotných rizík, klasifikácii biologických vzoriek či v geoinformatike pri zoskupovaní priestorových sobjektov. Jej výhodou je, že pracuje s viacerými premennými naraz a dokáže odhaliť vzory, ktoré by pri samotnom hodnotení jednotlivých ukazovateľov zostali skryté. Správne zvolená metrika vzdialenosti a metóda zhlukovania umožňujú odhaliť skryté vzťahy v dátach, čím poskytujú cenný podklad pre rozhodovanie v rôznych oblastiach aplikovaného výskumu.
library(knitr)
library(kableExtra)Krajiny EÚ
rm(list = ls())
udaje <- read.csv("world_population_data.csv", stringsAsFactors = FALSE)
eu_countries <- c("Austria", "Belgium", "Bulgaria", "Croatia", "Cyprus", "Czech Republic", "Denmark", "Estonia", "Finland", "France", "Germany", "Greece", "Hungary", "Ireland", "Italy", "Latvia", "Lithuania", "Luxembourg", "Malta", "Netherlands", "Poland", "Portugal", "Romania", "Slovakia", "Slovenia", "Spain", "Sweden")
eu_countries <- subset(udaje, country %in% eu_countries)
eu_countries <- eu_countries[, c("country", "X2023.population", "density..km..", "growth.rate")]
# Premenovanie stĺpcov
names(eu_countries) <- c("Country", "Population", "Density", "GrowthRate")
rownames(eu_countries) <- eu_countries$Country
eu_countries$Country <- NULL
eu_countries <- eu_countries[complete.cases(eu_countries) & eu_countries$Population > 0, ]
eu_countries$GrowthRate <- as.numeric(gsub("%", "", eu_countries$GrowthRate))Tabuľka 1
eu_countriesŠkálovanie
udaje_complete <- na.omit(eu_countries)
udaje_scaled <- scale(udaje_complete)Obrázok 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 = "pink",
horizontal = TRUE)
}
mtext("Boxploty numerických premenných (rok 2023)", outer = TRUE, cex = 1.3, font = 2)
Pri zhlukovej analýze je dôležitá korelačná matica premenných. Vysoká korelácia zvýhodňuje pri zhlukovej analýze korelované premenné. Preto pri korelácii nad 0,8 alebo 0.9 vylúčime jednu z korelovaných premenných. V Tab. 2. sa však takáto vysoká korelácia nenachádza.
Tabuľka 2
cor_mat <- cor(udaje_scaled, use="pairwise.complete.obs")
cor_mat <- round(cor_mat,2)
print(cor_mat)## Population Density GrowthRate
## Population 1.00 -0.06 0.05
## Density -0.06 1.00 0.06
## GrowthRate 0.05 0.06 1.00Tabuľka 3
rownames(eu_countries) <- c("Aus", "Bel", "Bul", "Cro", "Cyp", "Cze", "Den", "Est", "Fin", "Fra", "Ger", "Gre", "Hun", "Ire", "Ita", "Lat", "Lit", "Lux", "Mlt", "Ned", "Pol", "Por", "Rom", "Svk", "Slo", "Spa", "Swe")
eu_scaled <- scale(eu_countries)
dist_mat <- round(dist(eu_scaled, method = "euclidean"), 2)
dist_mat## Aus Bel Bul Cro Cyp Cze Den Est Fin Fra Ger Gre Hun Ire Ita
## Bel 0.96
## Bul 1.13 0.60
## Cro 1.68 0.83 0.64
## Cyp 3.56 2.90 3.28 2.99
## Cze 3.17 2.25 2.31 1.77 1.97
## Den 3.13 2.49 2.20 1.95 3.05 1.63
## Est 3.29 2.54 2.28 1.89 3.06 1.37 0.51
## Fin 3.42 2.49 2.41 1.81 2.71 0.75 1.63 1.18
## Fra 3.31 2.46 2.21 1.68 3.20 1.25 1.30 0.83 0.67
## Ger 3.35 2.54 2.23 1.71 3.59 1.65 1.61 1.18 1.01 0.46
## Gre 3.33 2.50 2.21 1.69 3.42 1.47 1.44 0.99 0.85 0.25 0.21
## Hun 3.87 2.98 3.09 2.58 1.73 0.83 2.07 1.84 1.32 1.87 2.29 2.10
## Ire 3.40 2.52 2.33 1.77 3.04 1.08 1.37 0.88 0.46 0.23 0.64 0.45 1.66
## Ita 3.73 3.06 2.64 2.26 4.55 2.62 2.28 1.94 1.97 1.41 0.97 1.17 3.26 1.60
## Lat 3.55 2.68 2.52 1.97 2.89 0.96 1.31 0.83 0.45 0.52 0.95 0.75 1.41 0.32 1.88
## Lit 4.47 3.63 3.80 3.32 1.61 1.62 2.73 2.56 2.11 2.66 3.08 2.89 0.81 2.44 4.03
## Lux 3.58 2.70 2.50 1.92 3.25 1.28 1.70 1.21 0.54 0.44 0.58 0.48 1.82 0.35 1.47
## Mlt 3.65 2.74 2.64 2.06 2.77 0.85 1.57 1.11 0.30 0.72 1.10 0.93 1.24 0.49 2.04
## Ned 3.65 2.84 2.52 2.02 3.82 1.85 1.76 1.31 1.16 0.65 0.31 0.43 2.43 0.79 0.85
## Pol 3.84 3.11 2.72 2.29 4.40 2.44 2.20 1.81 1.76 1.23 0.81 0.99 3.04 1.40 0.30
## Por 3.69 2.84 2.59 2.05 3.40 1.43 1.53 1.02 0.75 0.39 0.56 0.43 1.92 0.38 1.39
## Rom 3.87 3.13 2.75 2.31 4.37 2.41 2.21 1.81 1.72 1.21 0.79 0.98 3.00 1.37 0.38
## Svk 3.76 2.91 2.65 2.10 3.63 1.66 1.81 1.32 0.93 0.59 0.47 0.48 2.18 0.63 1.16
## Slo 3.80 2.91 2.78 2.23 2.85 0.99 1.48 1.01 0.56 0.79 1.18 1.00 1.26 0.59 2.08
## Spa 3.92 3.06 2.97 2.47 2.59 1.02 1.39 1.06 0.99 1.23 1.67 1.46 1.00 1.06 2.56
## Swe 5.89 5.70 5.38 5.43 5.79 5.16 3.71 4.09 5.23 4.88 5.10 4.98 5.19 4.95 5.37
## Lat Lit Lux Mlt Ned Pol Por Rom Svk Slo Spa
## Bel
## Bul
## Cro
## Cyp
## Cze
## Den
## Est
## Fin
## Fra
## Ger
## Gre
## Hun
## Ire
## Ita
## Lat
## Lit 2.18
## Lux 0.57 2.59
## Mlt 0.30 2.00 0.60
## Ned 1.05 3.19 0.65 1.20
## Pol 1.66 3.80 1.23 1.80 0.61
## Por 0.54 2.67 0.33 0.69 0.54 1.14
## Rom 1.63 3.76 1.19 1.76 0.58 0.08 1.10
## Svk 0.84 2.92 0.39 0.93 0.34 0.89 0.33 0.84
## Slo 0.29 1.99 0.73 0.26 1.24 1.84 0.70 1.80 0.99
## Spa 0.74 1.64 1.27 0.75 1.73 2.33 1.20 2.30 1.52 0.56
## Swe 4.82 5.44 5.24 5.07 5.13 5.35 4.96 5.38 5.22 4.87 4.55Princíp hierarchického zhlukovania (Wardova metóda)
Zhlukovanie v prípade Wardovej metódy prebieha zdola smerom nahor, t.j. začíname s jednočlennými klastrami, ktoré postupne zlučujeme. Táto metóda patrí teda medzi aglomeratívne hierarchické metódy. Minimalizuje nárast vnútornej variability pri spojení dvoch klastrov, pričom využíva nasledovné výpočty:
Wardová metóda minimalizuje sumu štvorcov chýb (Error sum of Squares - ESS)
\[ESS(C) = \sum_{i \in C} \lVert x_i - \bar{x}_C \rVert^2\] kde \(C\) je zvažovaný klaster (zhluk). V každom kroku zlučovania dvoch klasterov, Wardova metóda hľadá minimálny prírastok sumy štvorcov chýb (\(\Delta ESS\)), pričom
\[\Delta ESS = ESS(A \cup B) - ESS(A) - ESS(B)\] Dvojica zhlukov, ktoré tejto podmienke o minimalizácii vyhovuje, je následne zlúčená a prechádza sa k ďalšiemu kkroku. To spravidla vedie k vytváraniu homogénnych zhlukov, pričom nedochádza k odtrhávaniu odľahlých hodnôt tak, ako pri iných zhlukovacích metódach.
Obrázok 2 - Hierarchické zhlukovanie - dendogram
hc <- hclust(dist_mat, method = "ward.D2")
k <- 3
klaster_membership <- cutree(hc, k = k)
cluster_colors <- c("pink", "lightgreen", "orange")[klaster_membership]
plot(hc,
labels = rownames(eu_countries),
main = "Hierarchical clustering of EU countries (Ward.D2)",
xlab = "", sub = "",
hang = -1, cex = 0.8)
library(dendextend)##
## ---------------------
## Welcome to dendextend version 1.19.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------##
## Attaching package: 'dendextend'## The following object is masked from 'package:stats':
##
## cutreedend <- as.dendrogram(hc)
dend <- color_labels(dend, k = k, col = c("pink", "lightgreen", "orange"))
plot(dend, main = "Hierarchical clustering of EU countries (Ward.D2)")
h_cut <- hc$height[length(hc$height) - (k - 1)]
abline(h = h_cut, col = "red", lwd = 2, lty = 2)
udaje_klasters <- data.frame(
Country = rownames(eu_countries),
eu_countries,
klaster = factor(klaster_membership))Tabuľka 4 - Príslušnosť krajín podľa klastrov
data_prac <- data.frame(
Country = udaje_klasters$Country,
klaster = udaje_klasters$klaster)
data_pracDeskriptívne štatistiky výsledkov
Tabuľka 5 - Vysvetlenie vnútroklastrovej variability z hľadiska jednotlivých premenných
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_tableattach(eu_countries)
udaje_complete <- data.frame(cbind(eu_countries, udaje_klasters$klaster))
colnames(udaje_complete) <- c("Population", "Density", "GrowthRate", "klaster")Tabuľka 6 - Centroidy - priemerné hodnoty sledovaných premenných
eu_countries$klaster <- klaster_membership
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:kableExtra':
##
## group_rows## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondescriptives <- eu_countries %>%
group_by(klaster) %>%
summarise(
across(
.cols = c(Population, Density, GrowthRate),
.fns = list(mean = ~mean(.x, na.rm = TRUE)),
.names = "{.col}_{.fn}" ) )
descriptivesZáver
Predložená analýza sa zaoberá zhlukovaním členských štátov EÚ na základe troch demografických ukazovateľov – veľkosti populácie, hustoty obyvateľstva a miery populačného rastu. Pomocou hierarchického zhlukovania (Wardova metóda) boli krajiny rozdelené do troch klastrov s odlišným populačným profilom. Prvý klaster združuje veľké štáty s vyššou populáciou a priemernou hustotou obyvateľstva, druhý klaster tvorí skupina stredne veľkých krajín s nižšou populáciou a miernym rastom, zatiaľ čo tretí klaster zahŕňa malé, veľmi husto zaľudnené štáty. Výsledky ukazujú, že demografické charakteristiky sa medzi klastrami výrazne líšia najmä v celkovej veľkosti populácie a hustote osídlenia, zatiaľ čo miera rastu hrá pri zhlukovaní menšiu úlohu. Takto získaná klasifikácia môže slúžiť ako východisko pre tvorbu diferencovaných politík EÚ, napríklad pri plánovaní infraštruktúry, regionálneho rozvoja alebo alokácie verejných zdrojov podľa typu krajiny.