Εβδομαδιαία Εργασία 09
Agapi Serasidou
2026-05-10
ΣΤΟΧΟΣ
Έχουμε δεδομένα από βιοψίες και θέλουμε να προβλέψουμε: α) Benign: Καλοήθης όγκος, β) Malignant: Κακοήθης όγκος.
ΦΟΡΤΩΣΗ ΒΙΒΛΙΟΘΗΚΩΝ
- tidyverse
- mlbench
- randomForest
- xgboost
- caret
- pROC
set.seed(42) #Εξασφαλίζω ότι δεν υπάρχει randomness στα splits.
# --- Φόρτωση δεδομένων ---
data("BreastCancer", package = "mlbench")
bc <- BreastCancer
str(bc)## 'data.frame': 699 obs. of 11 variables:
## $ Id : chr "1000025" "1002945" "1015425" "1016277" ...
## $ Cl.thickness : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 5 5 3 6 4 8 1 2 2 4 ...
## $ Cell.size : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 1 4 1 8 1 10 1 1 1 2 ...
## $ Cell.shape : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 1 4 1 8 1 10 1 2 1 1 ...
## $ Marg.adhesion : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 1 5 1 1 3 8 1 1 1 1 ...
## $ Epith.c.size : Ord.factor w/ 10 levels "1"<"2"<"3"<"4"<..: 2 7 2 3 2 7 2 2 2 2 ...
## $ Bare.nuclei : Factor w/ 10 levels "1","2","3","4",..: 1 10 2 4 1 10 10 1 1 1 ...
## $ Bl.cromatin : Factor w/ 10 levels "1","2","3","4",..: 3 3 3 3 3 9 3 3 1 2 ...
## $ Normal.nucleoli: Factor w/ 10 levels "1","2","3","4",..: 1 2 1 7 1 7 1 1 1 1 ...
## $ Mitoses : Factor w/ 9 levels "1","2","3","4",..: 1 1 1 1 1 1 1 1 5 1 ...
## $ Class : Factor w/ 2 levels "benign","malignant": 1 1 1 1 1 2 1 1 1 1 ...Από το συγκεκριμένο προκύπτει ότι: Υπάρχουν 699 rows και 11 columns .
#Φόρτωση βιβλιοθήκης
library(knitr)## Warning: package 'knitr' was built under R version 4.5.3library(dplyr) # Απαραίτητο για το σύμβολο %>%##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union#Δημιουργία Πίνακα Μεταβλητών
data_info <- data.frame(
Μεταβλητές = c("Id", "Cl.thickness", "Cell.size", "Cell.shape", "Marg.adhesion", "Epith.c.size", "Bare.nuclei", "Bl.cromatin", "Normal.nucleoli", "Mitoses", "Class")
)
kable(data_info) | Μεταβλητές |
|---|
| Id |
| Cl.thickness |
| Cell.size |
| Cell.shape |
| Marg.adhesion |
| Epith.c.size |
| Bare.nuclei |
| Bl.cromatin |
| Normal.nucleoli |
| Mitoses |
| Class |
table(bc$Class)##
## benign malignant
## 458 241# --- Δημιουργία Πίνακα Μεταβλητών ---
class_info <- data.frame(
Μεταβλητές = c("Benign", "Malignant"),
Πλήθος = c ("458", "241")
)
kable(class_info);| Μεταβλητές | Πλήθος |
|---|---|
| Benign | 458 |
| Malignant | 241 |
# Καθαρισμός: αφαίρεση ID, χειρισμός missing, μετατροπή σε numeric
bc$Id <- NULL
bc <- na.omit(bc)
bc[, 1:9] <- lapply(bc[, 1:9], function(x) as.numeric(as.character(x)))# ============================================================
# ΜΕΡΟΣ Α — BASELINE με Random Forest
# ============================================================
# --- Διαχωρισμός dataset σε train/test ---
library(caret)## Warning: package 'caret' was built under R version 4.5.3## Loading required package: ggplot2## Loading required package: latticelibrary(ggplot2)
library(lattice)
train_index <- createDataPartition(
bc$Class,
p = 0.7,
list = FALSE
)
train_data <- bc[train_index, ]
test_data <- bc[-train_index, ]
# --- Εμφάνιση Γραμμών/ Στηλών Train Dataset ---
dim(train_data)## [1] 479 10# --- Εμφάνιση Γραμμών/ Στηλών Test Dataset ---
dim(test_data)## [1] 204 10# --- Εκπαίδευση Random Forest ---
library(randomForest)## Warning: package 'randomForest' was built under R version 4.5.3## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## margin## The following object is masked from 'package:dplyr':
##
## combinerf_model <- randomForest(
Class ~ .,
data = train_data, #Χρησιμοποιώ μόνο το train_data set
ntree = 500, #Θα φτιαχτούν 500 decision trees
importance = TRUE
)
rf_model##
## Call:
## randomForest(formula = Class ~ ., data = train_data, ntree = 500, importance = TRUE)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 3
##
## OOB estimate of error rate: 3.34%
## Confusion matrix:
## benign malignant class.error
## benign 301 10 0.03215434
## malignant 6 162 0.03571429Από την εκτέλεση των συγκεκριμένων εντολών προκύπτει το εξής: OOB estimate of error rate: 3.34%. Αυτό σημαίνει ότι το μοντέλο έκανε λάθος πρόβλεψη μόνο στο 3.34% των περιπτώσεων που δεν έιχε ξαναδεί κατά την εκπαίδευση.
# --- Accuracy, Sensitivity, AUC ---
#Προβλέψεις:
rf_pred <- predict(
rf_model,
test_data
)#Πίνακας συσχέτισης:
rf_cm <- confusionMatrix(
rf_pred,
test_data$Class,
positive = "malignant"
)
rf_cm #Εκτύπωση πίνακα## Confusion Matrix and Statistics
##
## Reference
## Prediction benign malignant
## benign 131 2
## malignant 2 69
##
## Accuracy : 0.9804
## 95% CI : (0.9506, 0.9946)
## No Information Rate : 0.652
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.9568
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.9718
## Specificity : 0.9850
## Pos Pred Value : 0.9718
## Neg Pred Value : 0.9850
## Prevalence : 0.3480
## Detection Rate : 0.3382
## Detection Prevalence : 0.3480
## Balanced Accuracy : 0.9784
##
## 'Positive' Class : malignant
## Πίνακας Συσχέτισης: Με την εντολή αυτή, δημιουργούμε τον πίνακα συσχέτισης για να ξιολογήσουμε την απόδοση του μοντέλου. Συγκρίνουμε τις προβλέψεις (rf_pred) με τις πραγματικές τιμές των δεδομένων (test_data$Class), ορίζοντας ως Positive την κλάση “Malignant”, ώστε να υπυολογίσουμς κρίσιμους δείκτες όπως η ακρίβεια και η ευαισθησία.
#Probability predictions:
rf_prob <- predict(
rf_model,
test_data,
type = "prob" #Εξαγωγή ποσοστών
)[,"malignant"] #Επιλογή κακοήθειας#ROC Curve:
library(pROC)## Warning: package 'pROC' was built under R version 4.5.3## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varrf_roc <- roc(
response = test_data$Class,
predictor = rf_prob,
levels = c("benign", "malignant")
)## Setting direction: controls < casesauc(rf_roc)## Area under the curve: 0.9982Η τιμή AUC(0.9982) δείχνει ότι το μοντέο έχει εξαιρετική ικανότητα διαχωρισμού μεταξύ των καλοηθών και κακπηθών δειγμάτων. Καθώς η τιμή πλησιάζει το1, επιβεβαιώνεται ότι οι προβέλεψεις μας είναι σχεδόν τέλειες, με ελάχιστη πιθανότητα λάθους.
#Variable Importance
varImpPlot(rf_model)
Το γράφημα Variable Importance αναδεικνύει τις σημαντικότερες
παραμέτρους για τη διάγνωση. Οι μεταβλητές Bare.nuclei, Cell.shape και
Cell.size εμφανίζουν τη μεγαλύτερη συνεισφορά στην ακρίβεια του
μοντέλου, υποδεικνύοντας ότι αποτελούν τους κύριους προγνωστικούς
παράγοντες για την κακοήθεια.
# ============================================================
# ΜΕΡΟΣ Β — BOOSTING & TUNING
# ============================================================
#Προετοιμασία δεδομένων
x_train <- as.matrix(train_data[,1:9]) #Παίρνουμε μόνο τις πρώτες 9 στήλες, όχι όλη την κλάση
x_test <- as.matrix(test_data[,1:9])
y_train <- ifelse(train_data$Class == "malignant", 1, 0) #Μετατροπή "malignant" σε 1
y_test <- ifelse(test_data$Class == "malignant", 1, 0) #Μετατροπή "benign" σε 0
#Μετατροπή δεδομένων στη μορφή που απαιτεί το XGBoost
library(xgboost)## Warning: package 'xgboost' was built under R version 4.5.3dtrain <- xgb.DMatrix(data = x_train, label = y_train)
dtest <- xgb.DMatrix(data = x_test, label = y_test)
#Εκπαίδευση XGBoost
xgb_model <- xgb.train(
params = list(
objective = "binary:logistic", #Δυαδική ταξινόμηση
eval_metric = "auc", #Μέτρηση απόδοσης
max_depth = 4, #Βάθος δέντρων
eta = 0.1
),
data = dtrain,
nrounds = 500, #μέγιστες επαναλήψεις
watchlist = list(
train = dtrain,
eval = dtest
),
early_stopping_rounds = 20, #Διακοπή υπερεκπαίδευσης
verbose = 1
)## Warning in throw_err_or_depr_msg("Parameter '", match_old, "' has been renamed
## to '", : Parameter 'watchlist' has been renamed to 'evals'. This warning will
## become an error in a future version.## Multiple eval metrics are present. Will use eval_auc for early stopping.
## Will train until eval_auc hasn't improved in 20 rounds.
##
## [1] train-auc:0.989148 eval-auc:0.987557
## [2] train-auc:0.989311 eval-auc:0.988245
## [3] train-auc:0.991923 eval-auc:0.988775
## [4] train-auc:0.992708 eval-auc:0.988192
## [5] train-auc:0.993560 eval-auc:0.993805
## [6] train-auc:0.994363 eval-auc:0.994652
## [7] train-auc:0.994670 eval-auc:0.994546
## [8] train-auc:0.995502 eval-auc:0.994440
## [9] train-auc:0.995340 eval-auc:0.994599
## [10] train-auc:0.995588 eval-auc:0.994599
## [11] train-auc:0.995856 eval-auc:0.994599
## [12] train-auc:0.995933 eval-auc:0.994599
## [13] train-auc:0.996172 eval-auc:0.994387
## [14] train-auc:0.996507 eval-auc:0.994281
## [15] train-auc:0.996785 eval-auc:0.994387
## [16] train-auc:0.996928 eval-auc:0.995235
## [17] train-auc:0.997139 eval-auc:0.994917
## [18] train-auc:0.997407 eval-auc:0.995764
## [19] train-auc:0.997713 eval-auc:0.995976
## [20] train-auc:0.997809 eval-auc:0.996399
## [21] train-auc:0.998096 eval-auc:0.996505
## [22] train-auc:0.998373 eval-auc:0.996294
## [23] train-auc:0.998507 eval-auc:0.996399
## [24] train-auc:0.998832 eval-auc:0.996294
## [25] train-auc:0.998890 eval-auc:0.996611
## [26] train-auc:0.998871 eval-auc:0.996611
## [27] train-auc:0.998852 eval-auc:0.996505
## [28] train-auc:0.998947 eval-auc:0.996399
## [29] train-auc:0.999024 eval-auc:0.996399
## [30] train-auc:0.999120 eval-auc:0.996399
## [31] train-auc:0.999177 eval-auc:0.996294
## [32] train-auc:0.999177 eval-auc:0.996399
## [33] train-auc:0.999215 eval-auc:0.996188
## [34] train-auc:0.999311 eval-auc:0.996082
## [35] train-auc:0.999407 eval-auc:0.996399
## [36] train-auc:0.999388 eval-auc:0.996082
## [37] train-auc:0.999426 eval-auc:0.996188
## [38] train-auc:0.999502 eval-auc:0.996294
## [39] train-auc:0.999522 eval-auc:0.996399
## [40] train-auc:0.999522 eval-auc:0.996294
## [41] train-auc:0.999541 eval-auc:0.996399
## [42] train-auc:0.999598 eval-auc:0.996611
## [43] train-auc:0.999636 eval-auc:0.996611
## [44] train-auc:0.999675 eval-auc:0.996611
## Stopping. Best iteration:
## [45] train-auc:0.999675 eval-auc:0.996611
##
## [45] train-auc:0.999675 eval-auc:0.996611#Προβλέψεις
xgb_prob <- predict(xgb_model, dtest)
#Μετατροπή σε classes
xgb_pred <- ifelse(xgb_prob > 0.5, "malignant", "benign")
xgb_pred <- factor(xgb_pred, levels = c("benign", "malignant"))
library(caret)
xgb_cm <- confusionMatrix(
xgb_pred,
test_data$Class,
positive = "malignant"
)
xgb_cm## Confusion Matrix and Statistics
##
## Reference
## Prediction benign malignant
## benign 131 3
## malignant 2 68
##
## Accuracy : 0.9755
## 95% CI : (0.9437, 0.992)
## No Information Rate : 0.652
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.9458
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.9577
## Specificity : 0.9850
## Pos Pred Value : 0.9714
## Neg Pred Value : 0.9776
## Prevalence : 0.3480
## Detection Rate : 0.3333
## Detection Prevalence : 0.3431
## Balanced Accuracy : 0.9714
##
## 'Positive' Class : malignant
## library(pROC)
xgb_roc <- roc(
response = test_data$Class,
predictor = xgb_prob,
levels = c("benign", "malignant")
)## Setting direction: controls < casesauc(xgb_roc)## Area under the curve: 0.9966Πιο συγκεκριμένα:
Το μοντέλο χτίζει έως και 500 δέντρα το ένα μετά το άλλο, προσπαθώντας σε κάθε βήμα να διορθώσει τα λάθη του προηγούμενου.
Καθώς εκπαιδεύεται, ελέγχει ταυτόχρονα και τα δεδομένα ελέγχου για να δει αν όντως βελτιώνεται η ακρίβειά του σε άγνωστα δεδομένα.
Αν για 20 συνεχόμενα βήματα η απόδοση σταματήσει να βελτιώνεται, το μοντέλο σταματάει αυτόματα για να γλιτώσει χρόνο και να αποφύγει το overfitting.
#Σύγκριση RF με XGBoost:
results <- data.frame(
Model = c("Random Forest", "XGBoost"),
Accuracy = c(
rf_cm$overall["Accuracy"],
xgb_cm$overall["Accuracy"]
),
Sensitivity = c(
rf_cm$byClass["Sensitivity"],
xgb_cm$byClass["Sensitivity"]
),
Specificity = c(
rf_cm$byClass["Specificity"],
xgb_cm$byClass["Specificity"]
),
AUC = c(
auc(rf_roc),
auc(xgb_roc)
)
)
results## Model Accuracy Sensitivity Specificity AUC
## 1 Random Forest 0.9803922 0.9718310 0.9849624 0.9981997
## 2 XGBoost 0.9754902 0.9577465 0.9849624 0.9966112Σύγκριση:
Accuracy:
- RF: 0.9804
- XGBoost: 0.9755
Το Random Forest είναι οριακά καλύτερο (0.9804 vs 0.9755), άρα κάνει συνολικά λιγότερα λάθη.
Sensitivity:
- RF: 0.9718
- XGBoost: 0.9577
ο Random Forest υπερέχει (0.9718 vs 0.9577), άρα εντοπίζει περισσότερους κακοήθεις όγκους και κάνει λιγότερα επικίνδυνα λάθη.
Specificity:
- RF : 0.9850
- XGBoost: 0.9850
Τα δύο μοντέλα είναι ίδια (0.9850), άρα αναγνωρίζουν εξίσου καλά τους καλοήθεις όγκους.
AUC:
- RF: 0.9982
- XGBoost: 0.9966
Το Random Forest έχει ελαφρώς μεγαλύτερο AUC (0.9982 vs 0.9966), άρα συνολικά διαχωρίζει καλύτερα τις δύο κλάσεις.