1. Wstęp

Celem projektu jest zastosowanie metod redukcji wymiarów do danych o uczniach portugalskich szkół średnich (Student Performance Data Set z Kaggle). Dane zawierają informacje o ocenach, cechach demograficznych, sytuacji rodzinnej oraz stylu życia uczniów.

Pytania badawcze:

  1. Jakie główne wymiary (komponenty) opisują różnice między uczniami?
  2. Czy wiążą się one z końcową oceną z portugalskiego (G3)?
  3. Czy PCA i MDS dają podobny obraz struktury danych?

W projekcie wykorzystałam:

2. Dane i przygotowanie

student <- read.csv("student-por.csv", header = TRUE, sep = ",")

dim(student)
## [1] 649  33
str(student[, 1:10])
## 'data.frame':    649 obs. of  10 variables:
##  $ school : chr  "GP" "GP" "GP" "GP" ...
##  $ sex    : chr  "F" "F" "F" "F" ...
##  $ age    : int  18 17 15 15 16 16 16 17 15 15 ...
##  $ address: chr  "U" "U" "U" "U" ...
##  $ famsize: chr  "GT3" "GT3" "LE3" "GT3" ...
##  $ Pstatus: chr  "A" "T" "T" "T" ...
##  $ Medu   : int  4 1 1 4 3 4 2 4 3 3 ...
##  $ Fedu   : int  4 1 1 2 3 3 2 4 2 4 ...
##  $ Mjob   : chr  "at_home" "at_home" "at_home" "health" ...
##  $ Fjob   : chr  "teacher" "other" "other" "services" ...

Opis używanych zmiennych

  • age – wiek ucznia
  • Medu – wykształcenie matki
  • Fedu – wykształcenie ojca
  • traveltime – czas dojazdu do szkoły
  • studytime – czas nauki poza lekcjami
  • failures – liczba niezaliczonych klas/przedmiotów
  • famrel – relacje w rodzinie
  • freetime – ilość wolnego czasu po szkole
  • goout – wyjścia ze znajomymi
  • Dalc – picie alkoholu w dni robocze
  • Walc – picie alkoholu w weekend
  • health – ocena zdrowia
  • absences – liczba nieobecności w szkole
  • G3 – końcowa ocena z portugalskiego

Tworzę trzy poziomy końcowej oceny: low, mid, high.

summary(student$G3)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   10.00   12.00   11.91   14.00   19.00
student <- student %>%
  mutate(
    G3_group = cut(
      G3,
      breaks = c(-Inf, 9, 14, Inf),
      labels = c("low", "mid", "high")
    )
  )

table(student$G3_group)
## 
##  low  mid high 
##  100  418  131
ggplot(student, aes(x = G3)) +
  geom_histogram(binwidth = 1, fill = "grey80", color = "black") +
  labs(title = "Rozkład końcowej oceny G3",
       x = "G3",
       y = "Liczba uczniów") +
  theme_minimal()

ggplot(student, aes(x = G3_group, y = studytime, fill = G3_group)) +
  geom_boxplot(alpha = 0.7) +
  labs(title = "Czas nauki a poziom G3",
       x = "Grupa G3",
       y = "studytime") +
  theme_minimal()

Zbiór danych obejmuje 649 uczniów opisanych przez 33 zmienne: informacje o szkole, cechach demograficznych, rodzinie, stylu życia oraz wyniki w nauce. Na potrzeby interpretacji wyników redukcji wymiarów wprowadziłama dodatkową zmienną jakościową G3_group, dzielącą uczniów na trzy poziomy końcowej oceny z portugalskiego: low (0–9), mid (10–14) oraz high (15–19). Taki podział umożliwia późniejsze sprawdzenie, czy uczniowie o różnych wynikach tworzą rozłączne skupiska lub układają się w czytelny gradient na mapach PCA/MDS. Wstępne wykresy pokazują, że rozkład G3 jest typowy dla ocen szkolnych: większość uczniów znajduje się w grupie mid, mniej w high, a najmniej w low. Boxplot czasu nauki (studytime) względem grupy G3 sugeruje dodatnią zależność: uczniowie z wyższą oceną częściej mają większy czas przeznaczany na naukę, choć zależność nie jest idealnie rozdzielająca (widoczne są nakładania się rozkładów między grupami). To stanowi dobrą motywację do zastosowania metod redukcji wymiarów: zależności są wielowymiarowe i nie da się ich uchwycić jednym prostym wykresem.

3. PCA – analiza głównych komponentów

Celem PCA jest zamiana wielu korelujących zmiennych liczbowych na kilka składowych głównych, które są nieskorelowane i opisują główne kierunki zmienności w danych.

