Zhluková analýza (klaster Analysis)

---

Úvod

Cieľom tohto cvičenia je aplikovať hierarchickú zhlukovú analýzu na dataset študentov, ktorý obsahuje:

• hodiny štúdia za deň,

• dĺžku spánku,

• percentuálnu dochádzku,

• predchádzajúce skóre,

• výsledné skóre z testu.

Zhluková analýza nám umožní identifikovať skupiny študentov so spoločnými charakteristikami – napr. “študenti, ktorí veľa študujú”, “študenti s nízkou dochádzkou” alebo “študenti s vysokými predpokladmi”.

library(knitr)
library(kableExtra)

rm(list=ls())

data <- read.csv("student_exam_scores.csv", stringsAsFactors = FALSE)
data_num <- subset(data, select = -student_id)
data_scaled <- scale(data_num)

Boxploty škálovaných premenných

num_vars <- as.data.frame(data_scaled)
num_plots <- ncol(num_vars)

par(mfrow = c(2, 3))
par(mar = c(4, 4, 2, 1))

for (col in names(num_vars)) {
boxplot(num_vars[[col]],
main = col,
col = "lightpink",
horizontal = TRUE)
}

mtext("Boxploty numerických premenných", outer = TRUE, cex = 1.3, font = 2)

Boxploty ukazujú rozloženie jednotlivých premenných po škálovaní. Môžeme vidieť, že niektorí študenti sú výrazne nad alebo pod priemerom, čo môže znamenať odlišné študijné návyky alebo výsledky. Napr. študenti s extrémne vysokým počtom hodín štúdia alebo veľmi nízkou dochádzkou.

Korelačná matica

cor_mat <- cor(data_scaled)
round(cor_mat, 2)

                   hours_studied sleep_hours attendance_percent previous_scores exam_score
hours_studied               1.00        0.08              -0.03            0.07       0.78
sleep_hours                 0.08        1.00               0.00           -0.19       0.19
attendance_percent         -0.03        0.00               1.00            0.05       0.23
previous_scores             0.07       -0.19               0.05            1.00       0.43
exam_score                  0.78        0.19               0.23            0.43       1.00

Korelačná matica ukazuje vzťahy medzi premennými. Ak sú niektoré premenné silno korelované (blízko 1 alebo -1), môžu poskytovať podobnú informáciu. V našom prípade sú korelácie mierne až stredné, takže všetky premenné sú vhodné do zhlukovej analýzy.

Matica vzdialeností (Euklidovská vzdialenosť)

dist_mat <- dist(data_scaled, method = "euclidean")
round(as.matrix(dist_mat), 2)

       1    2    3    4    5    6    7    8    9   10   11   12   13   14   15   16   17   18   19   20
1   0.00 2.44 3.04 3.71 3.03 3.37 3.83 4.00 3.37 2.77 3.81 2.96 3.24 2.86 3.40 1.63 2.08 1.48 3.24 4.06
2   2.44 0.00 2.84 3.87 4.28 3.80 4.47 3.22 3.56 1.07 3.60 3.52 2.61 2.10 3.88 2.50 1.62 2.79 4.58 2.51
3   3.04 2.84 0.00 3.02 2.56 2.79 2.93 4.21 1.72 2.21 2.50 1.29 2.04 2.19 1.84 3.46 3.07 2.13 3.80 3.93
4   3.71 3.87 3.02 0.00 2.29 3.06 4.04 2.83 1.79 3.72 1.26 2.64 1.55 2.60 4.32 4.59 3.08 2.76 2.15 3.93
5   3.03 4.28 2.56 2.29 0.00 2.48 2.81 4.39 1.73 4.06 2.59 1.74 2.80 3.11 2.92 3.91 3.54 1.78 1.70 4.98
      21   22   23   24   25   26   27   28   29   30   31   32   33   34   35   36   37   38   39   40
