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)
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
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
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
mtry = 3 Επειδή υπάρχουν 9 features, το randomForest επέλεξε default: 3 μεταβλητές ανά split.
OOB error ≈ 3.76% Αυτό σημαίνει ότι το μοντέλο κάνει λάθος περίπου στο 3.76% των περιπτώσεων χωρίς να χρησιμοποιήσει το test set.
Άρα το εκτιμώμενο accuracy είναι περίπου: Accuracy ≈ 1 − 0.0376 = 0.9624, δηλαδή περίπου 96.24%, που θεωρείται εξαιρετική επίδοση.
Για την κατηγορία benign: Class Error benign = 0.0289 ≈ 2.9%, δηλαδή το μοντέλο αναγνωρίζει σωστά περίπου το 97.1% των καλοήθη περιπτώσεων.
Για την κατηγορία malignant: Class Error malignant = 0.0535 ≈ 5.35%, δηλαδή αναγνωρίζει σωστά περίπου το 94.65% των κακοήθων περιπτώσεων.
Το μοντέλο παρουσιάζει πολύ καλή ισορροπία μεταξύ των δύο κατηγοριών και δεν φαίνεται να έχει σοβαρό imbalance problem.
Παρότι κάνει λίγο περισσότερα λάθη στα κακοήθη περιστατικά, η απόδοση παραμένει εξαιρετικά υψηλή για ιατρικό classification πρόβλημα.
# 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.
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 είναι:
# Προετοιμασία 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
)
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 είναι:
# =========================
# 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 διαχωρίζονται σχετικά εύκολα.