3.1 Wybór zmiennych i przygotowanie danych

vars_pca <- c(
  "age",
  "Medu", "Fedu",
  "traveltime", "studytime", "failures",
  "famrel", "freetime", "goout",
  "Dalc", "Walc",
  "health", "absences"
)

data_pca <- student %>%
  select(all_of(vars_pca))

summary(data_pca)
##       age             Medu            Fedu         traveltime   
##  Min.   :15.00   Min.   :0.000   Min.   :0.000   Min.   :1.000  
##  1st Qu.:16.00   1st Qu.:2.000   1st Qu.:1.000   1st Qu.:1.000  
##  Median :17.00   Median :2.000   Median :2.000   Median :1.000  
##  Mean   :16.74   Mean   :2.515   Mean   :2.307   Mean   :1.569  
##  3rd Qu.:18.00   3rd Qu.:4.000   3rd Qu.:3.000   3rd Qu.:2.000  
##  Max.   :22.00   Max.   :4.000   Max.   :4.000   Max.   :4.000  
##    studytime        failures          famrel         freetime   
##  Min.   :1.000   Min.   :0.0000   Min.   :1.000   Min.   :1.00  
##  1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:4.000   1st Qu.:3.00  
##  Median :2.000   Median :0.0000   Median :4.000   Median :3.00  
##  Mean   :1.931   Mean   :0.2219   Mean   :3.931   Mean   :3.18  
##  3rd Qu.:2.000   3rd Qu.:0.0000   3rd Qu.:5.000   3rd Qu.:4.00  
##  Max.   :4.000   Max.   :3.0000   Max.   :5.000   Max.   :5.00  
##      goout            Dalc            Walc          health     
##  Min.   :1.000   Min.   :1.000   Min.   :1.00   Min.   :1.000  
##  1st Qu.:2.000   1st Qu.:1.000   1st Qu.:1.00   1st Qu.:2.000  
##  Median :3.000   Median :1.000   Median :2.00   Median :4.000  
##  Mean   :3.185   Mean   :1.502   Mean   :2.28   Mean   :3.536  
##  3rd Qu.:4.000   3rd Qu.:2.000   3rd Qu.:3.00   3rd Qu.:5.000  
##  Max.   :5.000   Max.   :5.000   Max.   :5.00   Max.   :5.000  
##     absences     
##  Min.   : 0.000  
##  1st Qu.: 0.000  
##  Median : 2.000  
##  Mean   : 3.659  
##  3rd Qu.: 6.000  
##  Max.   :32.000

3.2 Dopasowanie PCA

pca_fit <- prcomp(data_pca, scale. = TRUE)

summary(pca_fit)            # informacja o wyjaśnionej wariancji
## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     1.5048 1.3664 1.1516 1.07367 1.02956 0.97058 0.93309
## Proportion of Variance 0.1742 0.1436 0.1020 0.08867 0.08154 0.07246 0.06697
## Cumulative Proportion  0.1742 0.3178 0.4198 0.50849 0.59003 0.66250 0.72947
##                            PC8     PC9    PC10    PC11    PC12   PC13
## Standard deviation     0.92094 0.88485 0.80333 0.74800 0.60201 0.5644
## Proportion of Variance 0.06524 0.06023 0.04964 0.04304 0.02788 0.0245
## Cumulative Proportion  0.79471 0.85494 0.90458 0.94762 0.97550 1.0000
pca_fit$rotation[, 1:2]     # ładunki na pierwszych dwóch składowych
##                    PC1          PC2
## age        -0.25695721 -0.125059021
## Medu        0.23358641  0.554727993
## Fedu        0.19408057  0.567114772
## traveltime -0.19030974 -0.279734928
## studytime   0.25672321 -0.008648206
## failures   -0.29264857 -0.196036990
## famrel      0.05124359  0.051873593
## freetime   -0.21781698  0.151633771
## goout      -0.35379513  0.244640857
## Dalc       -0.44946733  0.232413806
## Walc       -0.47245498  0.284097362
## health     -0.06729120  0.109375839
## absences   -0.22129504  0.077702167

Wyniki PCA pokazują, że:

  • PC1 wyjaśnia ~17.4% wariancji,

  • PC2 wyjaśnia ~14.4%,

Razem PC1+PC2 ≈ 31.8% całkowitej zmienności.

To typowy rezultat dla danych społeczno-edukacyjnych: nie ma jednej zmiennej lub jednego czynnika, który tłumaczy „prawie wszystko”, tylko wiele umiarkowanych zależności. Scree plot wskazuje na stopniowe zmniejszanie się wkładu kolejnych składowych.