1   3.46 1.80 2.14 3.21 4.02 2.11 2.99 3.12 3.62 1.82 3.57 4.11 2.73 3.15 2.80 4.01 2.80 3.13 2.20 1.98
2   4.54 3.37 1.80 2.99 5.05 1.79 2.38 1.52 4.72 3.25 4.20 4.74 3.09 4.98 3.00 3.90 4.08 4.24 3.85 3.32
3   2.41 2.66 2.41 0.97 3.57 2.08 2.03 2.33 3.26 2.20 3.60 2.83 1.78 3.53 2.62 3.04 2.67 3.27 2.83 2.58
4   4.30 2.46 2.92 2.34 3.06 2.80 1.69 4.13 2.27 3.02 3.44 2.96 3.23 3.35 1.52 3.41 4.25 1.62 3.20 2.09
5   2.41 1.38 3.07 2.39 1.95 2.88 2.80 4.27 1.24 1.87 2.92 1.94 2.35 1.40 2.21 3.30 2.48 1.31 1.54 1.42
      41   42   43   44   45   46   47   48   49   50   51   52   53   54   55   56   57   58   59   60
1   2.15 3.23 3.51 2.18 3.71 1.71 4.16 2.91 3.59 3.47 2.85 1.97 3.28 4.14 1.85 1.45 4.45 3.44 4.02 2.08
2   3.54 3.00 3.35 2.85 3.41 2.04 3.67 2.66 4.44 3.33 3.40 2.21 3.07 5.11 2.71 3.06 4.25 4.25 3.60 1.79
3   2.98 3.78 1.18 2.88 3.46 2.64 2.34 1.80 2.01 2.00 3.38 2.51 3.55 3.12 1.90 2.32 2.76 2.68 2.09 1.54
4   2.17 2.55 2.11 2.82 1.33 2.47 1.61 1.75 2.85 1.88 1.43 2.32 2.03 4.13 3.90 3.31 1.41 2.37 1.76 3.55
5   1.50 3.86 2.16 2.93 3.29 2.81 2.85 2.32 1.33 2.34 2.54 2.76 3.30 2.42 2.75 2.13 2.64 1.39 2.65 3.14
      61   62   63   64   65   66   67   68   69   70   71   72   73   74   75   76   77   78   79   80
1   3.87 1.35 2.16 4.18 1.69 1.93 2.38 2.53 1.85 3.91 2.09 4.41 2.84 1.38 2.89 3.39 3.39 2.97 3.14 3.33
2   5.03 2.66 2.68 4.49 3.71 3.17 1.31 2.06 2.52 3.23 1.50 5.52 4.15 1.28 3.67 3.92 4.88 3.62 3.22 3.27
3   3.43 2.28 3.49 2.76 2.98 2.78 3.13 1.98 2.48 4.00 3.69 3.43 2.45 2.79 3.28 4.25 4.36 1.67 3.22 1.33
4   5.11 3.57 3.04 3.10 3.56 3.78 3.43 2.93 2.07 3.37 3.79 3.67 3.49 3.82 2.31 2.00 3.12 2.02 1.30 1.93
5   3.25 2.48 3.20 2.51 1.97 2.62 3.98 3.21 2.26 4.26 4.31 1.93 1.56 3.66 2.22 3.25 2.40 1.09 2.81 2.11
      81   82   83   84   85   86   87   88   89   90   91   92   93   94   95   96   97   98   99  100
1   0.89 3.94 3.67 4.75 3.06 2.37 4.64 3.12 3.29 3.33 4.10 1.96 2.18 3.03 2.18 1.82 2.50 4.72 3.81 1.71
2   2.25 3.27 3.99 5.84 3.68 2.75 5.75 3.86 2.66 2.55 3.25 2.66 3.51 2.75 0.91 2.54 4.16 4.64 4.98 3.42
3   2.77 2.77 1.55 3.61 2.11 3.36 3.42 4.17 1.77 3.25 3.40 1.85 2.23 3.15 2.67 3.19 3.44 3.18 3.68 3.43
4   3.12 3.28 3.45 3.53 1.40 3.00 4.99 2.15 1.74 2.03 2.69 3.46 3.04 3.24 3.11 2.33 3.37 3.39 3.11 4.42
5   2.69 3.58 2.31 1.91 1.21 3.47 2.99 3.02 2.69 3.60 3.86 2.47 1.46 3.47 3.67 2.79 1.98 3.27 1.94 3.17
     101  102  103  104  105  106  107  108  109  110  111  112  113  114  115  116  117  118  119  120
