Εκπαίδευση βάσης δεδομένων για την ανίχνευση της φύσης ενός όγκου, σε περίπτωση που είναι καλοηθής (benign) ή κακοηθής (malignant).

Σύγκριση μοντέλων Random Forest (RF) και XGBoost.

Εισαγωγή απαραίτητων στοιχείων.

# ============================================================
#  LAB 010 — Random Forests & Gradient Boosting
#  Dataset: Breast Cancer (Wisconsin)
#  Στόχος: Πρόβλεψη κακοήθειας από κυτταρολογικά χαρακτηριστικά
# ============================================================

# --- Φόρτωση πακέτων ---
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.2     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.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 errors
library(mlbench)
## Warning: package 'mlbench' was built under R version 4.5.3
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:dplyr':
## 
##     combine
## 
## The following object is masked from 'package:ggplot2':
## 
##     margin
library(xgboost)
## Warning: package 'xgboost' was built under R version 4.5.3
library(caret)
## Warning: package 'caret' was built under R version 4.5.3
## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following object is masked from 'package:purrr':
## 
##     lift
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, var
set.seed(42)

# --- Φόρτωση δεδομένων ---
data("BreastCancer", package = "mlbench")
bc <- BreastCancer
# Καθαρισμός: αφαίρεση ID, χειρισμός missing, μετατροπή σε numeric
bc$Id <- NULL
bc <- na.omit(bc)
bc[, 1:9] <- lapply(bc[, 1:9], function(x) as.numeric(as.character(x)))

str(bc)
## 'data.frame':    683 obs. of  10 variables:
##  $ Cl.thickness   : num  5 5 3 6 4 8 1 2 2 4 ...
##  $ Cell.size      : num  1 4 1 8 1 10 1 1 1 2 ...
##  $ Cell.shape     : num  1 4 1 8 1 10 1 2 1 1 ...
##  $ Marg.adhesion  : num  1 5 1 1 3 8 1 1 1 1 ...
##  $ Epith.c.size   : num  2 7 2 3 2 7 2 2 2 2 ...
##  $ Bare.nuclei    : num  1 10 2 4 1 10 10 1 1 1 ...
##  $ Bl.cromatin    : num  3 3 3 3 3 9 3 3 1 2 ...
##  $ Normal.nucleoli: num  1 2 1 7 1 7 1 1 1 1 ...
##  $ Mitoses        : num  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 ...
##  - attr(*, "na.action")= 'omit' Named int [1:16] 24 41 140 146 159 165 236 250 276 293 ...
##   ..- attr(*, "names")= chr [1:16] "24" "41" "140" "146" ...
table(bc$Class)
## 
##    benign malignant 
##       444       239

Dataset: BreastCancer

Brief topic explanation:
Είστε data scientists σε ένα ογκολογικό κέντρο. Οι παθολόγοι σας έχουν συλλέξει κυτταρολογικά χαρακτηριστικά από 699 βιοψίες.
Η δουλειά είναι να χτίσετε ένα μοντέλο που να προβλέπει αν ένας όγκος είναι καλοήθης (benign) ή κακοήθης (malignant).
Το μοντέλο είναι ένα decision support tool για τους γιατρούς.
#ola ta view etc...
head(bc)
##   Cl.thickness Cell.size Cell.shape Marg.adhesion Epith.c.size Bare.nuclei
## 1            5         1          1             1            2           1
## 2            5         4          4             5            7          10
## 3            3         1          1             1            2           2
## 4            6         8          8             1            3           4
## 5            4         1          1             3            2           1
## 6            8        10         10             8            7          10
##   Bl.cromatin Normal.nucleoli Mitoses     Class
## 1           3               1       1    benign
## 2           3               2       1    benign
## 3           3               1       1    benign
## 4           3               7       1    benign
## 5           3               1       1    benign
## 6           9               7       1 malignant
View(BreastCancer)

============================================================

ΜΕΡΟΣ Α — BASELINE με Random Forest

============================================================

Βήμα 1: Χωρισμός σε train / test μοντέλα.

