1. Περιγραφή του Dataset

Το Dataset Ασφάλισης περιλαμβάνει δεδομένα που σχετίζονται με το κόστος ασφάλισης υγείας για άτομα στις Ηνωμένες Πολιτείες. Κάθε γραμμή αντιστοιχεί σε έναν ασφαλισμένο και περιέχει δημογραφικά χαρακτηριστικά και πληροφορίες για τον τρόπο ζωής του, καθώς και το ποσό που πληρώνει σε ετήσια βάση για την ασφάλειά του. Το dataset χρησιμοποιείται ευρέως για σκοπούς στατιστικής ανάλυσης, εκπαίδευσης μηχανικής μάθησης και αναλυτικής προβλεπτικών μοντέλων.

**Πίνακας των μεταβλητών του Dataset**
Μεταβλητή	Περιγραφή
age	Ηλικία του ασφαλισμένου
sex	Φύλο (male/female)
bmi	Δείκτης Μάζας Σώματος (BMI)
children	Αριθμός εξαρτώμενων παιδιών
smoker	Καπνιστής (yes/no)
region	Γεωγραφική περιοχή (π.χ. southeast)
charges	Ετήσιο κόστος ασφάλισης ($)

1.2 Υπολογισμός και παρουσίαση περιγραφικών στατιστικών

summary(insurance)

##       age            sex                 bmi           children    
##  Min.   :18.00   Length:1338        Min.   :15.96   Min.   :0.000  
##  1st Qu.:27.00   Class :character   1st Qu.:26.30   1st Qu.:0.000  
##  Median :39.00   Mode  :character   Median :30.40   Median :1.000  
##  Mean   :39.21                      Mean   :30.66   Mean   :1.095  
##  3rd Qu.:51.00                      3rd Qu.:34.69   3rd Qu.:2.000  
##  Max.   :64.00                      Max.   :53.13   Max.   :5.000  
##     smoker             region             charges     
##  Length:1338        Length:1338        Min.   : 1122  
##  Class :character   Class :character   1st Qu.: 4740  
##  Mode  :character   Mode  :character   Median : 9382  
##                                        Mean   :13270  
##                                        3rd Qu.:16640  
##                                        Max.   :63770

1.3 Δημιουργία μοντέλων Train και Test

set.seed(949)
split <- sample.split(insurance$smoker,SplitRatio=0.65)
insuranceTrain = subset(insurance,split==TRUE)
cat("Train set:", nrow(insuranceTrain), "καταχωρήσεις\n")

## Train set: 870 καταχωρήσεις

insuranceTest = subset(insurance,split==FALSE)
cat("Test set:", nrow(insuranceTest), "καταχωρήσεις\n")

## Test set: 468 καταχωρήσεις

insuranceTrain$smoker <- ifelse(insuranceTrain$smoker == "yes", 1, 0)
insuranceLog <- glm(smoker ~ ., data = insuranceTrain, family = binomial)

summary(insuranceLog)

## 
## Call:
## glm(formula = smoker ~ ., family = binomial, data = insuranceTrain)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      4.672e+00  1.335e+00   3.501 0.000464 ***
## age             -9.249e-02  1.562e-02  -5.920 3.22e-09 ***
## sexmale          6.727e-01  3.687e-01   1.825 0.068072 .  
## bmi             -3.300e-01  5.407e-02  -6.103 1.04e-09 ***
## children        -3.055e-01  1.508e-01  -2.027 0.042703 *  
## regionnorthwest  4.014e-02  4.836e-01   0.083 0.933843    
## regionsoutheast  1.003e+00  5.211e-01   1.925 0.054246 .  
## regionsouthwest  4.544e-01  5.220e-01   0.871 0.383996    
## charges          3.615e-04  3.332e-05  10.848  < 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: 207.91  on 861  degrees of freedom
## AIC: 225.91
## 
## Number of Fisher Scoring iterations: 8

