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

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
View(bc)

Καθαρισμός: αφαίρεση 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

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

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

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

Stratified train/test split (70/30)

train_idx <- createDataPartition(bc$Class, p = 0.7, list = FALSE)

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

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


Random Forest με ntree=500, importance=TRUE

rf_model <- randomForest(
  Class ~ Cl.thickness +
    Cell.size +
    Cell.shape +
    Marg.adhesion +
    Epith.c.size +
    Bare.nuclei +
    Bl.cromatin +
    Normal.nucleoli +
    Mitoses,

  data = train,
  ntree = 500,
  importance = TRUE
)
print(rf_model)
## 
## Call:
##  randomForest(formula = Class ~ Cl.thickness + Cell.size + Cell.shape +      Marg.adhesion + Epith.c.size + Bare.nuclei + Bl.cromatin +      Normal.nucleoli + Mitoses, 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.34%
## Confusion matrix:
##           benign malignant class.error
## benign       301        10  0.03215434
## malignant      6       162  0.03571429
  1. mtry = 3 Επειδή υπάρχουν 9 features, το randomForest επέλεξε default: 3 μεταβλητές ανά split.

  2. OOB error ≈ 3.76% Αυτό σημαίνει ότι το μοντέλο κάνει λάθος περίπου στο 3.76% των περιπτώσεων χωρίς να χρησιμοποιήσει το test set.

Άρα το εκτιμώμενο accuracy είναι περίπου: Accuracy ≈ 1 − 0.0376 = 0.9624, δηλαδή περίπου 96.24%, που θεωρείται εξαιρετική επίδοση.

  1. Class error ασύμμετρο:

Για την κατηγορία benign: Class Error benign = 0.0289 ≈ 2.9%, δηλαδή το μοντέλο αναγνωρίζει σωστά περίπου το 97.1% των καλοήθη περιπτώσεων.

Για την κατηγορία malignant: Class Error malignant = 0.0535 ≈ 5.35%, δηλαδή αναγνωρίζει σωστά περίπου το 94.65% των κακοήθων περιπτώσεων.

Το μοντέλο παρουσιάζει πολύ καλή ισορροπία μεταξύ των δύο κατηγοριών και δεν φαίνεται να έχει σοβαρό imbalance problem.

Παρότι κάνει λίγο περισσότερα λάθη στα κακοήθη περιστατικά, η απόδοση παραμένει εξαιρετικά υψηλή για ιατρικό classification πρόβλημα.


Accuracy, Sensitivity, AUC στο test set

# Predictions
rf_pred <- predict(rf_model, test)

# Probabilities για ROC
rf_prob <- predict(rf_model, test, type = "prob")[,2]

