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

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

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

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

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

Δημιουργία μοντέλων 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 ~ age + charges, data = insuranceTrain, family = binomial)

summary(insuranceLog)
## 
## Call:
## glm(formula = smoker ~ age + charges, family = binomial, data = insuranceTrain)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -3.141e+00  4.943e-01  -6.355 2.08e-10 ***
## age         -7.953e-02  1.273e-02  -6.246 4.22e-10 ***
## charges      2.884e-04  2.327e-05  12.394  < 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: 274.83  on 867  degrees of freedom
## AIC: 280.83
## 
## Number of Fisher Scoring iterations: 7

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

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'

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

Προβλέψεις του training μοντέλου

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

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

table(Actual = insuranceTrain$smoker, Predicted = predictTrain > 0.5)
##       Predicted
## Actual FALSE TRUE
##      0   655   37
##      1    51  127

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

exp(coef(insuranceLog))
## (Intercept)         age     charges 
##  0.04322579  0.92354607  1.00028846
  1. Κάθε επιπλέον έτος ηλικίας μειώνει τις πιθανότητες να είναι κάποιος καπνιστής κατά περίπου 7.6%. (1 − 0.924 = 0.076)
  2. Κάθε επιπλέον δολάριο στις χρεώσεις αυξάνει ελάχιστα τις πιθανότητες να είναι κάποιος καπνιστής

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

Σημαντικότητα μεταβλητών: Και οι δύο ανεξάρτητες μεταβλητές, η ηλικία (age) και οι χρεώσεις ασφάλισης (charges), εμφανίζονται στατιστικά σημαντικές στο μοντέλο με p-τιμές πολύ μικρότερες από 0.001. Αυτό σημαίνει ότι και οι δύο παράγοντες επηρεάζουν σημαντικά την πιθανότητα να είναι κάποιος καπνιστής.

Κατεύθυνση σχέσεων:

  1. Η ηλικία έχει αρνητικό συντελεστή: όσο αυξάνεται η ηλικία, μειώνεται η πιθανότητα να είναι κάποιος καπνιστής.
  2. Οι χρεώσεις έχουν θετικό συντελεστή: όσο αυξάνονται οι χρεώσεις ασφάλισης, αυξάνεται και η πιθανότητα το άτομο να είναι καπνιστής. Αυτό είναι αναμενόμενο, καθώς οι καπνιστές αντιμετωπίζουν υψηλότερο κόστος ασφάλισης λόγω αυξημένου κινδύνου για την υγεία τους.