##librarys
library(ggplot2)
library(readr)
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cluster)
library(fpc)
library(dbscan)
##
## Attache Paket: 'dbscan'
## Das folgende Objekt ist maskiert 'package:fpc':
##
## dbscan
## Das folgende Objekt ist maskiert 'package:stats':
##
## as.dendrogram
library(Rtsne)
library(plotly)
##
## Attache Paket: 'plotly'
## Das folgende Objekt ist maskiert 'package:ggplot2':
##
## last_plot
## Das folgende Objekt ist maskiert 'package:stats':
##
## filter
## Das folgende Objekt ist maskiert 'package:graphics':
##
## layout
library(umap)
library(mclust)
## Package 'mclust' version 6.1.1
## Type 'citation("mclust")' for citing this R package in publications.
data <- read_csv("student_performance_large_dataset.csv")
## Rows: 10000 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): Student_ID, Gender, Preferred_Learning_Style, Participation_in_Disc...
## dbl (8): Age, Study_Hours_per_Week, Online_Courses_Completed, Assignment_Com...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
# Nur numerische Spalten behalten
data_num <- data[sapply(data, is.numeric)]
# Zielvariable "Exam_Score (%)" entfernen
data_num_no_examscore <- data_num[, !names(data_num) %in% "Exam_Score (%)"]
data_scaled <- scale(data_num_no_examscore)
set.seed(100)
# k-Means Clustering auf die Daten anwenden
k <- 2 # Anzahl Cluster – anpassbar
cl <- kmeans(data_scaled, centers = k)
# PCA, um die Daten auf 2 Dimensionen zu reduzieren
pca <- prcomp(data_scaled, scale. = TRUE)
pca_df <- as.data.frame(pca$x[, 1:2]) # Nur die ersten beiden Hauptkomponenten
# Cluster-Zuweisungen aus dem k-Means Clustering auf die PCA-Daten anwenden
pca_df$cluster <- cl$cluster
# Visualisierung der Clusterergebnisse auf den PCA-reduzierten Daten
# Cluster-Plot
plot(pca_df$PC1, pca_df$PC2, col = pca_df$cluster, pch = 19,
xlab = "Hauptkomponente 1", ylab = "Hauptkomponente 2",
main = "k-Means Cluster (PCA-reduziert)", las = 1)
# Clusterzentren hinzufügen
points(cl$centers[, 1], cl$centers[, 2], col = 1:k, pch = 8, cex = 5)
# Cluster-Zentren und Varianz anzeigen
cl$centers
## Age Study_Hours_per_Week Online_Courses_Completed
## 1 -0.004196615 -0.07504250 -0.8709715
## 2 0.004166508 0.07450413 0.8647230
## Assignment_Completion_Rate (%) Attendance_Rate (%)
## 1 -0.007432383 -0.002707759
## 2 0.007379061 0.002688333
## Time_Spent_on_Social_Media (hours/week) Sleep_Hours_per_Night
## 1 -0.0009041666 0.008958535
## 2 0.0008976800 -0.008894265
cl$withinss
## [1] 31184.72 31219.28
cl$tot.withinss
## [1] 62404
# Elbow-Methode (manuell)
wcv <- rep(0, 20)
for (i in 1:20)
wcv[i] <- sum(kmeans(data_scaled, centers = i)$withinss)
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
# Plot der Elbow-Methode
plot(1:20, wcv, type = "b", xlab = "Anzahl Cluster", ylab = "within-cluster Variation", las = 1,
main = "Elbow-Methode") # Plot nur für die ersten 20 Clusterzahlen
# Elbow-Methode mit factoextra
fviz_nbclust(data_scaled, kmeans, method = "wss", k.max = 10)
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
## Warning: keine Konvergenz nach 10 Schritten
# Silhouettenplot für k=2
cl2 <- kmeans(data_scaled, centers = 2)
sil_plot <- silhouette(cl2$cluster, dist(data_scaled))
plot(sil_plot, main = "Silhouettenplot (k=2)")
# Durchschnittliche Silhouettenbreite für k = 2 bis 10
sil <- rep(0, 10)
for (i in 2:10){
sil[i] <- summary(silhouette(
kmeans(data_num_no_examscore, centers = i)$cluster,
dist(data_num_no_examscore)))$avg.width
}
plot(2:10, sil[2:10], type = "b", las = 1,
xlab = "Anzahl Cluster",
ylab = "Mittlere Silhouetten-Breite",
main = "Optimale Clusteranzahl (Silhouette)")
# Silhouetten-Methode mit factoextra
fviz_nbclust(data_num_no_examscore, kmeans, method = "silhouette")
# PAM Clustering anwenden
cl_pam <- pam(data_scaled, k = 2) # Cluster auf den originalen skalierten Daten
# PCA auf den gesamten Datensatz anwenden (nur zur Visualisierung)
pca <- prcomp(data_scaled)
pca_df <- as.data.frame(pca$x[, 1:2]) # Reduziere auf die ersten beiden Hauptkomponenten
# Visualisierung der Cluster auf den PCA-reduzierten Daten
plot(pca_df$PC1, pca_df$PC2, col = cl_pam$clustering, pch = 19,
xlab = "Hauptkomponente 1", ylab = "Hauptkomponente 2",
main = "PAM-Cluster mit Medoiden (PCA-reduziert)", las = 1)
# Medoidpunkte (zentraler Punkt jedes Clusters)
points(pca_df$PC1[cl_pam$medoids], pca_df$PC2[cl_pam$medoids], col = 1:2, pch = 8, cex = 2) # Medoidpunkte
# Cluster-Zentren und Objektivwert von PAM
cl_pam$medoids # Medoidpunkte der Cluster
## Age Study_Hours_per_Week Online_Courses_Completed
## [1,] -0.1383021 -0.01002111 -0.1642407
## [2,] 0.4394009 -0.62528518 0.3246194
## Assignment_Completion_Rate (%) Attendance_Rate (%)
## [1,] 0.4823025 0.1298303
## [2,] -0.8123778 -0.4803701
## Time_Spent_on_Social_Media (hours/week) Sleep_Hours_per_Night
## [1,] 0.007037852 0.01036573
## [2,] -0.325459115 0.01036573
cl_pam$objective # Objektivwert des PAM-Algorithmus
## build swap
## 2.493201 2.493201
# Silhouetten-Methode: Visualisierung der mittleren Silhouetten-Breite
sil <- rep(0, 10) # Initialisierung
for (i in 2:10) {
sil[i] <- summary(silhouette(x = pam(data_scaled, k = i)$cluster, dist = dist(data_scaled)))$avg.width
}
plot(2:10, sil[2:10], type = "b", las = 1,
xlab = "Anzahl Cluster", ylab = "Mittlere Silhouetten-Breite",
main = "Optimale Clusteranzahl (Silhouette)")
# Silhouetten-Methode mit factoextra
fviz_nbclust(data_scaled, pam, method = "silhouette")
# PAM Clustering mit optimaler Clusteranzahl aus pamk
cl_pamk <- pamk(data_scaled, krange = 2:5)
# Visualisierung der Cluster-Labels und Medoiden für das beste k (z.B. k = 3)
best_k <- cl_pamk$nc # Die optimale Clusteranzahl, die von pamk bestimmt wurde
cl_best_k <- pam(data_scaled, k = best_k)
# Visualisierung der Cluster mit fviz_cluster
fviz_cluster(cl_best_k, data = data_scaled, geom = "point",
main = paste("PAM-Cluster mit k =", best_k)) + theme_minimal()
df <- data
# Nur numerische Variablen verwenden
df_num <- data_num
# Standardisieren (Z-Transformation): wichtig für Abstandsbasierte Algorithmen wie DBSCAN
df_scaled <- data_scaled
# kNN-Distanzplot: zeigt den Abstand zum k-nächsten Nachbarn (hier: k = 5)
# Ziel: Ellbogenpunkt identifizieren → sinnvoller eps-Wert
kNNdistplot(df_scaled, k = 5) #berechnung)
abline(h = 0.8, col = "red") # Ellbogenpunkt manuell wählen
# eps = Radius um jeden Punkt → wie „nah“ müssen Punkte beieinander liegen
# minPts = Mindestanzahl Punkte innerhalb dieses Radius, damit ein „Core Point“ entsteht
# Ziel: Dichte-Regionen erkennen und Rauschen filtern
db <- dbscan(df_scaled, eps = 0.8, minPts = 5)
db
## DBSCAN clustering for 10000 objects.
## Parameters: eps = 0.8, minPts = 5
## Using euclidean distances and borderpoints = TRUE
## The clustering contains 180 cluster(s) and 8823 noise points.
##
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 8823 5 6 5 9 5 12 9 6 17 6 9 8 8 5 12
## 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
## 10 5 8 15 11 18 13 8 6 5 5 5 10 9 5 12
## 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
## 5 10 9 7 5 5 16 5 17 16 6 5 5 12 9 9
## 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
## 5 5 13 8 12 5 8 5 5 8 8 9 6 5 12 9
## 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
## 16 5 8 6 5 8 5 5 5 5 5 5 4 5 5 5
## 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
## 8 6 7 6 5 5 5 7 5 6 5 8 5 6 5 6
## 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
## 7 5 6 5 5 5 6 6 8 7 5 5 5 5 5 5
## 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
## 6 7 5 5 5 4 5 5 5 4 5 5 11 5 5 5
## 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
## 5 7 6 5 4 5 5 5 4 7 4 6 5 4 6 5
## 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
## 5 4 5 9 4 5 6 7 5 5 5 5 5 5 5 5
## 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
## 4 5 6 5 6 5 9 6 5 5 6 5 4 5 5 5
## 176 177 178 179 180
## 4 5 4 5 5
##
## Available fields: cluster, eps, minPts, metric, borderPoints
# Output: Übersicht Clustergrössen (je grösser eps, desto weniger cluster)
# Ergebnis bei eps = 0.8, minPts = 5: 3 Cluster (1–3), 9985 Rauschpunkte (= nicht zugeordnet → Cluster 0)
pca <- prcomp(df_scaled)
par(mfrow = c(1, 2), mar = c(3, 3, 2, 1), mgp = c(2, 0.5, 0))
# Links: Punkte eingefärbt nach Final_Grade (A–F)
plot(pca$x[, 1:2], col = as.factor(df$Final_Grade), las = 1,
main = "PCA gefärbt nach Final_Grade")
# Rechts: Punkte eingefärbt nach DBSCAN Cluster (0 = schwarz = Rauschen)
plot(pca$x[, 1:2], col = db$cluster + 1, las = 1,
main = "DBSCAN Cluster (PCA-Projektion)")
# Hierarchisches Clustering mit verschiedenen Linkage-Methoden
d <- dist(df_scaled)
hc_complete <- hclust(d, method = "complete") # vollständige Verbindung
hc_average <- hclust(d, method = "average") # Durchschnittsverbindung
hc_single <- hclust(d, method = "single") # Einzelverbindung
clusters_hc <- cutree(hc_complete, k = 3) # Anzahl Cluster auf z.B. 3 setzen
table(clusters_hc)
## clusters_hc
## 1 2 3
## 2207 4287 3506
# PCA für Visualisierung
pca <- prcomp(df_scaled)
par(mfrow = c(1,1))
farben_transparent <- adjustcolor(clusters_hc, alpha.f = 0.8)
# PCA-Plot mit transparenter Färbung
plot(pca$x[, 1:2], col = farben_transparent, pch = 16,
main = "Hierarchisches Clustering (PCA-Projektion)",
xlab = "PC1", ylab = "PC2")
#_______________________________________________________________________________
# Ohne Dimensionsreduktion
#Daten skalieren
data_scaled <- scale(data_num)
# Beste Anzah Cluster-Visualisierung
res.mc<-Mclust(data_scaled,verbose=FALSE) # Dauert ca. 2 - 3 min.
plot(res.mc,what="BIC")
# Beste Anzah Cluster-Visualisierung alternativ
fviz_mclust(res.mc, "BIC", palette = "jco")
## Warning: `gather_()` was deprecated in tidyr 1.2.0.
## ℹ Please use `gather()` instead.
## ℹ 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.
# Clustering
fviz_mclust(res.mc,"classification",geom="point", palette="jco",xlab="x1",ylab="x2")
# Unsicherheit im Clustering noch darstellen
fviz_mclust(res.mc, "uncertainty", palette = "jco", xlab = "x1", ylab = "x2")
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ 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.