# Confusion Matrix
rf_cm <- confusionMatrix(
  rf_pred,
  test$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       
## 
# Accuracy
rf_accuracy <- rf_cm$overall["Accuracy"]

# Sensitivity
rf_sensitivity <- rf_cm$byClass["Sensitivity"]

# Specificity
rf_specificity <- rf_cm$byClass["Specificity"]

# ROC / AUC
rf_roc <- roc(
  response = test$Class,
  predictor = rf_prob,
  levels = c("benign", "malignant")
)
## Setting direction: controls < cases
rf_auc <- auc(rf_roc)

rf_auc
## Area under the curve: 0.9982

Ερμηνεία

131 benign προβλέφθηκαν σωστά ως benign 69 malignant προβλέφθηκαν σωστά ως malignant 2 benign ταξινομήθηκαν λάθος ως malignant 2 malignant ταξινομήθηκαν λάθος ως benign

Άρα συνολικά μόνο: 4 λάθη στο test set

Accuracy = 0.9804 ≈ 98.04%

Το μοντέλο προβλέπει σωστά περίπου το 98% των περιπτώσεων. Πολύ υψηλή επίδοση.

Sensitivity = 0.9718 ≈ 97.18% Δείχνει πόσο καλά εντοπίζει τα κακοήθη περιστατικά. Άρα βρίσκει σωστά περίπου το 97.18% των κακοήθων όγκων.

Specificity = 0.9850 ≈ 98.5% Δείχνει πόσο καλά αναγνωρίζει τα καλοήθη περιστατικά. Άρα προβλέπει σωστά περίπου το 98.5% των καλοήθων όγκων. AUC

AUC=0.9986 Το AUC είναι σχεδόν 1. Αυτό σημαίνει εξαιρετικός διαχωρισμός benign με malignant. Το μοντέλο ξεχωρίζει σχεδόν τέλεια τις δύο κατηγορίες

Άρα πολύ ισχυρό classification model.


Variable Importance plot

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

importance(rf_model)
##                    benign malignant MeanDecreaseAccuracy MeanDecreaseGini
## Cl.thickness    13.435500 21.454365            19.592274        12.492423
## Cell.size       11.976588 15.948203            19.900875        58.301150
## Cell.shape      10.011263 21.083813            22.370249        53.470968
## Marg.adhesion    4.951799 13.487285            13.528026         6.915326
## Epith.c.size    10.025874  4.762791            11.224042        12.617603
## Bare.nuclei     19.069891 20.454103            24.973998        36.838280
## Bl.cromatin      5.943408 14.599084            16.079432        13.093756
## Normal.nucleoli 11.431501 11.709221            15.365021        22.570651
## Mitoses          4.732594  1.147448             4.710676         1.322268

Από το Variable Importance plot, τα top 3 features είναι:

  1. Cell.size
  2. Cell.shape
  3. Bare.nuclei


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

ΜΕΡΟΣ Β — BOOSTING & TUNING

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

Προετοιμασία των δεδομένων για XGBoost

# Προετοιμασία predictors
train_x <- as.matrix(train[, -10])
test_x  <- as.matrix(test[, -10])

# Μετατροπή target σε binary
train_y <- ifelse(train$Class == "malignant", 1, 0)
test_y  <- ifelse(test$Class == "malignant", 1, 0)

# Δημιουργία DMatrix
dtrain <- xgb.DMatrix(
  data = train_x,
  label = train_y
)

dtest <- xgb.DMatrix(
  data = test_x,
  label = test_y
)


Εκπαίδευση XGBoost μοντέλο με early stopping

Παράμετροι: max_depth=4, eta=0.1, nrounds=500, early_stopping_rounds=20

params <- list(
  objective   = "binary:logistic",
  eval_metric = "auc",
  max_depth   = 4,
  eta         = 0.1,       
  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.978037  test-auc:0.974531 
## [26] train-auc:0.997971  test-auc:0.997141 
## Stopping. Best iteration:
## [38] train-auc:0.998832  test-auc:0.997564
## 
## [38] train-auc:0.998832  test-auc:0.997564

Το XGBoost εκπαιδεύτηκε με early stopping ώστε να αποφεύγεται το overfitting. Η εκπαίδευση σταμάτησε στο iteration 26, καθώς το validation AUC δεν βελτιωνόταν πλέον. Το μοντέλο πέτυχε πολύ υψηλό test AUC (~0.997), υποδεικνύοντας εξαιρετική ικανότητα διάκρισης μεταξύ benign και malignant περιπτώσεων.


# Predictions
xgb_prob <- predict(xgb_model, test_x)

# Convert probabilities -> class
xgb_pred <- ifelse(xgb_prob > 0.5,
                   "malignant",
                   "benign")

xgb_pred <- factor(
  xgb_pred,
  levels = c("benign", "malignant")
)

# Confusion Matrix
xgb_cm <- confusionMatrix(
  xgb_pred,
  test$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      
## 
# Metrics
xgb_accuracy <- xgb_cm$overall["Accuracy"]
xgb_sensitivity <- xgb_cm$byClass["Sensitivity"]
xgb_specificity <- xgb_cm$byClass["Specificity"]

# ROC
xgb_roc <- roc(
  response = test$Class,
  predictor = xgb_prob,
  levels = c("benign", "malignant")
)
## Setting direction: controls < cases
xgb_auc <- auc(xgb_roc)

xgb_auc
## Area under the curve: 0.9976

Ερμηνεία

132 benign προβλέφθηκαν σωστά 65 malignant προβλέφθηκαν σωστά 1 benign ταξινομήθηκε λάθος ως malignant 6 malignant ταξινομήθηκαν λάθος ως benign

Συνολικά: 7 λάθη στο test set

Accuracy = 0.9657 ≈ 96.57% Το μοντέλο προβλέπει σωστά περίπου το 96.6% των περιπτώσεων. Πολύ υψηλή επίδοση.

Sensitivity = 0.9155 ≈ 91.55% Δείχνει πόσο καλά εντοπίζει τα malignant περιστατικά. Άρα αναγνωρίζει σωστά περίπου το 91.6% των κακοήθων όγκων.

Specificity=0.9925≈99.25% Δείχνει πόσο καλά αναγνωρίζει τα benign περιστατικά. Άρα ταξινομεί σωστά περίπου το 99.25% των benign περιπτώσεων.

AUC=0.9968 Το AUC είναι σχεδόν 1, που σημαίνει εξαιρετικός διαχωρισμός μεταξύ benign και malignant.


imp_xgb <- xgb.importance(model = xgb_model)
print(imp_xgb)
##            Feature        Gain      Cover  Frequency
##             <char>       <num>      <num>      <num>
## 1:      Cell.shape 0.360965232 0.18231049 0.11344538
## 2:       Cell.size 0.322646319 0.19568959 0.10924370
## 3:     Bare.nuclei 0.148679825 0.22849100 0.20588235
## 4: Normal.nucleoli 0.057965813 0.09032731 0.12184874
## 5:    Cl.thickness 0.043671200 0.08663706 0.14285714
## 6:     Bl.cromatin 0.032928277 0.12102685 0.12184874
## 7:   Marg.adhesion 0.024403832 0.06374165 0.13025210
## 8:    Epith.c.size 0.005748661 0.02348820 0.04201681
## 9:         Mitoses 0.002990841 0.00828785 0.01260504
xgb.plot.importance(imp_xgb, top_n = 8, 
                    main = "Feature Importance — XGBoost")

Από το Variable Importance plot, τα top 3 features είναι:

  1. Cell.size
  2. Cell.shape
  3. Bare.nuclei


Σύγκριση XGBoost vs Random Forest σε ένα πίνακα

Στήλες: Accuracy, Sensitivity, Specificity, AUC

# =========================
# RF metrics
# =========================

rf_accuracy <- rf_cm$overall["Accuracy"]

rf_sensitivity <- rf_cm$byClass["Sensitivity"]

rf_specificity <- rf_cm$byClass["Specificity"]

rf_auc <- auc(rf_roc)

# =========================
# XGBoost metrics
# =========================

xgb_accuracy <- xgb_cm$overall["Accuracy"]

xgb_sensitivity <- xgb_cm$byClass["Sensitivity"]

xgb_specificity <- xgb_cm$byClass["Specificity"]

xgb_auc <- auc(xgb_roc)

# =========================
# Comparison Table
# =========================

comparison_table <- data.frame(

  Model = c(
    "Random Forest",
    "XGBoost"
  ),

  Accuracy = c(
    rf_accuracy,
    xgb_accuracy
  ),

  Sensitivity = c(
    rf_sensitivity,
    xgb_sensitivity
  ),

  Specificity = c(
    rf_specificity,
    xgb_specificity
  ),

  AUC = c(
    rf_auc,
    xgb_auc
  )
)

comparison_table
##           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.9975643


Μέρος Α


1. Ποιο Accuracy πήρατε;

Το Random Forest πέτυχε Accuracy περίπου: Accuracy ≈ 98.04%

ενώ το XGBoost πέτυχε περίπου: Accuracy ≈ 96.57%

Άρα και τα δύο μοντέλα είχαν εξαιρετική απόδοση.


2. Ποια ήταν τα top-3 features σας;

Τα σημαντικότερα features από το Variable Importance Plot ήταν:

Cell.size Cell.shape Bare.nuclei

Αυτά συνέβαλαν περισσότερο στη διάκριση μεταξύ benign και malignant όγκων.


3. Είναι 97% accuracy «αρκετό» σε ιατρικό context; Το 97% accuracy θεωρείται πολύ υψηλό ποσοστό και γενικά εξαιρετικό αποτέλεσμα.

Ωστόσο, σε ιατρικό context δεν αρκεί μόνο το accuracy. Πολύ σημαντικά είναι επίσης: το Sensitivity, τα false negatives, διότι ένα false negative σημαίνει ότι ένας κακοήθης όγκος προβλέπεται λανθασμένα ως καλοήθης.

Στο δικό μας μοντέλο τα false negatives ήταν πολύ λίγα, επομένως η απόδοση θεωρείται ιδιαίτερα καλή για ιαρικό πρόβλημα.


Μέρος Β


1. Ποιο μοντέλο νίκησε; Με πόση διαφορά; Το Random Forest είχε συνολικά καλύτερη απόδοση.

Συγκεκριμένα:

καλύτερο Accuracy καλύτερο Sensitivity ελαφρώς καλύτερο AUC

Η διαφορά στο Accuracy ήταν περίπου: 98.04% − 96.57% ≈ 1.47%, δηλαδή περίπου 1.5%.


2. Σας εξέπληξε κάτι στα αποτελέσματα; Ναι. Παρότι το XGBoost θεωρείται συχνά πιο ισχυρό boosting μοντέλο, στο συγκεκριμένο dataset το Random Forest απέδωσε ελαφρώς καλύτερα.

Επίσης, και τα δύο μοντέλα πέτυχαν εξαιρετικά υψηλό AUC (~0.997–0.999), κάτι που δείχνει ότι το dataset είναι αρκετά “καθαρό” και τα classes διαχωρίζονται σχετικά εύκολα.