Klastrowanie i redukcja wymiarów na podstawie danych World Happiness Report
Igor Piotrowski
2026-01-30
library(cluster)
library(factoextra)## Ładowanie wymaganego pakietu: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(flexclust)
library(fpc)
library(ClusterR)
library(tidyverse)## Warning: pakiet 'tidyverse' został zbudowany w wersji R 4.5.2## Warning: pakiet 'readr' został zbudowany w wersji R 4.5.2## Warning: pakiet 'forcats' został zbudowany w wersji R 4.5.2## Warning: pakiet 'lubridate' został zbudowany w wersji R 4.5.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.5.2
## ✔ lubridate 1.9.4 ✔ tibble 3.3.0
## ✔ purrr 1.1.0 ✔ tidyr 1.3.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(lattice)##
## Dołączanie pakietu: 'lattice'
##
## Następujące obiekty zostały zakryte z 'package:flexclust':
##
## barchart, bwplot, densityplot, histogramlibrary(psych)##
## Dołączanie pakietu: 'psych'
##
## Następujące obiekty zostały zakryte z 'package:ggplot2':
##
## %+%, alphalibrary(doBy)##
## Dołączanie pakietu: 'doBy'
##
## Następujący obiekt został zakryty z 'package:dplyr':
##
## order_bylibrary(rstatix)##
## Dołączanie pakietu: 'rstatix'
##
## Następujący obiekt został zakryty z 'package:stats':
##
## filterlibrary(ggpubr)
library(ggplot2)
library(dplyr)Wstęp
Celem niniejszej analizy jest grupowanie krajów na podstawie wybranych czynników wpływających na poziom szczęścia, takich jak poziom PKB, wsparcie społeczne, zdrowie, wolność, hojność oraz postrzeganie korupcji. W analizie wykorzystano dane dla roku 2024, aby uniknąć wielokrotnego występowania tych samych krajów.
Zastosowano metody redukcji wymiarów (PCA, MDS) oraz algorytmy klastrowania: K-means, PAM oraz CLARA.
Opis danych
Dane wykorzystane w analizie pochodzą z World Happiness Report, corocznego raportu publikowanego pod auspicjami United Nations Sustainable Development Solutions Network (SDSN). Zbiór danych obejmuje informacje dotyczące poziomu szczęścia oraz czynników społeczno-ekonomicznych wpływających na dobrostan mieszkańców poszczególnych krajów.
W analizie uwzględniono dane dla roku 2024, co pozwoliło uniknąć wielokrotnego występowania tych samych krajów. Przed przystąpieniem do dalszych analiz dane zostały oczyszczone z braków oraz poddane standaryzacji.
#Wczytanie danych
Dane <- read.csv("danedoklastrowania.csv", sep = ";", dec = ",", header = TRUE)
head(Dane)## Year Rank Country.name Life.evaluation..3.year.average. Lower.whisker
## 1 2024 147 Afghanistan 1.364 1.301
## 2 2023 143 Afghanistan 1.721 1.667
## 3 2022 137 Afghanistan 1.859 1.795
## 4 2021 146 Afghanistan 2.404 2.339
## 5 2020 150 Afghanistan 2.523 2.449
## 6 2019 153 Afghanistan 2.567 2.506
## Upper.whisker Explained.by..Log.GDP.per.capita Explained.by..Social.support
## 1 1.427 0.649 0.000
## 2 1.775 0.628 0.000
## 3 1.923 0.645 0.000
## 4 2.469 0.758 0.000
## 5 2.596 0.370 0.000
## 6 2.628 0.301 0.356
## Explained.by..Healthy.life.expectancy
## 1 0.155
## 2 0.242
## 3 0.087
## 4 0.289
## 5 0.126
## 6 0.266
## Explained.by..Freedom.to.make.life.choices Explained.by..Generosity
## 1 0 0.075
## 2 0 0.091
## 3 0 0.093
## 4 0 0.089
## 5 0 0.122
## 6 0 0.135
## Explained.by..Perceptions.of.corruption Dystopia...residual X X.1 X.2 X.3
## 1 0.135 0.348 NA NA NA NA
## 2 0.088 0.672 NA NA NA NA
## 3 0.059 0.976 NA NA NA NA
## 4 0.005 1.263 NA NA NA NA
## 5 0.010 1.895 NA NA NA NA
## 6 0.001 1.507 NA NA NA NA
## X.4 X.5 X.6 X.7 X.8 X.9 X.10 X.11 X.12 X.13 X.14
## 1 NA NA NA NA NA NA NA NA NA NA NA
## 2 NA NA NA NA NA NA NA NA NA NA NA
## 3 NA NA NA NA NA NA NA NA NA NA NA
## 4 NA NA NA NA NA NA NA NA NA NA NA
## 5 NA NA NA NA NA NA NA NA NA NA NA
## 6 NA NA NA NA NA NA NA NA NA NA NAglimpse(Dane)## Rows: 2,624
## Columns: 28
## $ Year <int> 2024, 2023, 2022, 2021, 202…
## $ Rank <int> 147, 143, 137, 146, 150, 15…
## $ Country.name <chr> "Afghanistan", "Afghanistan…
## $ Life.evaluation..3.year.average. <dbl> 1.364, 1.721, 1.859, 2.404,…
## $ Lower.whisker <dbl> 1.301, 1.667, 1.795, 2.339,…
## $ Upper.whisker <dbl> 1.427, 1.775, 1.923, 2.469,…
## $ Explained.by..Log.GDP.per.capita <dbl> 0.649, 0.628, 0.645, 0.758,…
## $ Explained.by..Social.support <dbl> 0.000, 0.000, 0.000, 0.000,…
## $ Explained.by..Healthy.life.expectancy <dbl> 0.155, 0.242, 0.087, 0.289,…
## $ Explained.by..Freedom.to.make.life.choices <dbl> 0.000, 0.000, 0.000, 0.000,…
## $ Explained.by..Generosity <dbl> 0.075, 0.091, 0.093, 0.089,…
## $ Explained.by..Perceptions.of.corruption <dbl> 0.135, 0.088, 0.059, 0.005,…
## $ Dystopia...residual <dbl> 0.348, 0.672, 0.976, 1.263,…
## $ X <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.1 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.2 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.3 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.4 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.5 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.6 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.7 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.8 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.9 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.10 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.11 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.12 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.13 <lgl> NA, NA, NA, NA, NA, NA, NA,…
## $ X.14 <lgl> NA, NA, NA, NA, NA, NA, NA,…summary(Dane)## Year Rank Country.name
## Min. :2011 Min. : 1.00 Length:2624
## 1st Qu.:2015 1st Qu.: 38.00 Class :character
## Median :2018 Median : 76.00 Mode :character
## Mean :2018 Mean : 76.43
## 3rd Qu.:2021 3rd Qu.:114.00
## Max. :2024 Max. :158.00
## NA's :655 NA's :655
## Life.evaluation..3.year.average. Lower.whisker Upper.whisker
## Min. :1.364 Min. :1.301 Min. :1.427
## 1st Qu.:4.596 1st Qu.:4.638 1st Qu.:4.885
## Median :5.456 Median :5.529 Median :5.775
## Mean :5.452 Mean :5.419 Mean :5.649
## 3rd Qu.:6.295 3rd Qu.:6.254 3rd Qu.:6.458
## Max. :7.856 Max. :7.780 Max. :7.904
## NA's :655 NA's :1749 NA's :1749
## Explained.by..Log.GDP.per.capita Explained.by..Social.support
## Min. :0.0000 Min. :0.0000
## 1st Qu.:0.9012 1st Qu.:0.8508
## Median :1.2635 Median :1.1065
## Mean :1.2203 Mean :1.0785
## 3rd Qu.:1.5670 3rd Qu.:1.3610
## Max. :2.2090 Max. :1.8400
## NA's :1752 NA's :1752
## Explained.by..Healthy.life.expectancy
## Min. :0.0000
## 1st Qu.:0.3830
## Median :0.5550
## Mean :0.5429
## 3rd Qu.:0.7047
## Max. :1.1380
## NA's :1754
## Explained.by..Freedom.to.make.life.choices Explained.by..Generosity
## Min. :0.0000 Min. :0.0000
## 1st Qu.:0.4505 1st Qu.:0.0920
## Median :0.5710 Median :0.1405
## Mean :0.5637 Mean :0.1543
## 3rd Qu.:0.6760 3rd Qu.:0.2050
## Max. :1.0180 Max. :0.5700
## NA's :1753 NA's :1752
## Explained.by..Perceptions.of.corruption Dystopia...residual X
## Min. :0.0000 Min. :-0.110 Mode:logical
## 1st Qu.:0.0620 1st Qu.: 1.455 NA's:2624
## Median :0.1130 Median : 1.854
## Mean :0.1444 Mean : 1.833
## 3rd Qu.:0.1800 3rd Qu.: 2.237
## Max. :0.5870 Max. : 3.482
## NA's :1753 NA's :1756
## X.1 X.2 X.3 X.4 X.5
## Mode:logical Mode:logical Mode:logical Mode:logical Mode:logical
## NA's:2624 NA's:2624 NA's:2624 NA's:2624 NA's:2624
##
##
##
##
##
## X.6 X.7 X.8 X.9 X.10
## Mode:logical Mode:logical Mode:logical Mode:logical Mode:logical
## NA's:2624 NA's:2624 NA's:2624 NA's:2624 NA's:2624
##
##
##
##
##
## X.11 X.12 X.13 X.14
## Mode:logical Mode:logical Mode:logical Mode:logical
## NA's:2624 NA's:2624 NA's:2624 NA's:2624
##
##
##
##
## dim(Dane)## [1] 2624 28help(eclust)## uruchamianie serwera httpd dla pomocy ... wykonano# 3. Czyszczenie i przygotowanie danych
# Wybieramy tylko rok 2024 (żeby kraje się nie powtarzały)
Dane_2024 <- Dane %>%
filter(Year == 2024) %>%
select(Country.name, starts_with("Explained.by")) %>%
column_to_rownames("Country.name") %>% # Ustawiamy nazwy krajów jako nazwy wierszy
na.omit() # Usuwamy ewentualne braki danych
# Nadajemy czytelniejsze nazwy kolumnom
colnames(Dane_2024) <- c("GDP", "Social_Support", "Healthy_Life",
"Freedom", "Generosity", "Corruption")
# Standaryzacja danych
Dane_scaled <- scale(Dane_2024)# ---------------------------------------------------------
# ETAP 1: Redukcja wymiarów (PCA)
# ---------------------------------------------------------
# Obliczamy PCA
pca_result <- prcomp(Dane_scaled, center = TRUE, scale. = TRUE)
summary(pca_result)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.713 1.0763 0.8845 0.7913 0.55348 0.43892
## Proportion of Variance 0.489 0.1931 0.1304 0.1044 0.05106 0.03211
## Cumulative Proportion 0.489 0.6821 0.8125 0.9168 0.96789 1.00000# Wykres zmienności (Scree plot)
fviz_eig(pca_result, addlabels = TRUE, ylim = c(0, 60),
main = "Ile zmienności wyjaśniają poszczególne wymiary PCA?")## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
# Wykres zmiennych na kole korelacji
fviz_pca_var(pca_result, col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
title = "Rysunek 2. Wpływ zmiennych na wymiary PCA")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
## Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## 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 factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Rysunek 1 & 2: Analiza Składowych Głównych (PCA) Wykresy te
ilustrują, w jakim stopniu pierwotne zmienne (PKB, wsparcie społeczne,
zdrowie) budują nowe wymiary. Pierwszy wymiar PCA jest silnie
skorelowany z poziomem zamożności (GDP) i oczekiwaną długością życia.
Pozwala to na interpretację osi poziomej jako ogólnego poziomu rozwoju
kraju.
# ---------------------------------------------------------
# ETAP 2: Klastrowanie (K-Means)
# ---------------------------------------------------------
# Metoda łokcia (Elbow Method) - aby ustalić optymalną liczbę klastrów
fviz_nbclust(Dane_scaled, kmeans, method = "wss") +
geom_vline(xintercept = 3, linetype = 2) +
labs(title = "Rysunek 3. Dobór liczby klastrów",
subtitle = "Metoda Łokcia (Elbow Method) dla algorytmu K-Means",
x = "Liczba klastrów (k)",
y = "Wariancja wewnątrzklastrowa (WSS)")
# Ustawiamy ziarno losowości dla powtarzalności wyników
set.seed(123)
# Wykonujemy K-Means (załóżmy k=3 na podstawie metody łokcia)
final_kmeans <- kmeans(Dane_scaled, centers = 3, nstart = 25)
# WYKRES 4: Wyniki K-Means
rownames(Dane_scaled) <- iconv(
rownames(Dane_scaled),
from = "latin1",
to = "UTF-8")
fviz_cluster(final_kmeans, data = Dane_scaled,
palette = c("#2E9FDF", "#E7B800", "#FC4E07"),
ggtheme = theme_minimal(),
main = "Rysunek 4. Wyniki klastrowania metodą K-Means",
subtitle = "Podział krajów na 3 grupy w rzucie na 2 pierwsze wymiary PCA",
xlab = "Wymiar 1 (GDP)",
ylab = "Wymiar 2 (Social_Support")
# =========================================================
# CZĘŚĆ A: Klastrowanie metodą PAM
# =========================================================
# PAM jest bardziej odporny na "szum" w danych niż K-Means.
# Używamy k=3 (zakładając 3 grupy na podstawie wcześniejszej analizy)
pam_result <- pam(Dane_scaled, k = 3)
# Wizualizacja PAM
fviz_cluster(pam_result,
palette = c("#2E9FDF", "#E7B800", "#FC4E07"),
ellipse.type = "t",
repel = TRUE,
ggtheme = theme_classic(),
main = "Klastrowanie metodą PAM")
# =========================================================
# CZĘŚĆ B: Klastrowanie metodą CLARA
# =========================================================
# CLARA działa na próbkach danych - idealna dla bardzo dużych zbiorów.
# W tym małym zbiorze da wynik zbliżony do PAM.
clara_result <- clara(Dane_scaled, k = 3, samples = 50)
# Wizualizacja CLARA
fviz_cluster(clara_result,
palette = c("#2E9FDF", "#E7B800", "#FC4E07"),
ellipse.type = "t",
geom = "point",
ggtheme = theme_minimal(),
main = "Klastrowanie metodą CLARA")
# ---------------------------------------------------------
# ETAP 3: Wizualizacja końcowa (Połączenie PCA i Klastrów)
# ---------------------------------------------------------
fviz_cluster(final_kmeans, data = Dane_scaled,
palette = c("#2E9FDF", "#E7B800", "#FC4E07"),
ggtheme = theme_minimal(),
main = "Klastrowanie krajów (K-Means + PCA)",
xlab = "Wymiar 1 (GDP)",
ylab = "Wymiar 2 (Social_Support)")
# =========================================================
# CZĘŚĆ C: Redukcja wymiarów metodą MDS
# =========================================================
# MDS to alternatywa dla PCA. Obliczamy macierz odległości między krajami.
dist_matrix <- dist(Dane_scaled)
# Obliczamy współrzędne MDS (skalowanie do 2 wymiarów)
mds_coords <- cmdscale(dist_matrix, k = 2)
colnames(mds_coords) <- c("Dim1", "Dim2")
# Tworzymy ramkę danych do wykresu, dodając wyniki klastrowania z PAM
mds_df <- as.data.frame(mds_coords)
mds_df$Cluster <- as.factor(pam_result$clustering) # Kolorujemy wg klastrów PAM
mds_df$Country <- rownames(mds_df)
# Wykres MDS
ggplot(mds_df, aes(x = Dim1, y = Dim2, color = Cluster, label = Country)) +
geom_point(size = 3, alpha = 0.8) +
geom_text(vjust = 1.5, size = 3, check_overlap = TRUE) + # Podpisy krajów
theme_minimal() +
scale_color_manual(values = c("#2E9FDF", "#E7B800", "#FC4E07")) +
labs(title = "Wizualizacja MDS (Multidimensional Scaling)",
subtitle = "Kolory odpowiadają klastrom wyznaczonym przez PAM",
x = "Wymiar MDS 1",
y = "Wymiar MDS 2")
# =========================================================
# Porównanie jakości (Silhouette Plot)
# =========================================================
# Sprawdźmy, jak dobrze siedzą punkty w klastrach PAM
fviz_silhouette(pam_result, palette = "jco", ggtheme = theme_classic()) +
labs(title = "Rysunek 7. Wykres Sylwetkowy (Silhouette Plot)",
subtitle = "Ocena spójności klastrów (im bliżej 1, tym lepiej)",
caption = "Szerokość sylwetki wskazuje siłę przynależności do grupy")## cluster size ave.sil.width
## 1 1 44 0.28
## 2 2 77 0.25
## 3 3 23 0.49
Rysunek 3: Metoda Łokcia (Elbow Method) Wykres przedstawia spadek
wariancji wewnątrzklastrowej wraz ze wzrostem liczby grup. Wyraźne
załamanie krzywej przy wartości 3 sugeruje, że podział świata na trzy
główne typy państw jest statystycznie najbardziej uzasadniony dla tego
zbioru danych.
Rysunek 4: Wizualizacja Klastrów (K-Means / PAM) przedstawia podział krajów na mapie 2D. Kolory reprezentują odrębne grupy państw. Wyraźna separacja kolorów potwierdza, że czynniki takie jak wolność czy brak korupcji skutecznie różnicują narody. Klaster niebieski: Grupuje kraje o najwyższych wskaźnikach PKB, wsparcia społecznego i wolności (państwa wysokorozwinięte). Klaster czerwony: Państwa o średnim poziomie dobrostanu, stanowiące grupę przejściową. Klaster żółty: Kraje o najniższych parametrach Explained.by (rozwojowe), gdzie poziom szczęścia jest silnie ograniczony przez czynniki ekonomiczne i zdrowotne.
Rysunek 7: Wykres Sylwetkowy (Silhouette Plot) Mierzy, jak blisko każdego punktu znajdują się sąsiednie klastry. Im szerszy i wyższy słupek (bliżej wartości 1.0), tym lepiej dany kraj “pasuje” do swojej grupy i tym dalej znajduje się od klastrów sąsiednich.
Podsumowanie Projektu
Niniejszy projekt miał na celu analizę struktury szczęścia państw na świecie w 2024 roku przy użyciu metod uczenia nienadzorowanego. Wykorzystując dane z World Happiness Report, przeprowadzono proces klastrowania, który pozwolił na pogrupowanie krajów o zbliżonych profilach społeczno-ekonomicznych.W toku analizy zredukowano wymiarowość danych za pomocą metody PCA (analiza składowych głównych) oraz MDS, co umożliwiło wizualizację wielowymiarowych zależności na płaszczyźnie. Do wyznaczenia grup wykorzystano algorytmy K-means, PAM oraz CLARA, przyjmując optymalną liczbę klastrów \(k=3\) na podstawie metody łokcia. ## Wnioski Końcowe: 1. Trójpodział świata: Analiza statystyczna wyraźnie wskazuje na istnienie trzech grup państw: “wysokiego dobrostanu” (wysokie PKB i wolność), “średnio rozwiniętych” oraz “rozwijających się”, gdzie wsparcie społeczne i zdrowie są na znacznie niższym poziomie.
Kluczowe determinanty: PKB per capita oraz wsparcie społeczne pozostają najsilniejszymi czynnikami różnicującymi kraje w kontekście szczęścia.
Zbieżność metod: Wyniki klastrowania metodami K-means oraz PAM okazały się spójne, co zwiększa wiarygodność otrzymanego podziału.
Zastosowanie praktyczne: Wykorzystany model może służyć organizacjom międzynarodowym do identyfikacji państw wymagających wsparcia w konkretnych obszarach (np. walka z korupcją lub poprawa systemu ochrony zdrowia), które odstają od reszty swojej grupy.
**AI użyte do pomocy z kodowaniem i redakcją tekstu