Το επιλεγμένο σύνολο δεδομένων αποτελεί μια προσομοίωση πραγματικών ασφαλιστικών δεδομένων, με σκοπό τη διερέυνση των παραγόντων που διαμορφώνουν το ετήσιο ιατρικό κόστος ανά ασφαλισμένο.
#ΔΗΜΙΟΥΡΓΙΑ ΠΙΝΑΚΑ:
datasetVar <- data.frame(
Μεταβλητές = c("age", "sex", "bmi" , "children", "smoker", "region", "charges"),
Τύπος = c("double", "character", "double", "double", "character", "character", "double")
)
#ΕΜΦΑΝΙΣΗ ΠΙΝΑΚΑ:
knitr::kable(datasetVar)
| Μεταβλητές | Τύπος |
|---|---|
| age | double |
| sex | character |
| bmi | double |
| children | double |
| smoker | character |
| region | character |
| charges | double |
Ως εξαρτημένη μεταβλητή επιλέχθηκε η μεταβλητή smoker, καθώς αποτελεί μια δίτιμη κατηγορική μεταβλητή που επιτρέπει τη μελέτη των παραγόντων που καθορίζουν την πιθανότητα ένας ασφαλισμένος να είναι καπνιστής. Οι ανεξάρτητες μεταβλητές που εισήχθησαν στο μοντέλο περιλαμβάνουν δημογραφικά στοιχεία (ηλικία, φύλο, περιοχή), φυσικά χαρακτηριστικά (BMI, αριθμός παιδιών) και οικονομικά δεδομένα (ιατρικές χρεώσεις).
Σε αυτό το στάδιο, διαχωρίζουμε τη βάση δεδομένων σε δύο σύνολα: το train (65%) για την εκπαίδευση του μοντέλου και το test (35%) για την αξιολόγησή του. Ορίζουμε το seed σύμφωνα με τις οδηγίες για τη διασφάλιση της τυχαίας αλλά σταθερής επιλογής των δειγμάτων.
# Φόρτωση απαραίτητων βιβλιοθηκών
library(caTools)
## Warning: package 'caTools' was built under R version 4.5.3
library(ROCR)
## Warning: package 'ROCR' was built under R version 4.5.3
# Ανάγνωση dataset:
Med_Insurance <-read.csv("insurance.csv")
# 1. Ορισμός Seed
set.seed(971)
# 2. Υπολογισμός μεγέθους training set (65%)
split <- sample.split(Med_Insurance$smoker, SplitRatio = 0.65)
# 3. Διαχωρισμός
train <- subset(Med_Insurance, split == TRUE)
test <- subset(Med_Insurance, split == FALSE)
# Έλεγχος μεγέθους των dataset
# Καταγραφή πλήθους καταχωρήσεων
cat("Καταχωρήσεις στο train set:", nrow(train), "\n")
## Καταχωρήσεις στο train set: 870
cat("Καταχωρήσεις στο test set:", nrow(test))
## Καταχωρήσεις στο test set: 468
Στο μοντέλο μας χρησιμοποιούμε την ηλικία (age) και τις χρεώσεις (charges) ως ανεξάρτητες μεταβλητές για την πρόβλεψη της ιδιότητας του καπνιστή. Η επιλογή αυτή εστιάζει στη σχέση της υγείας και του κόστους με τις συνήθειες του ασφαλισμένου, απλουστεύοντας το μοντέλο για την ανάδειξη των πιο κρίσιμων παραγόντων.
# Μετατροπή της εξαρτημένης μεταβλητής σε Factor
train$smoker <- as.factor(train$smoker)
test$smoker <- as.factor(test$smoker)
model <- glm(smoker ~ ., data = train, family = "binomial")
summary(model)
##
## Call:
## glm(formula = smoker ~ ., family = "binomial", data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 5.460e+00 1.370e+00 3.985 6.76e-05 ***
## age -1.066e-01 1.770e-02 -6.019 1.75e-09 ***
## sexmale 5.974e-01 3.952e-01 1.512 0.131
## bmi -3.721e-01 5.972e-02 -6.231 4.65e-10 ***
## children -2.309e-01 1.648e-01 -1.401 0.161
## regionnorthwest -2.325e-01 5.522e-01 -0.421 0.674
## regionsoutheast 4.831e-01 5.547e-01 0.871 0.384
## regionsouthwest 5.255e-01 5.814e-01 0.904 0.366
## charges 4.195e-04 4.177e-05 10.043 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 881.68 on 869 degrees of freedom
## Residual deviance: 178.81 on 861 degrees of freedom
## AIC: 196.81
##
## Number of Fisher Scoring iterations: 8
Από τον πίνακα των συντελεστών, παρατηρούμε ότι οι ανεξάρτητες μεταβλητές που έχουν ισχυρή στατιστική σημαντικότητα (p-value < 0.05) και συνδέονται άμεσα με την πιθανότητα ένας ασφαλισμένος να είναι καπνιστής είναι οι εξής: charges / age/ bmi
Και οι τρεις παραπάνω μεταβλητές έχουν τη μέγιστη στατιστική σημαντικότητα, η οποία υποδηλώνεται από τα τρία αστεράκια στον πίνακα. Αυτό σημαίνει ότι το επίπεδο σημαντικότητας είναι μικρότερο από 0.001, γεγονός που καθιστά το μοντέλο πολύ αξιόπιστο ως προς αυτούς τους παράγοντες.
# Πρόβλεψη στο test set
predictTest <- predict(model, type = 'response', newdata = test)
# Εμφάνιση των πρώτων τιμών για επιβεβαίωση
head(predictTest)
## 5 6 10 13 14 19
## 1.218004e-03 4.667666e-03 7.943389e-01 3.699103e-04 3.757828e-05 4.856004e-05
Η predict δείχνει την πιθανότητα (έναν αριθμό από 0 έως 1) να είναι ο ασφαλισμένος καπνιστής.
# 1. Δημιουργία Confusion Matrix με κατώφλι 0.5
conf_matrix <- table(test$smoker, predictTest > 0.5)
print(conf_matrix)
##
## FALSE TRUE
## no 351 21
## yes 4 92
# 2. Υπολογισμός Ακρίβειας
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
# 3. Υπολογισμός Sensitivity- True Positive Rate
#Στο table, η 2η γραμμή είναι οι πραγματικοί καπνιστές (Yes)
sensitivity <- conf_matrix[2,2] / sum(conf_matrix[2,])
# 4. Υπολογισμός Specificity - True Negative Rate
#Η 1η γραμμή είναι οι μη καπνιστές (No)
specificity <- conf_matrix[1,1] / sum(conf_matrix[1,])
# 5. Ακρίβεια Baseline Model (Πρόβλεψη πάντα της πιο συχνής κατηγορίας "no")
baseline_acc <- max(table(test$smoker)) / nrow(test)
# Εκτύπωση αποτελεσμάτων
cat("Accuracy:", accuracy, "\n")
## Accuracy: 0.9465812
cat("Sensitivity:", sensitivity, "\n")
## Sensitivity: 0.9583333
cat("Specificity:", specificity, "\n")
## Specificity: 0.9435484
cat("Baseline Accuracy:", baseline_acc)
## Baseline Accuracy: 0.7948718
Το μοντέλο είναι εξαιρετικά αξιόπιστο, καθώς η ακρίβειά του (94,66%) υπερέχει σημαντικά του baseline μοντέλου (79,49%) κατά περίπου 15 ποσοστιαίες μονάδες. Επιπλέον, παρουσιάζει πολύ υψηλή και ισορροπημένη ικανότητα στο να εντοπίζει σωστά τόσο τους καπνιστές (Sensitivity) όσο και τους μη καπνιστές (Specificity).
# Δημιουργία του αντικειμένου ROCRpred
ROCRpred <- prediction(predictTest, test$smoker)
# Δημιουργία νέας βάσης χωρίς κενά
insurance2 <- na.omit(Med_Insurance)
# Νέος διαχωρισμός
set.seed(971)
split2 <- sample.split(insurance2$smoker, SplitRatio = 0.65)
train2 <- subset(insurance2, split2 == TRUE)
test2 <- subset(insurance2, split2 == FALSE)
# Καταγραφή καταχωρήσεων
cat("Καταχωρήσεις στο train2:", nrow(train2), "\n")
## Καταχωρήσεις στο train2: 870
cat("Καταχωρήσεις στο test2:", nrow(test2))
## Καταχωρήσεις στο test2: 468
# Παραγωγή καμπύλης ROC
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
plot(ROCRperf, colorize = TRUE, print.cutoffs.at = seq(0, 1, 0.1), text.adj = c(-0.2, 1.7))
# Υπολογισμός AUC
auc_val <- as.numeric(performance(ROCRpred, "auc")@y.values)
cat("Η τιμή του AUC είναι:", auc_val)
## Η τιμή του AUC είναι: 0.9810428
Η ανάλυση της καμπύλης ROC και ο υπολογισμός του δείκτη AUC προσφέρουν μια σαφή εικόνα για την αποτελεσματικότητα του μοντέλου:
Εξαιρετική Ακρίβεια (AUC = 0.981): Ο δείκτης AUC έλαβε την τιμή 0.981, γεγονός που υποδηλώνει ότι το μοντέλο έχει σχεδόν άριστη ικανότητα να διακρίνει τις δύο κατηγορίες των δεδομένων. Πρακτικά, αυτό σημαίνει ότι το μοντέλο προβλέπει σωστά το αποτέλεσμα στο 98,1% των περιπτώσεων.
Ανάλυση της Καμπύλης: Οπτικά, η καμπύλη ROC πλησιάζει την πάνω αριστερή γωνία του διαγράμματος. Αυτό το σχήμα αποτελεί την “ιδανική” μορφή μιας καμπύλης αξιολόγησης, καθώς δείχνει ότι το μοντέλο επιτυγχάνει πολύ υψηλή ευαισθησία (εντοπίζει σχεδόν όλες τις θετικές περιπτώσεις) με ελάχιστα σφάλματα (πολύ χαμηλό ποσοστό ψευδώς θετικών αποτελεσμάτων).