3.3 Scree plot

var_explained <- pca_fit$sdev^2 / sum(pca_fit$sdev^2)

scree_df <- data.frame(
  PC = 1:length(var_explained),
  Variance = var_explained
)

ggplot(scree_df, aes(x = PC, y = Variance)) +
  geom_line() +
  geom_point() +
  ylim(0, 1) +
  scale_x_continuous(breaks = 1:length(var_explained)) +
  labs(
    title = "Scree plot – udział wyjaśnionej wariancji",
    x = "Składowa główna",
    y = "Proporcja wariancji"
  ) +
  theme_minimal()

3.4 Interpretacja pierwszych składowych

loadings <- pca_fit$rotation
loadings_pc1 <- sort(loadings[,1], decreasing = TRUE)
loadings_pc2 <- sort(loadings[,2], decreasing = TRUE)

loadings_pc1
##   studytime        Medu        Fedu      famrel      health  traveltime 
##  0.25672321  0.23358641  0.19408057  0.05124359 -0.06729120 -0.19030974 
##    freetime    absences         age    failures       goout        Dalc 
## -0.21781698 -0.22129504 -0.25695721 -0.29264857 -0.35379513 -0.44946733 
##        Walc 
## -0.47245498
loadings_pc2
##         Fedu         Medu         Walc        goout         Dalc     freetime 
##  0.567114772  0.554727993  0.284097362  0.244640857  0.232413806  0.151633771 
##       health     absences       famrel    studytime          age     failures 
##  0.109375839  0.077702167  0.051873593 -0.008648206 -0.125059021 -0.196036990 
##   traveltime 
## -0.279734928

Ładunki PC1 mają największe wartości (bezwzględne) dla: Walc, Dalc, goout (silnie ujemne), oraz w mniejszym stopniu failures, age, absences (ujemne), przeciwstawione studytime (dodatnie) i częściowo Medu/Fedu (dodatnie). Oznacza to, że PC1 tworzy oś interpretowalną jako „styl funkcjonowania ucznia”: z jednej strony częstsze wyjścia i większe spożycie alkoholu (oraz bardziej problematyczny przebieg nauki: niepowodzenia, absencje), a z drugiej — bardziej „szkolny” profil z większym czasem nauki. W praktyce jest to wymiar zachowań i nawyków, który często bywa powiązany z wynikami.

PC2 jest najsilniej zbudowany przez: Fedu i Medu (bardzo wysokie dodatnie ładunki), oraz umiarkowanie dodatnie: Walc/goout/Dalc, przy czym traveltime i częściowo failures mają ładunki ujemne. Wymiar PC2 można opisać jako „kapitał edukacyjny rodziny i warunki sprzyjające nauce” (wykształcenie rodziców, pośrednio zasoby/organizacja), częściowo zmieszany z komponentem stylu życia. Ujemny wkład traveltime sugeruje, że dłuższy dojazd częściej współwystępuje z mniej korzystnym kontekstem (lub mniejszym dostępem do zasobów), co jest spójne z intuicją edukacyjną.

3.5 Rzut uczniów na PC1–PC2

pca_df <- student %>%
  select(G3, G3_group)

autoplot(
  pca_fit,
  data = pca_df,
  colour = "G3_group",
  loadings = TRUE,
  loadings.label = TRUE,
  loadings.label.size = 3
) +
  scale_colour_manual(values = c("low" = "red", "mid" = "orange", "high" = "darkgreen")) +
  labs(
    title = "PCA – uczniowie na płaszczyźnie PC1–PC2",
    colour = "Poziom G3"
  ) +
  theme_minimal()
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the ggfortify package.
##   Please report the issue at <https://github.com/sinhrks/ggfortify/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Rzut uczniów na płaszczyźnie PC1–PC2, pokolorowany według G3_group, pozwala wizualnie ocenić, czy uczniowie o wysokich i niskich wynikach układają się w różne obszary przestrzeni

3.6 Korelacje PC1/PC2 z G3

coords_pca <- as.data.frame(pca_fit$x) %>%
  mutate(
    G3 = student$G3,
    G3_group = student$G3_group
  )

cor(coords_pca$PC1, coords_pca$G3)
## [1] 0.3929479
cor(coords_pca$PC2, coords_pca$G3)
## [1] 0.1644794

Policzone korelacje pokazują, że:

  • PC1 ma umiarkowaną dodatnią korelację z G3 (~0.39),

  • PC2 ma słabszą korelację z G3 (~0.16)

