Εργασία 9 - iis23001
Foivos Lazaridis - iis23001
2026-05-11
A. Καθαρισμός του Dataset
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 239prop.table(table(bc$Class)) %>% round(3)##
## benign malignant
## 0.65 0.35Γ. ΜΕΡΟΣ Α - Baseline με Random Forest
Β.1 Χωρισμός δεδομένων
train_indices <- createDataPartition(bc$Class, times=1, p=0.7, list=FALSE)
bc_train <- bc[train_indices, ]
bc_test <- bc[-train_indices, ]
prop.table(table(bc_train$Class)) %>% round(3)##
## benign malignant
## 0.649 0.351prop.table(table(bc_test$Class)) %>% round(3)##
## benign malignant
## 0.652 0.348Από τα παραπάνω φαίνεται πως ο χωρισμός έγινε σωστά και η ισορροποία των κλάσεων έχει διατηρηθεί.
Β.2 Εκπαίδευση Random Forest
set.seed(42)
rf_model <-randomForest(Class ~ .,data = bc_train, ntree = 500, importance = TRUE)
print(rf_model)##
## Call:
## randomForest(formula = Class ~ ., data = bc_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Παρατηρείται μικρό OOB Error (3,55%) πράγμα που σημαίνει πως για το train σετ έχουμε περίπου 96,45% ακρίβεια (accuracy) μοντέλου. Επίσης η ασυμμετρία μεταξύ των κλάσεων είναι μικρή και το ίδιο το νούμερο είναι πολύ κοντά και για τις δύο κλάσεις στην συνολική απόκλιση του μοντέλου. Δεν υποφέρει συνεπώς από ζητήματα στην απόδοση μεταξύ των δύο κλάσεων.
Β.3 Υπολογισμός Accuracy, Sensitivity, AUC επί του Test Set
rf_pred <- predict(rf_model, bc_test)
rf_prob <- predict(rf_model, bc_test, type = "prob")[, "malignant"]
# Confusion Matrix
rf_cm <- confusionMatrix(rf_pred, bc_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(bc_test$Class, rf_prob, levels = c("benign", "malignant"))$auc## Setting direction: controls < casescat("RF AUC:", round(rf_auc, 3), "\n")## RF AUC: 0.999To μοντέλο παρουσιάζει μεγάλα σκορ στα Sensitivity, Specificity, Accuracy και AUC, καθώς όλα είναι μεγαλύτερα του 97%. Αυτό είναι πολύ καλό για το test set και δείχνει πως δεν υπήρξε υπερπροσαρμογή. Για το πεδίο της ιατρικής το επίπεδο ακρίβειας σημαίνει πως 3% θα διαγνωστούν λανθασμένα, ωστόσο δεδομένου πως το error μεταξύ των κλάσεων είναι σχεδόν ίδιο, αυτό σημαίνει πως η περίπτωση να διαγνωστεί λανθασμένα (3%) έχει οριακά 50/50 περίπτωση να είναι είτε benign είτε malignant. Συνεπώς παρόρτι όχι το ιδανικό, δεν είναι προκατηλημένο το μοντέλο κατά την διάγνωση.
B. 4 Δείξε το Variable Importance plot
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Τα τρια πιο σημαντικά χαρακτηριστικά εδώ είναι τα Bare.nuclei, Cell.shape & Cell.size, καθώς είναι τα τρια με τις δύο υψηλότερες τιμές και στα δύο διαγράμματα.
Γ. ΜΕΡΟΣ Β - Boosting & Tuning
Γ.1 Προετοιμασία των δεδομένων
train_x <- as.matrix(bc_train[, -10])
train_y <- ifelse(bc_train$Class == "malignant", 1, 0)
test_x <- as.matrix(bc_test[, -10])
test_y <- ifelse(bc_test$Class == "malignant", 1, 0)
dtrain <- xgb.DMatrix(data = train_x, label = train_y)
dtest <- xgb.DMatrix(data = test_x, label = test_y)Γ.2 Εκπαίδευση XGBoost με Early Stopping
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.982564 test-auc:0.979932
## [26] train-auc:0.997722 test-auc:0.996717
## Stopping. Best iteration:
## [29] train-auc:0.998258 test-auc:0.996717
##
## [29] train-auc:0.998258 test-auc:0.996717Βρήκαμε άρα καλύτερο iteration στο 29 και σταματάμε εδώ.
Γ.3 Σύγκριση XGBoost και RandomForest
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, bc_test$Class, positive = "malignant")
xgb_auc <- roc(bc_test$Class, xgb_prob, levels = c("benign", "malignant"))$auc## Setting direction: controls < casesresults <- 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)
) %>% 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.966 0.930 0.985 0.950 0.998Εδώ βλέπουμε πως σχεδόν σε όλες τις μετρικές το Random Forest εχει οριακά καλύτερη απόδοση από το XGBoost. Δεδομένου πως το XGBoost είναι σχεδιασμένο για την βελτιστοποιήση των αποτελεσμάτων, τα αποτελέσματα κρίνονται μη αναμενόμενα.
Γ.4 ROC με τις δύο γραμμές μαζί
roc_rf <- roc(bc_test$Class, rf_prob, levels = c("benign", "malignant"))## Setting direction: controls < casesroc_xgb <- roc(bc_test$Class, xgb_prob, levels = c("benign", "malignant"))## Setting direction: controls < casesplot(roc_rf, col = "blue", lwd = 3, main = "ROC Curve Comparison")
lines(roc_xgb, col = "red", lwd = 3)
legend("bottomright",
legend = c(paste0("Random Forest (AUC = ", round(auc(roc_rf), 3), ")"),
paste0("XGBoost (AUC = ", round(auc(roc_xgb), 3), ")")),
col = c("blue", "red"), lwd = 3)
Γ.5 Διαφορετικά eta
params <- list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 4,
eta = 0.01, # learning rate
subsample = 0.8,
colsample_bytree = 0.8
)
xgb_model_0.01 <- 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.983301 test-auc:0.966907
## [26] train-auc:0.993110 test-auc:0.996082
## [51] train-auc:0.994249 test-auc:0.995976
## Stopping. Best iteration:
## [53] train-auc:0.994287 test-auc:0.995976
##
## [53] train-auc:0.994287 test-auc:0.995976params <- list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 4,
eta = 0.3, # learning rate
subsample = 0.8,
colsample_bytree = 0.8
)
xgb_model_0.3 <- 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.974765 test-auc:0.966907
## [26] train-auc:0.999847 test-auc:0.995976
## Stopping. Best iteration:
## [29] train-auc:0.999809 test-auc:0.995764
##
## [29] train-auc:0.999809 test-auc:0.995764Παρατηρείται πως με την μειώση του eta από 0,1 σε 0,01 έχουμε μεγάλη αύξηση στον αριθμό επαναλήψεων από 29 σε 39, ενώ αν αυξήσουμε το eta εχουμε επίσης αύξηση των επαναλήψεων αλλά σε μικρότερο βαθμό. Από τα δύο φαίνεται πως η απόδοση (AUC) είναι βέλτιστη στο 0,3. Είναι αναμενόμενο καθώς όσο μειώνουμε το eta τόσο συνήθως αυξάνεται ο αριθμός των βημάτων/ επαναλήψεων.