ΔΕΝΤΡΑ ΑΠΟΦΑΣΗΣ
ΣΟΦΤΣΗΣ ΧΡΙΣΤΟΣ
2025-05-21
Στο dataset Alzheimer's Disease Dataset.
1. ΔΙΕΥΡΕΥΝΗΣΗ ΤΟΥ DATASET
ΕΙΣΑΓΩΓΗ
Η παρούσα εργασία εξετάζει ένα case study πρόβλεψης με χρήση του dataset Alzheimer, το οποίο περιλαμβάνει ιατρικά και συμπεριφορικά δεδομένα από άτομα που συμμετείχαν σε μελέτη για τη γνωστική εξασθένηση και τη νόσο Alzheimer.
Ο στόχος είναι να μελετήσουμε ποιες μεταβλητές σχετίζονται με τη
διάγνωση Alzheimer και να δημιουργήσουμε ένα μοντέλο που προβλέπει αν
ένα άτομο έχει διαγνωστεί με τη νόσο (μεταβλητή
Diagnosis).
Το dataset περιέχει 2149 εγγραφές και αρχικά περιλάμβανε 35 μεταβλητές, εκ των οποίων επιλέχθηκαν 16 σημαντικές μεταβλητές(μαζί με την εξαρτημένη) για περαιτέρω ανάλυση και μοντελοποίηση.
ΑΡΧΙΚΕΣ ΔΙΑΓΝΩΣΤΙΚΕΣ ΕΝΤΟΛΕΣ
## Rows: 2149 Columns: 35
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): DoctorInCharge
## dbl (34): PatientID, Age, Gender, Ethnicity, EducationLevel, BMI, Smoking, A...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Rows: 2149 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (16): Diagnosis, FunctionalAssessment, ADL, BehavioralProblems, MemoryCo...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(alzheimer) # Δομή δεδομένων## spc_tbl_ [2,149 × 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Diagnosis : num [1:2149] 0 0 0 0 0 0 0 1 0 0 ...
## $ FunctionalAssessment : num [1:2149] 6.52 7.12 5.9 8.97 6.05 ...
## $ ADL : num [1:2149] 1.7259 2.5924 7.1195 6.4812 0.0147 ...
## $ BehavioralProblems : num [1:2149] 0 0 0 1 0 0 0 0 1 1 ...
## $ MemoryComplaints : num [1:2149] 0 0 0 0 0 0 0 0 0 0 ...
## $ Disorientation : num [1:2149] 0 0 1 0 0 0 0 0 0 0 ...
## $ MMSE : num [1:2149] 21.46 20.61 7.36 13.99 13.52 ...
## $ DifficultyCompletingTasks: num [1:2149] 1 0 1 0 1 0 0 0 0 0 ...
## $ EducationLevel : num [1:2149] 2 0 1 1 0 1 2 1 0 0 ...
## $ SleepQuality : num [1:2149] 9.03 7.15 9.67 8.39 5.6 ...
## $ BMI : num [1:2149] 22.9 26.8 17.8 33.8 20.7 ...
## $ PersonalityChanges : num [1:2149] 0 0 0 0 1 0 0 0 1 0 ...
## $ Smoking : num [1:2149] 0 0 0 1 0 0 1 0 0 1 ...
## $ CardiovascularDisease : num [1:2149] 0 0 0 0 0 0 0 0 0 1 ...
## $ Hypertension : num [1:2149] 0 0 0 0 0 0 0 0 1 0 ...
## $ Age : num [1:2149] 73 89 73 74 89 86 68 75 72 87 ...
## - attr(*, "spec")=
## .. cols(
## .. Diagnosis = col_double(),
## .. FunctionalAssessment = col_double(),
## .. ADL = col_double(),
## .. BehavioralProblems = col_double(),
## .. MemoryComplaints = col_double(),
## .. Disorientation = col_double(),
## .. MMSE = col_double(),
## .. DifficultyCompletingTasks = col_double(),
## .. EducationLevel = col_double(),
## .. SleepQuality = col_double(),
## .. BMI = col_double(),
## .. PersonalityChanges = col_double(),
## .. Smoking = col_double(),
## .. CardiovascularDisease = col_double(),
## .. Hypertension = col_double(),
## .. Age = col_double()
## .. )
## - attr(*, "problems")=<externalptr>summary(alzheimer) # Περιγραφικά στατιστικά## Diagnosis FunctionalAssessment ADL BehavioralProblems
## Min. :0.0000 Min. :0.00046 Min. : 0.001288 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:2.56628 1st Qu.: 2.342836 1st Qu.:0.0000
## Median :0.0000 Median :5.09444 Median : 5.038973 Median :0.0000
## Mean :0.3537 Mean :5.08005 Mean : 4.982958 Mean :0.1568
## 3rd Qu.:1.0000 3rd Qu.:7.54698 3rd Qu.: 7.581490 3rd Qu.:0.0000
## Max. :1.0000 Max. :9.99647 Max. : 9.999747 Max. :1.0000
## MemoryComplaints Disorientation MMSE
## Min. :0.000 Min. :0.0000 Min. : 0.005312
## 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.: 7.167602
## Median :0.000 Median :0.0000 Median :14.441660
## Mean :0.208 Mean :0.1582 Mean :14.755132
## 3rd Qu.:0.000 3rd Qu.:0.0000 3rd Qu.:22.161028
## Max. :1.000 Max. :1.0000 Max. :29.991381
## DifficultyCompletingTasks EducationLevel SleepQuality BMI
## Min. :0.0000 Min. :0.000 Min. : 4.003 Min. :15.01
## 1st Qu.:0.0000 1st Qu.:1.000 1st Qu.: 5.483 1st Qu.:21.61
## Median :0.0000 Median :1.000 Median : 7.116 Median :27.82
## Mean :0.1587 Mean :1.287 Mean : 7.051 Mean :27.66
## 3rd Qu.:0.0000 3rd Qu.:2.000 3rd Qu.: 8.563 3rd Qu.:33.87
## Max. :1.0000 Max. :3.000 Max. :10.000 Max. :39.99
## PersonalityChanges Smoking CardiovascularDisease Hypertension
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.1508 Mean :0.2885 Mean :0.1443 Mean :0.1489
## 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:0.0000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## Age
## Min. :60.00
## 1st Qu.:67.00
## Median :75.00
## Mean :74.91
## 3rd Qu.:83.00
## Max. :90.00head(alzheimer, 5) # Πρώτες 5 εγγραφές## # A tibble: 5 × 16
## Diagnosis FunctionalAssessment ADL BehavioralProblems MemoryComplaints
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 6.52 1.73 0 0
## 2 0 7.12 2.59 0 0
## 3 0 5.90 7.12 0 0
## 4 0 8.97 6.48 1 0
## 5 0 6.05 0.0147 0 0
## # ℹ 11 more variables: Disorientation <dbl>, MMSE <dbl>,
## # DifficultyCompletingTasks <dbl>, EducationLevel <dbl>, SleepQuality <dbl>,
## # BMI <dbl>, PersonalityChanges <dbl>, Smoking <dbl>,
## # CardiovascularDisease <dbl>, Hypertension <dbl>, Age <dbl>ΠΕΡΙΓΡΑΦΗ ΜΕΤΑΒΛΗΤΩΝ
| Μεταβλητή | Περιγραφή | Μονάδα Μέτρησης |
|---|---|---|
Diagnosis |
Η Εξαρτημένη μεταβλητή: αν υπάρχει διάγνωση με νόσο Alzheimer | Δυαδική (0/1) |
FunctionalAssessment |
Βαθμός λειτουργικότητας / αυτοεξυπηρέτησης | βαθμοί |
ADL |
Activities of Daily Living score (βαθμολογία καθημερινών δραστηριοτήτων) | βαθμοί |
BehavioralProblems |
Ένταση ή συχνότητα συμπεριφορικών προβλημάτων (π.χ. ευερεθιστότητα, άγχος) | δυαδική (0/1) |
MemoryComplaints |
Αριθμός ή ένταση καταγγελιών για προβλήματα μνήμης | δυαδική (0/1) |
Disorientation |
Συχνότητα επεισοδίων αποπροσανατολισμού | δυαδική (0/1) |
MMSE |
Mini-Mental State Examination score (0–30), διαγνωστικό τεστ νοητικής κατάστασης | βαθμοί |
DifficultyCompletingTasks |
Ένδειξη δυσκολίας στην ολοκλήρωση καθημερινών ή γνωστικών εργασιών | δυαδική (0/1) |
EducationLevel |
Επίπεδο εκπαίδευσης (σε 4 διαφορετικές κλίμακες βαθμίδες 0-3) | κατηγορικοί (0-3) |
SleepQuality |
Βαθμολογία ποιότητας ύπνου (π.χ. σε ώρες 4–10) | ώρες |
BMI |
Body Mass Index (βάρος/ύψος²), δείκτης σωματικής σύστασης | kg/m² |
PersonalityChanges |
Ένδειξη αλλαγών στην προσωπικότητα (π.χ. εναλλαγές διάθεσης) | δυαδική (0/1) |
Smoking |
Καπνιστική συμπεριφορά | δυαδική (0/1) |
CardiovascularDisease |
Παρουσία καρδιαγγειακής νόσου | δυαδική (0/1) |
Hypertension |
Διάγνωση υπέρτασης | δυαδική (0/1) |
Age |
Ηλικία του/της συμμετέχοντα σε χρόνια | χρόνια |
ΕΠΕΞΗΓΗΜΑΤΙΚΑ ΣΧΟΛΙΑ
Σημείωση1: Επειδή το dataset είχε 35 μεταβλητές και είναι πάρα πολλές, βρήκα την μέση απόλυτη (και απλή) συσχέτιση κάθε μεταβλητής με όλες τις άλλες και κρατήσα τις πρώτες 15.
| Var1 | avg_abs_r | avg_r |
|---|---|---|
| Diagnosis | 0.062 | -0.016 |
| FunctionalAssessment | 0.031 | -0.007 |
| ADL | 0.027 | -0.011 |
| BehavioralProblems | 0.026 | 0.008 |
| MemoryComplaints | 0.025 | 0.008 |
| Disorientation | 0.021 | 0.003 |
| MMSE | 0.021 | 0.000 |
| DifficultyCompletingTasks | 0.020 | 0.000 |
| EducationLevel | 0.019 | -0.002 |
| SleepQuality | 0.018 | 0.006 |
| BMI | 0.018 | 0.000 |
| PersonalityChanges | 0.018 | -0.005 |
| Smoking | 0.018 | -0.006 |
| CardiovascularDisease | 0.018 | 0.003 |
| Hypertension | 0.018 | -0.001 |
| CholesterolTriglycerides | 0.017 | -0.002 |
| DietQuality | 0.017 | 0.002 |
| CholesterolLDL | 0.017 | 0.002 |
| Age | 0.017 | -0.001 |
| HeadInjury | 0.017 | -0.002 |
| PatientID | 0.016 | -0.004 |
| Gender | 0.016 | 0.001 |
| CholesterolHDL | 0.016 | 0.000 |
| Diabetes | 0.016 | -0.001 |
| Ethnicity | 0.016 | 0.000 |
| FamilyHistoryAlzheimers | 0.016 | 0.001 |
| Forgetfulness | 0.015 | 0.001 |
| CholesterolTotal | 0.015 | -0.002 |
| Depression | 0.014 | 0.001 |
| Confusion | 0.014 | -0.002 |
| PhysicalActivity | 0.014 | 0.002 |
| AlcoholConsumption | 0.014 | -0.005 |
| SystolicBP | 0.014 | -0.006 |
| DiastolicBP | 0.013 | -0.005 |
ΠΙΝΑΚΑΣ ΣΥΣΧΕΤΙΣΕΩΝ
Ένα correlation matrix σε βοηθάει ώστε με μια γρήγορη ματιά να ξέρεις ποιες είναι οι δυνατές συσχετίσεις που υπάρχουν στο dataset.
ΔΙΑΓΡΑΜΜΑΤΑ
Παραθέτω κάποια διαγράμματα μεταξύ κάποιων μεταβλητών-ζευγαριών για καλύτερη κατανόηση του dataset
graph1: histogram
Το histogram με την μεταβλητή Age δείχνει ότι οι ηλικίες
των συμμετεχόντων είναι σχετικά ισοκατανεμημένες στο δείγμα. Δεν
παρατηρείται κάποια έντονη συγκέντρωση τιμών σε συγκεκριμένη ηλικιακή
ομάδα, γεγονός που υποδηλώνει ότι το dataset καλύπτει επαρκώς ένα ευρύ
φάσμα ηλικιών.
graph2: grouped bar chart
Από το γράφημα παρατηρούμε ότι τα άτομα που ανέφεραν προβλήματα μνήμης παρουσιάζουν σε μεγάλο ποσοστό θετική διάγνωση για τη νόσο Alzheimer. Αντίθετα, μεταξύ όσων δεν ανέφεραν προβλήματα μνήμης, η πλειονότητα δεν διαγνώστηκε με τη νόσο.
graph3: bar chart
Ένα απλό γράφημα στο οποίο δείχνω πώς κατανείμεται η εξαρτημένη μεταβλητή στο δείγμα, δηλάδη πόσους έχουμε με Alzheimer και πόσους χωρίς.
graph4: geom_jitter - scatterPlot
Το γράφημα παρουσιάζει τη σχέση ανάμεσα στο σκορ του γνωστικού τεστ MMSE και την πιθανότητα διάγνωσης με Alzheimer. Διακρίνεται ότι τα περισσότερα άτομα που διαγνώστηκαν με τη νόσο (Diagnosis = 1) είχαν χαμηλές επιδόσεις στο τεστ, γεγονός που αντανακλά γνωστικές δυσκολίες. Αντίθετα, τα άτομα που δεν διαγνώστηκαν (Diagnosis = 0) βαθμολογήθηκαν σε υψηλότερες τιμές του MMSE, επιβεβαιώνοντας τη διαγνωστική αξία του τεστ. Το γράφημα επιβεβαιώνει την ισχυρή αρνητική συσχέτιση μεταξύ MMSE score και διάγνωσης Alzheimer.
2. ΔΗΜΙΟΥΡΓΙΑ ΔΕΝΤΡΟΥ
ΚΑΝΟΥΜΕ SPLIT
Διαχωρίζουμε το dataset μας σε trainset και testset
set.seed(3000)
spl <- sample.split(alzheimer$Diagnosis, SplitRatio = 0.7)
Train <- subset(alzheimer, spl == TRUE)
Test <- subset(alzheimer, spl == FALSE)## Πλήθος στο training set: 1504## Πλήθος στο test set: 645ΕΚΠΑΙΔΕΥΣΗ ΔΕΝΤΡΟΥ
Βάζουμε στο μοντέλο και τις 15 μεταβλητές με εξαρτημένη την
Diagnosis.
TreeModel <- rpart(Diagnosis ~ ., data = Train, method = "class")
prp(TreeModel)
Παρακάτω βλέπουμε και το print(TreeModel). Δεν έκανα το
summary() γιατί έχει πολύ μεγάλο και για Rmd αρχειο
output.
## n= 1504
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 1504 532 0 (0.64627660 0.35372340)
## 2) FunctionalAssessment>=4.966706 782 127 0 (0.83759591 0.16240409)
## 4) MemoryComplaints< 0.5 615 50 0 (0.91869919 0.08130081)
## 8) BehavioralProblems< 0.5 526 19 0 (0.96387833 0.03612167) *
## 9) BehavioralProblems>=0.5 89 31 0 (0.65168539 0.34831461)
## 18) ADL>=5.15993 45 2 0 (0.95555556 0.04444444) *
## 19) ADL< 5.15993 44 15 1 (0.34090909 0.65909091)
## 38) MMSE>=24.04367 9 0 0 (1.00000000 0.00000000) *
## 39) MMSE< 24.04367 35 6 1 (0.17142857 0.82857143) *
## 5) MemoryComplaints>=0.5 167 77 0 (0.53892216 0.46107784)
## 10) ADL>=4.840241 84 17 0 (0.79761905 0.20238095)
## 20) BehavioralProblems< 0.5 69 5 0 (0.92753623 0.07246377) *
## 21) BehavioralProblems>=0.5 15 3 1 (0.20000000 0.80000000) *
## 11) ADL< 4.840241 83 23 1 (0.27710843 0.72289157)
## 22) MMSE>=24.10395 19 0 0 (1.00000000 0.00000000) *
## 23) MMSE< 24.10395 64 4 1 (0.06250000 0.93750000) *
## 3) FunctionalAssessment< 4.966706 722 317 1 (0.43905817 0.56094183)
## 6) ADL>=5.036814 340 101 0 (0.70294118 0.29705882)
## 12) MemoryComplaints< 0.5 271 43 0 (0.84132841 0.15867159)
## 24) BehavioralProblems< 0.5 219 5 0 (0.97716895 0.02283105) *
## 25) BehavioralProblems>=0.5 52 14 1 (0.26923077 0.73076923)
## 50) MMSE>=23.79367 12 0 0 (1.00000000 0.00000000) *
## 51) MMSE< 23.79367 40 2 1 (0.05000000 0.95000000) *
## 13) MemoryComplaints>=0.5 69 11 1 (0.15942029 0.84057971)
## 26) MMSE>=24.02476 10 1 0 (0.90000000 0.10000000) *
## 27) MMSE< 24.02476 59 2 1 (0.03389831 0.96610169) *
## 7) ADL< 5.036814 382 78 1 (0.20418848 0.79581152)
## 14) MMSE>=24.02205 68 4 0 (0.94117647 0.05882353) *
## 15) MMSE< 24.02205 314 14 1 (0.04458599 0.95541401) *3. ΠΡΟΒΛΕΨΗ
ACCURACY ΔΕΝΤΡΟΥ
Εφαρμόζουμε το μοντέλο που φτιάξαμε σε νέα δεδομένα, συγκεκριμένα στα test δεδομένα και παίρνουμε ακρίβεια 0.945. Άρα όπως θα δείτε παρακάτω είναι καλύτερο του baseline, ανταγωνιστικό του μοντέλου λογιστικής παλινδρόμησης και πολύ πιο ερμηνεύσιμο.
PredictCART <- predict(TreeModel, newdata = Test, type = "class")
table(Test$Diagnosis, PredictCART)## PredictCART
## 0 1
## 0 405 12
## 1 23 205accuracy <- sum(diag(table(Test$Diagnosis, PredictCART))) / nrow(Test)
accuracy # εμφάνιση ποσοστού ακρίβειας## [1] 0.9457364ΣΥΓΚΡΙΣΗ ΜΕ BASELINE
Tο μοντέλο baseline που δίνει πρόβλεψη πάντα
OXI ΔΙΑΓΝΩΣΗ έχει ακρίβεια 0.647.
# Count των τιμών της Diagnosis στο Test
table(Test$Diagnosis)##
## 0 1
## 417 228# Ποια είναι η πιο συχνή κατηγορία;
most_common_class <- names(which.max(table(Test$Diagnosis)))
# Υπολογισμός baseline accuracy: προβλέπουμε πάντα την πιο συχνή κατηγορία
baseline_accuracy <- sum(Test$Diagnosis == most_common_class) / nrow(Test)## Baseline accuracy (predict always 0 ): 0.647ΣΥΓΚΡΙΣΗ ΜΕ ΛΟΓΙΣΤΙΚΗ ΠΑΛΙΝΔΡΟΜΗΣΗ
Αν είχαμε χτίσει μοντέλο λογιστικής παλινδρόμησης, αυτό θα έδινε ακρίβεια περίπου 0.854.
# Confusion matrix
table(Actual = Test$Diagnosis, Predicted = log_pred_class)## Predicted
## Actual 0 1
## 0 379 38
## 1 56 172## Logistic Regression Accuracy: 0.854ΑΞΙΟΛΟΓΗΣΗ ΜΟΝΤΕΛΟΥ
ΚΑΜΠΥΛΗ ROC
PredictROC <- predict(TreeModel, newdata = Test)
head(PredictROC, 10)## 0 1
## 1 0.96387833 0.03612167
## 2 0.96387833 0.03612167
## 3 0.95555556 0.04444444
## 4 0.96387833 0.03612167
## 5 0.04458599 0.95541401
## 6 0.06250000 0.93750000
## 7 0.03389831 0.96610169
## 8 0.95555556 0.04444444
## 9 0.95555556 0.04444444
## 10 0.04458599 0.95541401pred <- prediction(PredictROC[,2], Test$Diagnosis)
perf <- performance(pred, "tpr", "fpr")
plot(perf)
ΜΕΤΡΙΚΗ AUC
as.numeric(performance(pred, "auc")@y.values)## [1] 0.9447863Βρήκαμε μια καλή τιμή, σκεφτείτε όταν είναι κοντά στο 0.5 οι τιμές είναι σχεδόν τυχαίες, οπότε θέλουμε όσο γίνεται πιο κοντά στο 1.
CROSS-VALIDATION
Για να πειραματιστούμε με το δέντρο και να δούμε αν το κάναμε υπερβολικά περίπλοκο ή απλό αλλάζουμε το min-bucket, έτσι κάνουμε το αντίστοιχο pruning. Αυτό σημαίνει ότι με τις ίδιες μεταβλητές στο μοντέλο μπορεί να πετύχουμε διαφορετική ακρίβεια. Για τον λόγο αυτό κάνουμε cross-validation και χρησιμοποιήσουμε μια παράμετρο που ονομάζεται παράμετρος πολυπλοκότητας (cp). Αυτή που θα δώσει την υψηλότερη ακρίβεια, την κρατάμε και με αυτήν εκπαιδεύουμε το μοντέλο μας στο train.
# Βήμα 1: Ορισμός cross-validation (7-fold)
numFolds <- trainControl(method = "cv", number = 7)
# Βήμα 2: Ορισμός grid για παράμετρο cp
cpGrid <- expand.grid(.cp = seq(0.01, 0.2, 0.01))
# Βήμα 3: Μετατροπή της εξαρτημένης σε factor (μόνο μία φορά!)
Train$Diagnosis <- factor(Train$Diagnosis, levels = c(0, 1), labels = c("No", "Yes"))
# Βήμα 4: Εκπαίδευση μοντέλου με cross-validation
cvModel <- train(
Diagnosis ~ .,
data = Train,
method = "rpart",
trControl = numFolds,
tuneGrid = cpGrid
)# Βήμα 5: Εμφανίζουμε βασικά αποτελέσματα
print(cvModel)## CART
##
## 1504 samples
## 15 predictor
## 2 classes: 'No', 'Yes'
##
## No pre-processing
## Resampling: Cross-Validated (7 fold)
## Summary of sample sizes: 1289, 1289, 1290, 1289, 1289, 1289, ...
## Resampling results across tuning parameters:
##
## cp Accuracy Kappa
## 0.01 0.9448039 0.8793661
## 0.02 0.9222095 0.8272298
## 0.03 0.9042693 0.7836508
## 0.04 0.8750054 0.7109624
## 0.05 0.8716832 0.7009196
## 0.06 0.8710187 0.6988831
## 0.07 0.8710187 0.6988831
## 0.08 0.8590493 0.6674950
## 0.09 0.8497469 0.6421304
## 0.10 0.8324433 0.5962913
## 0.11 0.8158320 0.5628387
## 0.12 0.8052007 0.5416900
## 0.13 0.8025429 0.5361878
## 0.14 0.7899183 0.5160516
## 0.15 0.7805725 0.5030746
## 0.16 0.7805725 0.5030746
## 0.17 0.7805725 0.5030746
## 0.18 0.7805725 0.5030746
## 0.19 0.7805725 0.5030746
## 0.20 0.7626323 0.4276306
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cp = 0.01.Και παίρνουμε ως αποτέλεσμα: The final value used for the model was cp = 0.01.
plot(cvModel)
Βλέπουμε στο γράφημα ότι όσο αυξάνουμε το cp το δέντρο πρακτικά γίνεται πιο απλό και μικρό οπότε χάνουμε ακρίβεια. Τελικά κρατάμε το 0.01 και προχωράμε.
# Βήμα 6: Εκπαίδευση τελικού CART με το καλύτερο cp
best_cp <- cvModel$bestTune$cp
AlzheimerTreeCV <- rpart(Diagnosis ~ ., data = Train, method = "class", cp = best_cp)Μετά κάνουμε την πρόβλεψη μας στο test και βλέπουμε την ακρίβεια.
# Βήμα 7: Πρόβλεψη και πίνακας σύγχυσης
PredictCV <- predict(AlzheimerTreeCV, newdata = Test, type = "class")
table(Test$Diagnosis, PredictCV)## PredictCV
## No Yes
## 0 405 12
## 1 23 205Το confusion matrix δείχνει ότι το μοντέλο με cross-validation προβλέπει σωστά τόσο τις θετικές όσο και τις αρνητικές περιπτώσεις, με σχετικά μικρό αριθμό σφαλμάτων (12 false positives και 23 false negatives).
## [1] 0.9457364Η ακρίβεια που επιτεύχθηκε στο test set ήταν 0.945, η οποία είναι ελαφρώς βελτιωμένη σε σχέση με την ακρίβεια 0.944 του αρχικού δέντρου χωρίς χρήση cross-validation.
4. ΑΠΟΤΕΛΕΣΜΑΤΑ - ΠΑΡΑΔΕΙΓΜΑΤΑ
ΣΥΜΠΕΡΑΣΜΑΤΑ
Παρότι η διαφορά στην ακρίβεια μεταξύ απλού και optimized δέντρου είναι μικρή (0.945 > 0.944), η χρήση cross-validation παραμένει σημαντική, καθώς προσφέρει σταθερότερη επιλογή υπερπαραμέτρων, μειώνει την πιθανότητα υπερπροσαρμογής, και εξασφαλίζει ότι η τιμή cp δεν επιλέγεται αυθαίρετα ή μόνο με βάση την ακρίβεια στο training set.
Ο cp ελέγχει το pruning (κλάδεμα) στο δέντρο αποφάσεων
Η χρήση k-fold cross-validation σε βοηθάει στο να επιλέξεις μια τιμή cp με βάση την απόδοση στο training set.
Το dataset φάνηκε αρκετά ισορροπημένο, αφού δεν είχαμε σημαντικά προβλήματα στην πρόβλεψη της μειοψηφικής κλάσης του να διαγνωστεί κάποιος με τη νόσο.
ΠΡΟΒΛΗΜΑΤΙΣΜΟΙ
Είχα μεγάλο θέμα στο feature selection γιατί το αρχικό dataset είχε 35 στήλες και δεν γινόταν να τις κρατήσω όλες, πχ δεν μπορούσα να κάνω το heatmap με τις συσχετίσεις.
Επειδή πολλές από τις μεταβλητές ήταν δυαδικές δηλαδή 0 ή 1 δεν μπορούσα να βγάλω ωραία γραφήματα που να δείχνουν κάποια ενδιαφέρουσα σχέση
Δεν μπορούσα να κάνω fetch το best_cp επειδή χρησιμοποιούσα λάθος την μέθοδο με την οποία το επιτυγάνεις, συγκεκριμένα:
best_cp <- cvModel$bestTune$.cpενω θα επρεπεbest_cp <- cvModel$bestTune$cp