To wzmacnia interpretację, że najsilniejszy „wymiar różnic” związany z wynikiem dotyczy codziennych nawyków i zachowań (nauka vs. imprezy/alkohol/absencje), natomiast tło rodzinne ma wpływ bardziej pośredni lub rozproszony pomiędzy kilka wymiarów.

4. MDS – mapa podobieństwa uczniów

Metoda MDS (Multidimensional Scaling) pozwala przedstawić uczniów na mapie tak, aby odległości między punktami odzwierciedlały ich podobieństwo.

4.1 Zmienne do MDS i odległość Gowera

W MDS celowo użyłam mieszanki zmiennych liczbowych i kategorycznych. Żeby móc policzyć sensowne odległości między uczniami przy takim miksie typów danych, zastosowałam odległość Gowera, która: normalizuje różnice w zmiennych liczbowych, porównuje zgodność/niezgodność w kategoriach, a następnie składa to w jedną miarę „podobieństwa profilu ucznia”. Dzięki temu porównanie dwóch osób nie sprowadza się wyłącznie do liczb, tylko obejmuje też kontekst społeczny i rodzinny

vars_mds <- c(
  "sex", "age", "address", "famsize", "Pstatus",
  "Medu", "Fedu", "Mjob", "Fjob",
  "studytime", "failures",
  "schoolsup", "famsup", "activities", "higher", "internet", "romantic",
  "freetime", "goout", "Dalc", "Walc",
  "absences"
)

data_mds <- student %>%
  select(all_of(vars_mds))

data_mds <- data_mds %>%
  mutate(across(where(is.character), as.factor))

str(data_mds[, 1:10])
## 'data.frame':    649 obs. of  10 variables:
##  $ sex      : Factor w/ 2 levels "F","M": 1 1 1 1 1 2 2 1 2 2 ...
##  $ age      : int  18 17 15 15 16 16 16 17 15 15 ...
##  $ address  : Factor w/ 2 levels "R","U": 2 2 2 2 2 2 2 2 2 2 ...
##  $ famsize  : Factor w/ 2 levels "GT3","LE3": 1 1 2 1 1 2 2 1 2 1 ...
##  $ Pstatus  : Factor w/ 2 levels "A","T": 1 2 2 2 2 2 2 1 1 2 ...
##  $ Medu     : int  4 1 1 4 3 4 2 4 3 3 ...
##  $ Fedu     : int  4 1 1 2 3 3 2 4 2 4 ...
##  $ Mjob     : Factor w/ 5 levels "at_home","health",..: 1 1 1 2 3 4 3 3 4 3 ...
##  $ Fjob     : Factor w/ 5 levels "at_home","health",..: 5 3 3 4 3 3 3 5 3 3 ...
##  $ studytime: int  2 2 2 3 2 2 2 2 2 2 ...
dist_gower <- gower.dist(data_mds)
dist_gower[1:5, 1:5]
##           [,1]      [,2]      [,3]      [,4]      [,5]
## [1,] 0.0000000 0.3161526 0.3291396 0.4607684 0.3027597
## [2,] 0.3161526 0.0000000 0.2004870 0.2809794 0.1684253
## [3,] 0.3291396 0.2004870 0.0000000 0.4327652 0.3104708
## [4,] 0.4607684 0.2809794 0.4327652 0.0000000 0.2943723
## [5,] 0.3027597 0.1684253 0.3104708 0.2943723 0.0000000

4.2 MDS (smacof) w dwóch wymiarach

set.seed(123)
mds_fit <- mds(dist_gower, ndim = 2, type = "ratio")

mds_fit
## 
## Call:
## mds(delta = dist_gower, ndim = 2, type = "ratio")
## 
## Model: Symmetric SMACOF 
## Number of objects: 649 
## Stress-1 value: 0.323 
## Number of iterations: 78
mds_coords <- as.data.frame(mds_fit$conf) %>%
  mutate(
    G3 = student$G3,
    G3_group = student$G3_group,
    sex = student$sex
  )

head(mds_coords)
##           D1         D2 G3 G3_group sex
## 1 -0.6550595  0.8034629 11      mid   F
## 2 -0.2605458  0.1342581 11      mid   F
## 3 -0.5212779 -0.4158342 12      mid   F
## 4  0.1000677  0.6361125 14      mid   F
## 5 -0.2899354  0.2139943 13      mid   F
## 6  0.4855614  0.1405619 13      mid   M

4.3 Stress plot

plot(mds_fit, plot.type = "stressplot",
     main = "MDS – stressplot")

MDS w 2 wymiarach dał Stress-1 ≈ 0.323, co oznacza, że odwzorowanie dwuwymiarowe jest raczej przybliżeniem.