set.seed(42)
train_rf <- createDataPartition(bc$Class, p = 0.7, list = FALSE)

train <- bc[train_rf, ]
test  <- bc[-train_rf, ]

prop.table(table(train$Class)) %>% round(3)
## 
##    benign malignant 
##     0.649     0.351
prop.table(table(test$Class))  %>% round(3)
## 
##    benign malignant 
##     0.652     0.348

Βήμα 2: Μοντέλο Random Forest (ntree = 500 & importance = TRUE)

set.seed(42)
rf_model <- randomForest(
  Class ~ .,            # Όλα τα features
  data = train,
  ntree = 500,             # Αριθμός δέντρων
  importance = TRUE        # Για να πάρουμε variable importance
)

print(rf_model)
## 
## Call:
##  randomForest(formula = Class ~ ., data = train, 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.76%
## Confusion matrix:
##           benign malignant class.error
## benign       301        10  0.03215434
## malignant      8       160  0.04761905

Από το confusion matrix μπορούμε να παρατηρήσουμε ότι:

  • 301 benign όγκοι ταξινομήθηκαν σωστά ως benign.

  • 10 benign περιπτώσεις ταξινομήθηκαν λάθος ως malignant.

  • 160 malignant περιπτώσεις ταξινομήθηκαν σωστά.

  • 8 malignant περιπτώσεις ταξινομήθηκαν λανθασμένα ως benign

Επίσης, έχουμε περίπου 3.2% λάθος στους καλοηθείς όγκους και περίπου 4.8% λάθος στους κακοηθείς. Το μοντέλο κάνει ελάχιστα λάθη, έχει πολύ υψηλή ακρίβεια και αναγνωρίζει σωστά σχεδόν όλες τις περιπτώσεις με σοβαρότερα λάθη τα 8 false negative.

Βήμα 3: Υπολογισμός Accuracy, Sensitivity, AUC.

rf_pred  <- predict(rf_model, test)
rf_prob  <- predict(rf_model, test, type = "prob")[, "malignant"]