2. Δημιουργία διαγράμματος Λογιστικής Παλινδρόμησης

ggplot(insuranceTrain, aes(charges, smoker)) + 
         geom_point() +
         geom_smooth(method = "glm", method.args = list(family = "binomial")) +
         labs(title = "Logistic Regression Plot - Model 1",
                         x = "Independent Variable",
                         y = "Probability") +
         theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Σχόλιο: Το διάγραμμα δείχνει ότι καθώς αυξάνονται οι χρεώσεις ασφάλισης, αυξάνεται σημαντικά η πιθανότητα να είναι κάποιος καπνιστής, επιβεβαιώνοντας τη θετική συσχέτιση μεταξύ των δύο μεταβλητών.

ggplot(insuranceTrain, aes(age, smoker)) + 
         geom_point(alpha = 0.5) +
         geom_smooth(method = "glm", method.args = list(family = "binomial")) +
         labs(title = "Logistic Regression Plot - Model 2",
                         x = "Independent Variable",
                         y = "Probability") +
         theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Σχόλιο: Το διάγραμμα δείχνει ότι η πιθανότητα να είναι κάποιος καπνιστής μειώνεται όσο αυξάνεται η ηλικία, αποκαλύπτοντας μια αρνητική συσχέτιση μεταξύ ηλικίας και καπνίσματος.

3. Εφαρμογή πρόβλεψης

predictTrain <- predict(insuranceLog,type='response')
predictTest <-  predict(insuranceLog, type='response', newdata=insuranceTest)
tapply(predictTrain,insuranceTrain$smoker,mean)

##          0          1 
## 0.04435057 0.82758092

3.1 Πίνακας πρόβλεψης πραγματικών τιμών / Confusion Matrix

table(Actual = insuranceTrain$smoker, Predicted = predictTrain > 0.5)

##       Predicted
## Actual FALSE TRUE
##      0   668   24
##      1    15  163

3.2 Ερμηνεία συντελεστών

exp(coef(insuranceLog))

##     (Intercept)             age         sexmale             bmi        children 
##     106.8818981       0.9116563       1.9594588       0.7188992       0.7367283 
## regionnorthwest regionsoutheast regionsouthwest         charges 
##       1.0409607       2.7263838       1.5752444       1.0003615

Κάθε επιπλέον έτος ηλικίας μειώνει τις πιθανότητες να είναι κάποιος καπνιστής κατά περίπου 7.6%. (1 − 0.924 = 0.076)
Κάθε επιπλέον δολάριο στις χρεώσεις αυξάνει ελάχιστα τις πιθανότητες να είναι κάποιος καπνιστής

3.3 Area Under The Curve - AUC

ROCRpred <- prediction(predictTest, insuranceTest$smoker)
ROCRperf <- performance(ROCRpred, "tpr", "fpr")

plot(ROCRperf,colorize = TRUE)
abline(a=0, b=1, lty=2, col="gray") 
title("ROC Curve for Smoker Prediction")

## AUC = 0.9877

4. Συμπεράσματα

Η ROC καμπύλη δείχνει ότι το μοντέλο προβλέπει με εξαιρετική ακρίβεια ποιος είναι καπνιστής, καθώς ανεβαίνει απότομα και παραμένει κοντά στην κορυφή με πολύ χαμηλό False Positive Rate.
Η τιμή AUC = 0.9877 υποδηλώνει πολύ υψηλή ικανότητα διάκρισης, δηλαδή το μοντέλο σχεδόν πάντα ξεχωρίζει σωστά καπνιστές από μη καπνιστές.
Η μεταβλητή charges φαίνεται να παίζει καθοριστικό ρόλο στην πρόβλεψη, κάτι που δικαιολογεί και τη σχεδόν τέλεια απόδοση του μοντέλου.

Λογιστική Παλινδρόμηση - Επιχειρηματική Αναλυτική/ εργ 6

Σταμούλη Φανή, iis22049

2025-05-14