4.4 Mapa MDS

ggplot(mds_coords, aes(x = D1, y = D2, colour = G3_group, shape = sex)) +
  geom_point(alpha = 0.8, size = 2) +
  scale_colour_manual(values = c("low" = "red", "mid" = "orange", "high" = "darkgreen")) +
  labs(
    title = "MDS (Gower) – mapa podobieństwa uczniów",
    x = "Wymiar 1",
    y = "Wymiar 2",
    colour = "Poziom G3",
    shape = "Płeć"
  ) +
  theme_minimal()

cor(mds_coords$D1, mds_coords$G3)
## [1] 0.1059692
cor(mds_coords$D2, mds_coords$G3)
## [1] 0.3058348

Na mapie MDS punkty bliżej siebie oznaczają uczniów o bardziej podobnych profilach (demografia + rodzina + styl życia + wsparcie). Oznaczenie kolorem G3_group pokazuje, czy wynik końcowy tworzy wyraźne obszary. Korelacje wskazują, że:

  • D1 jest słabo skorelowany z G3 (~0.11),

  • D2 jest wyraźniej skorelowany z G3 (~0.31).

To sugeruje, że w MDS zależność między „profilem ucznia” a oceną ujawnia się bardziej w drugim wymiarze niż w pierwszym. Ponieważ MDS bazuje na odległościach z wielu typów zmiennych, D2 może „zbierać” kombinację warunków rodzinnych i szkolnych, które wspierają wynik (np. wykształcenie rodziców, wsparcie, aspiracje, dostęp do internetu), nawet jeśli nie da się tego opisać jednym prostym czynnikiem

5. Porównanie PCA i MDS

p1 <- ggplot(coords_pca, aes(x = PC1, y = PC2, colour = G3_group)) +
  geom_point(alpha = 0.8) +
  scale_colour_manual(values = c("low" = "red", "mid" = "orange", "high" = "darkgreen")) +
  labs(title = "PCA – PC1 vs PC2", colour = "Poziom G3") +
  theme_minimal()

p2 <- ggplot(mds_coords, aes(x = D1, y = D2, colour = G3_group)) +
  geom_point(alpha = 0.8) +
  scale_colour_manual(values = c("low" = "red", "mid" = "orange", "high" = "darkgreen")) +
  labs(title = "MDS (Gower) – D1 vs D2", colour = "Poziom G3") +
  theme_minimal()

grid.arrange(p1, p2, ncol = 2)

Porównanie wykresów PCA (PC1–PC2) i MDS (D1–D2) pokazuje, że obie metody rysują strukturę danych w inny sposób, bo optymalizują różne kryteria:

PCA maksymalizuje wyjaśnioną wariancję w zmiennych liczbowych i daje komponenty łatwe do interpretacji przez ładunki.

MDS stara się zachować odległości między uczniami wynikające z mieszaniny cech (liczbowych i kategorycznych), ale osie nie mają tak bezpośredniej interpretacji jak w PCA.

Wyniki sugerują też, że PCA lepiej ujawnia liniowy związek z G3 poprzez zachowania ucznia (PC1), natomiast MDS pokazuje bardziej „kontekstowy” obraz podobieństw (rodzina, wsparcie, środowisko), co może dawać inny rozkład grup na mapie.

6. Wnioski

Analiza redukcji wymiarów pokazała, że dane o uczniach mają strukturę wielowymiarową, a wynik końcowy (G3) nie wynika z jednej cechy, tylko z kombinacji zachowań i kontekstu rodzinnego. W PCA pierwszy komponent (PC1) można interpretować jako oś nawyki szkolne vs. styl towarzysko-rozrywkowy (alkohol/wyjścia/absencje/niepowodzenia) i to właśnie on ma najsilniejszy związek z G3. Drugi komponent (PC2) jest mocno związany z wykształceniem rodziców i szerzej rozumianym kapitałem edukacyjnym rodziny, jednak jego bezpośrednia korelacja z G3 jest słabsza, co sugeruje bardziej pośredni wpływ. W MDS, dzięki użyciu odległości Gowera, możliwe było uwzględnienie jednocześnie zmiennych liczbowych i kategorycznych, co daje pełniejszy opis „profilu ucznia”. Dwuwymiarowa mapa MDS ma jednak umiarkowanie duży stres, więc należy ją traktować jako przybliżenie. Mimo to, jeden z wymiarów MDS (D2) wykazuje zauważalny związek z G3, co wskazuje, że w danych istnieje gradient podobieństw związany z wynikami, ale jest on rozproszony w wielu cechach kontekstowych.