# Confusion Matrix
rf_cm <- confusionMatrix(rf_pred, test$Class, positive = "malignant")
print(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       
## 
# AUC
rf_auc <- roc(test$Class, rf_prob, levels = c("benign", "malignant"))$auc
## Setting direction: controls < cases
cat("RF AUC:", round(rf_auc, 3), "\n")
## RF AUC: 0.999

To μοντέλο έχει ακρίβεια = 98%, ευαισθησία = 97% και AUC = 99%. Πρακτικά πολύ κοντά σε ένα τέλειο μοντέλο, το οποίο όμως είναι αναμενόμενο για εξετάσεις προβλημάτων υγείας.

Βήμα 4: Variable Importance Plot.

plot(rf_model, main = "OOB Error vs Number of Trees")
legend("topright", colnames(rf_model$err.rate), col = 1:3, lty = 1:3)

varImpPlot(rf_model, main = "Variable Importance — Random Forest")

importance(rf_model)
##                    benign malignant MeanDecreaseAccuracy MeanDecreaseGini
## Cl.thickness    12.702656 19.830096            19.363837        11.845927
## Cell.size       11.605774 16.330563            19.826188        60.344346
## Cell.shape      10.417048 20.502944            21.800283        53.561147
## Marg.adhesion    6.228395 12.425305            13.009741         5.977215
## Epith.c.size    10.510480  3.579421            11.128863        11.709247
## Bare.nuclei     20.271034 19.036320            26.035566        34.154820
## Bl.cromatin      6.086543 14.621620            14.691182        14.587449
## Normal.nucleoli 11.849778 11.676750            15.229482        23.815034
## Mitoses          4.984157  0.839361             4.608274         1.550928

Σύμφωνα με τα αποτελέσματα του πίνακα, οι 3 σημαντικότερες κατηγορίες, βασισμένες στο

MeanDecreaseAccuracy & MeanDecreaseGini

είναι οι

Bare.nuclei 26.04
Cell.shape 21.80
Cell.size 19.83

Επεξήγηση: Η μορφή των “γυμνών πυρήνων” (bare.nuclei) βοηθά περισσότερο στον διαχωρισμό καλοηθών και κακοηθών καταστάσεων. Το σχήμα /παραμόρφωση των κυττάρων (cell.shape) αποτελεί ισχυρό δείκτη κακοήθειας. Το μέγεθος (cell.size) είναι επίσης πολύ σημαντικός παράγοντας εντοπισμού κακοηθή όγκου.

============================================================

ΜΕΡΟΣ Β — BOOSTING & TUNING

============================================================

Βήμα 5: Έλεγχος καταλληλότητας δεδομένων για μοντέλο XGBoost.

# Μετατροπή σε numeric matrix
train_x <- data.matrix(train[, -10]) # χωρίς τη στήλη class giati den einai numeric
train_y <- ifelse(train$Class == "malignant", 1, 0)

test_x  <- data.matrix(test[, -10])
test_y  <- ifelse(test$Class == "malignant", 1, 0)

Βήμα 6: Δημιουργία XGBoost μοντέλου με early stopping.

#xgbm
# Δημιουργία xgb.DMatrix (το optimized format του XGBoost)
dtrain <- xgb.DMatrix(data = train_x, label = train_y)
dtest  <- xgb.DMatrix(data = test_x,  label = test_y)

set.seed(42)
params <- list(
  objective   = "binary:logistic",
  eval_metric = "auc",
  max_depth   = 4,
  eta         = 0.1,        # learning rate
  subsample   = 0.8,
  colsample_bytree = 0.8
)

xgb_model <- xgb.train(
  params              = params,
  data                = dtrain,
  nrounds             = 500,
  watchlist           = list(train = dtrain, test = dtest),
  early_stopping_rounds = 20,
  print_every_n       = 25,
  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 test_auc for early stopping.
## Will train until test_auc hasn't improved in 20 rounds.
## 
## [1]  train-auc:0.977109  test-auc:0.967489 
## [26] train-auc:0.997722  test-auc:0.995446 
## [51] train-auc:0.999541  test-auc:0.997458 
## [76] train-auc:0.999847  test-auc:0.997564 
## Stopping. Best iteration:
## [95] train-auc:0.999923  test-auc:0.997458
## 
## [95] train-auc:0.999923  test-auc:0.997458

To μοντέλο με early stopping μας έβγαλε μέγιστο αποτέλεσμα περίπου κοντά στο 99.99%.

Stopping. Best iteration: [95]  train-auc:0.999923  test-auc:0.997458  [95] train-auc:0.999923  test-auc:0.997458

Βήμα 7: Σύγκριση μοντέλων Random Forest & XGBoost (Accuracy, Sensitivity, Specificity, AUC).

xgb_prob <- predict(xgb_model, dtest)
xgb_pred <- factor(ifelse(xgb_prob > 0.5, "malignant", "benign"),
                   levels = c("benign", "malignant"))

xgb_cm  <- confusionMatrix(xgb_pred, test$Class, positive = "malignant")
print(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      
## 
xgb_auc <- roc(test$Class, xgb_prob, levels = c("benign", "malignant"))$auc
## Setting direction: controls < cases
cat("XGBoost AUC:", round(xgb_auc, 3), "\n")
## XGBoost AUC: 0.998
imp_xgb <- xgb.importance(model = xgb_model)
print(imp_xgb)
##            Feature       Gain      Cover  Frequency
##             <char>      <num>      <num>      <num>
## 1:      Cell.shape 0.41314930 0.17212968 0.10379242
## 2:       Cell.size 0.26421488 0.14343242 0.09580838
## 3:     Bare.nuclei 0.12418836 0.20984672 0.17964072
## 4:    Cl.thickness 0.04996820 0.10978109 0.13772455
## 5: Normal.nucleoli 0.04993893 0.11101276 0.13972056
## 6:     Bl.cromatin 0.04290336 0.10546435 0.08782435
## 7:   Marg.adhesion 0.03863542 0.09280645 0.16566866
## 8:    Epith.c.size 0.01144765 0.03618452 0.06986028
## 9:         Mitoses 0.00555390 0.01934201 0.01996008
xgb.plot.importance(imp_xgb, top_n = 8, 
                    main = "Feature Importance — XGBoost")

Σε αυτό το διάγραμμα βλέπουμε ότι το cell.shape είναι πολύ πιο σημαντικό από τις άλλες δύο μεταβλητές, που αν και ίδιες με αυτές που βρήκαμε πριν, τώρα έχουν αντιστραφεί οι δείκτες σημαντικότητας.

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"]
  ),
  F1 = c(
    rf_cm$byClass["F1"],
    xgb_cm$byClass["F1"]
  ),
  AUC = c(rf_auc, xgb_auc)
)
results <- results %>%
  mutate(across(where(is.numeric), ~ round(.x, 3)))

print(results)
##           Model Accuracy Sensitivity Specificity    F1   AUC
## 1 Random Forest    0.980       0.972       0.985 0.972 0.999
## 2       XGBoost    0.975       0.958       0.985 0.965 0.998

Αυτό το μοντέλο, το XGBoost, έχει ακρίβεια = 97%, ευαισθησία = 95% και AUC = 99%. Πάλι καλό αλλά όχι όσο το προηγούμενο.

Σε τελική ανάλυση, παρατηρούμε ότι το RF παρουσίασε καλύτερες μετρικές από το XGBoost που αν και πολυ μικρές σε διαφορά, είναι απαραίτητες σε ιατρικές καταστάσεις.

============================================================

Bonus

============================================================

Βήμα 8: Δοκιμή μοντέλου με eta = 0.01 & eta = 0.3.

set.seed(42)
params1 <- list(
  objective = "binary:logistic",
  eval_metric = "auc",
  max_depth = 4,
  eta = 0.01,
  subsample = 0.8,
  colsample_bytree = 0.8
)

xgb_model1 <- xgb.train(
  params = params1,
  data = dtrain,
  nrounds = 500,
  watchlist = list(train = dtrain, test = dtest),
  early_stopping_rounds = 20,
  verbose = 0
)
## 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.
set.seed(42)
params2 <- list(
  objective = "binary:logistic",
  eval_metric = "auc",
  max_depth = 4,
  eta = 0.3,
  subsample = 0.8,
  colsample_bytree = 0.8
)

xgb_model2 <- xgb.train(
  params = params2,
  data = dtrain,
  nrounds = 500,
  watchlist = list(train = dtrain, test = dtest),
  early_stopping_rounds = 20,
  verbose = 0
)
## 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.

Παρατηρήθηκε ότι η τιμή του eta επηρεάζει σημαντικά τον αριθμό boosting rounds που απαιτούνται για την εκπαίδευση του μοντέλου. Με μικρό learning rate (eta = 0.01), το μοντέλο μάθαινε πιο αργά και χρειάστηκε περισσότερους γύρους μέχρι να σταθεροποιηθεί η απόδοσή του. Αντίθετα, με μεγαλύτερο learning rate (eta = 0.3), η σύγκλιση πραγματοποιήθηκε γρηγορότερα και το training ολοκληρώθηκε σε λιγότερους γύρους.

Αυτό συμβαίνει επειδή το μεγαλύτερο eta επιτρέπει στο μοντέλο να κάνει μεγαλύτερες διορθώσεις σε κάθε boosting step.

Βήμα 9: Δημιουργία διαγράμματος ROC για σύγκριση μοντέλων Random Forest & XGBoost.

prob1 <- predict(xgb_model1, dtest)
prob2 <- predict(xgb_model2, dtest)

auc1 <- roc(test$Class, prob1,
            levels = c("benign", "malignant"))$auc
## Setting direction: controls < cases
auc2 <- roc(test$Class, prob2,
            levels = c("benign", "malignant"))$auc
## Setting direction: controls < cases
auc1
## Area under the curve: 0.9964
auc2
## Area under the curve: 0.9963

Το μοντέλο - παραλλαγή 1 με eta = 0.01 είναι καλύτερο από το 2 (eta = 0.3) κατά 0.0001 βαθμούς.

roc_rf  <- roc(test$Class, rf_prob,  levels = c("benign", "malignant"))
## Setting direction: controls < cases
roc_xgb <- roc(test$Class, xgb_prob, levels = c("benign", "malignant"))
## Setting direction: controls < cases
plot(roc_rf,  col = "purple", lwd = 2, main = "ROC Curves Comparison")
lines(roc_xgb, col = "yellow",   lwd = 2)
legend("bottomright",
       legend = c(paste0("RF (AUC = ",  round(rf_auc,  3), ")"),
                  paste0("XGB (AUC = ", round(xgb_auc, 3), ")")
                  ),
       col = c("purple", "yellow"),
       lwd = 2)

Το ROC curve εμφανίζεται σχεδόν κάθετο λόγω του ότι τα AUC και από τα δύο μοντέλα είναι σχεδόν τέλεια, κοντά στο 100%, με το AUC του RF να υπερισχύει κατά 0.001 βαθμούς. Οι ROC καμπύλες βρίσκονται πολύ κοντά στο άνω αριστερό άκρο του διαγράμματος, γεγονός που υποδηλώνει σχεδον τέλειο διαχωρισμό μεταξύ των δύο κατηγοριών του dataset.

Συμπεράσματα

Μέρος Α

  • Με Accuracy =
Accuracy : 0.9804
  • είχαμε top features τα bar.nuclei, cell.shape, cell.size με αυτή την σειρά ακριβώς.

  • Αν και Accuracy = 97% είναι πολύ καλό για ένα μοντέλο, όταν εξετάζουμε προβλήματα υγείας και ειδικά κακοηθείς περιπτώσεις όπως μπορεί να εξελιχθούν οι όγκοι, περιμένουμε ένα κάπως καλύτερο accuracy.

    Παρόλα αυτά, η ακρίβεια δεν είναι το μόνο που επηρεάζει την ανίχνευση των αποτελεσμάτων, οπότε δεν μπορούμε να στηριχτούμε μόνο σε αυτό.

Μέρος Β

  • Το καλύτερο μοντέλο ήταν το Random Forest με μικρή διαφορά RF area under the curve: 0.9964 & XGBoost area under the curve: 0.9963, κατά 0.0001 βαθμούς.

  • Ένα ενδιαφέρον στοιχείο των αποτελεσμάτων ήταν ότι το Random Forest παρουσίασε οριακά καλύτερη απόδοση από το XGBoost, παρόλο που το XGBoost θεωρείται συνήθως πιο ισχυρό και πιο εξελιγμένο ensemble μοντέλο. Η διαφορά ήταν μικρή, ωστόσο το Random Forest πέτυχε ελαφρώς υψηλότερο AUC και πολύ σταθερή συμπεριφορά. Αυτό πιθανόν οφείλεται στο γεγονός ότι το συγκεκριμένο dataset είναι σχετικά «καθαρό» και εύκολα διαχωρίσιμο, επομένως ακόμη και ένα λιγότερο πολύπλοκο ensemble μοντέλο μπορεί να αποδώσει εξαιρετικά χωρίς την ανάγκη πιο επιθετικού boosting.

  • Η αλλαγή του eta επηρέασε κυρίως την ταχύτητα εκπαίδευσης του XGBoost. Με μικρό eta (0.01), το μοντέλο μάθαινε πιο αργά και χρειάστηκε περισσότερους boosting rounds μέχρι να επιτευχθεί καλή απόδοση. Αντίθετα, με μεγαλύτερο eta (0.3), η σύγκλιση έγινε πολύ γρηγορότερα και το μοντέλο ολοκλήρωσε την εκπαίδευση σε λιγότερους γύρους. Ενώ το μεσαίο eta (0.1) είχε μία ισορροπία ανάμεσα στα δύο, συγκλίνοντας όμως στην συμπεριφορά του 3ου eta (0.3).

    Παρότι και οι τρεις τιμές παρήγαγαν υψηλό AUC, τα μεγαλύτερα eta εμφάνισαν τάση για πιο επιθετική μάθηση και πιθανό overfitting.

Fin