1   3.75 2.05 1.58 2.19 3.47 3.70 3.89 2.86 1.91 2.13 1.82 4.12 3.41 3.44 2.45 2.95 2.41 2.57 4.19 2.15
2   2.92 2.99 2.89 2.85 2.89 4.41 2.65 3.21 1.81 4.11 3.62 3.69 3.90 2.87 4.51 4.79 2.04 2.83 4.22 1.58
3   1.30 3.66 1.95 1.67 4.25 2.88 2.88 0.80 3.69 3.46 3.31 2.16 2.46 3.35 3.70 3.48 3.38 2.21 3.00 1.64
4   3.24 4.00 3.29 2.15 3.68 1.92 3.27 3.28 4.33 4.20 4.32 2.59 1.26 2.21 3.68 3.81 3.01 3.62 3.65 2.92
5   3.46 3.47 2.02 1.59 4.45 1.43 4.07 2.24 4.30 2.52 2.89 2.89 1.45 3.48 2.07 1.97 3.64 2.90 3.22 3.06
     121  122  123  124  125  126  127  128  129  130  131  132  133  134  135  136  137  138  139  140
1   3.92 2.67 3.67 2.85 4.15 3.50 3.92 2.56 2.47 2.34 1.91 4.50 3.26 3.79 2.29 2.86 3.93 1.13 3.30 4.05
2   5.24 3.30 4.69 3.70 3.42 3.70 3.44 4.07 3.53 3.55 1.60 3.78 4.63 4.83 1.93 3.69 2.87 3.33 4.40 3.04
3   3.11 1.43 2.23 1.55 4.19 1.15 2.96 3.00 2.86 2.53 2.16 2.48 2.63 3.77 2.15 1.61 2.67 3.25 2.43 2.42
4   3.70 3.74 3.71 2.88 2.39 2.60 1.49 4.49 4.39 4.14 3.55 2.27 3.76 3.58 2.64 2.82 2.86 3.38 2.47 3.18
5   1.89 2.43 1.83 1.61 4.24 2.03 3.24 2.74 3.04 2.62 3.27 3.37 1.64 2.51 3.08 1.58 3.71 2.35 0.55 3.71
     141  142  143  144  145  146  147  148  149  150  151  152  153  154  155  156  157  158  159  160
1   1.69 4.56 3.98 3.84 2.36 1.89 3.78 2.43 2.17 2.88 2.56 3.04 1.43 3.11 2.30 3.43 2.17 4.07 4.01 2.89
2   3.08 5.22 3.26 4.39 2.56 2.11 4.71 3.67 2.11 2.09 4.65 4.04 1.66 3.92 2.55 2.99 1.88 4.78 3.81 2.03
3   2.91 3.06 4.44 3.37 2.97 2.10 2.47 3.58 2.90 3.50 3.64 2.08 3.28 3.60 3.42 3.15 1.78 2.87 2.90 2.39
4   2.65 2.26 3.68 3.89 2.47 2.55 3.51 2.84 2.30 3.58 4.24 2.53 4.24 1.50 3.29 1.86 3.85 1.84 1.12 2.57
5   2.26 1.70 4.68 3.05 2.82 2.66 2.12 2.38 3.11 4.12 2.37 0.80 3.97 2.20 3.69 3.26 3.32 1.43 2.71 3.30
     161  162  163  164  165  166  167  168  169  170  171  172  173  174  175  176  177  178  179  180
1   2.36 2.17 1.94 2.13 3.91 2.79 3.86 4.16 3.90 2.44 3.84 1.02 1.55 3.90 4.20 4.29 2.94 3.23 3.77 1.33
2   1.04 3.17 1.79 3.69 5.03 2.54 3.09 5.00 3.73 2.32 5.13 2.30 2.60 4.97 4.91 4.17 2.19 3.20 3.73 2.55
3   2.51 3.59 2.36 3.04 2.94 2.57 2.47 2.48 3.11 3.56 2.96 2.43 2.36 2.63 2.87 2.90 1.29 1.91 1.85 2.52
4   2.91 2.85 2.24 3.32 2.77 1.71 3.09 3.23 1.13 3.36 3.44 2.89 2.32 3.17 3.76 1.02 2.31 2.05 2.45 2.67
5   3.61 2.79 2.77 2.01 1.07 2.86 3.49 1.82 2.73 4.00 1.32 2.37 2.10 1.52 2.35 2.55 2.83 2.21 2.29 2.36
     181  182  183  184  185  186  187  188  189  190  191  192  193  194  195  196  197  198  199  200
1   2.13 2.78 3.96 3.36 3.69 2.76 3.14 3.82 1.85 1.88 1.66 1.92 3.95 3.35 3.94 4.32 3.93 3.14 2.92 3.13
2   3.26 4.13 5.38 1.99 4.17 2.38 4.33 3.52 0.92 1.95 2.91 1.60 3.19 5.05 3.94 5.40 4.44 1.83 4.31 4.57
3   2.17 3.62 3.57 3.79 2.19 3.62 3.64 1.57 3.04 3.40 3.14 2.73 2.29 3.58 2.96 3.26 2.03 1.86 3.63 3.08
4   3.43 2.03 3.06 3.77 1.59 3.09 2.74 2.14 3.71 3.97 2.96 3.17 3.00 3.34 2.31 2.88 2.48 2.88 4.60 2.38
5   2.05 1.78 1.19 4.65 1.38 3.81 2.04 2.47 4.02 3.87 2.79 3.33 3.42 1.39 2.69 1.37 1.53 3.48 3.09 0.76
 [ reached 'max' / getOption("max.print") -- omitted 195 rows ]

Euklidovská matica vzdialeností ukazuje, ako sú jednotliví študenti “vzdialení” od seba z hľadiska všetkých premenných. Väčšia vzdialenosť znamená väčší rozdiel v študijných charakteristikách a výsledkoch testov.

Hierarchické zhlukovanie (Ward D2)

hc <- hclust(dist_mat, method = "ward.D2")

plot(hc,
     main = "Hierarchical clustering of students (Ward.D2)",
     xlab = "",
     sub = "",
     col = "lightpink") 
k <- 3
h_cut <- hc$height[length(hc$height) - (k - 1)]
abline(h = h_cut, col = "black", lwd = 2, lty = 2)

clusters <- cutree(hc, k = k)

Dendrogram ukazuje postupné zlučovanie študentov do klastrov. Rez pri 3 klastroch umožňuje rozdeliť študentov do troch skupín s podobnými charakteristikami.

Príslušnosť študentov ku klastrom

clustered <- data.frame(
student_id = data$student_id,
data_num,
klaster = factor(clusters)
)

clustered

NA

Tabuľka ukazuje, do ktorého klastru patrí každý študent. Napr. klaster 1 môžu tvoriť študenti s vysokou dochádzkou a dobrými výsledkami, klaster 2 študenti s priemernými výsledkami a klaster 3 študenti s nízkym počtom hodín štúdia alebo nízkou dochádzkou.

Vnútroklastrová variabilita

ssq <- function(x, m) sum((x - m)^2)

var_names <- colnames(data_scaled)

TSS <- sapply(var_names, function(v) ssq(data_scaled[, v], mean(data_scaled[, v])))

WSS <- sapply(var_names, function(v) {
x <- data_scaled[, v]
tapply(x, clusters, 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_table

NA

Tabuľka TSS, WSS, BSS a Prop_Between ukazuje, koľko variability je vysvetlene medzi klastrami. Vyššia hodnota Prop_Between znamená, že premenná dobre separuje študentov do klastrov. Napr. výsledné skóre môže byť kľúčová premenná, ktorá odlišuje klastre.

Centroidy klastrov (priemerné hodnoty)

library(dplyr)

descriptives <- clustered %>%
group_by(klaster) %>%
summarise(
across(
.cols = where(is.numeric),
mean,
na.rm = TRUE,
.names = "{.col}_mean"
)
)

descriptives

NA

Centroidy ukazujú priemerné hodnoty premenných v jednotlivých klastroch. Pomocou nich vieme charakterizovať klastre – napr. klaster 1: vysoké skóre a dochádzka, klaster 2: priemerné hodnoty, klaster 3: nižšie skóre alebo menej hodín štúdia.

Záver

Hierarchická zhluková analýza umožnila identifikovať tri odlišné skupiny študentov podľa ich študijných návykov a výsledkov. Analýza odhalila, že existujú študenti s vysokou dochádzkou a vysokými výsledkami, študenti s priemernými výsledkami a študenti s nižším počtom hodín štúdia alebo slabšími výsledkami. Tento typ analýzy môže byť užitočný pre učiteľov alebo školu na prispôsobenie podpory študentom, napríklad identifikovaním skupín, ktoré potrebujú viac pomoci alebo individuálneho prístupu.