Επιλογή μεθόδου

Για το dataset Medical Cost Personal θα χρησιμοποιηθεί η Γραμμικη Παλινδρόμηση μετατρέποντας τα αλφαριθμιτικά στοιχεία σε αριθμητικά μεταβλητές όπως:

  • sex (male = 1, female = 0)
  • smoker (yes = 1, no = 0)
  • region (northwest = 1, southeast = 0)
# Διάβασμα CSV αρχείου
insurance_data <- read.csv("insurance.csv")
summary(insurance_data)
##       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
# Αλλαγη απο text σε numeric
insurance_data$sex_numeric <- ifelse(insurance_data$sex == "male", 1, 0)
insurance_data$smoker_numeric <- ifelse(insurance_data$smoker == "yes", 1, 0)
insurance_data$region_numeric <- ifelse(insurance_data$region == "northwest", 1, 0)
summary(insurance_data)
##       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       sex_numeric    
##  Length:1338        Length:1338        Min.   : 1122   Min.   :0.0000  
##  Class :character   Class :character   1st Qu.: 4740   1st Qu.:0.0000  
##  Mode  :character   Mode  :character   Median : 9382   Median :1.0000  
##                                        Mean   :13270   Mean   :0.5052  
##                                        3rd Qu.:16640   3rd Qu.:1.0000  
##                                        Max.   :63770   Max.   :1.0000  
##  smoker_numeric   region_numeric  
##  Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.0000  
##  Mean   :0.2048   Mean   :0.2429  
##  3rd Qu.:0.0000   3rd Qu.:0.0000  
##  Max.   :1.0000   Max.   :1.0000

Διερεύνηση

Για την εύρεση των σημαντικότερων μεταβλητων θα γίνει η διαδικασία αφαίρεσης μεταβλητών.

Δοκιμή 1η

m1 <- lm(charges ~ age + sex_numeric + bmi + children + smoker_numeric + region_numeric,  data = insurance_data)

summary (m1)
## 
## Call:
## lm(formula = charges ~ age + sex_numeric + bmi + children + smoker_numeric + 
##     region_numeric, data = insurance_data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -11744  -2909  -1001   1386  29627 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -12209.29     973.14 -12.546  < 2e-16 ***
## age               257.62      11.91  21.637  < 2e-16 ***
## sex_numeric      -128.07     333.41  -0.384 0.700953    
## bmi               325.26      27.68  11.750  < 2e-16 ***
## children          471.60     137.93   3.419 0.000647 ***
## smoker_numeric  23834.91     412.86  57.731  < 2e-16 ***
## region_numeric    299.88     391.08   0.767 0.443324    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6071 on 1331 degrees of freedom
## Multiple R-squared:  0.7498, Adjusted R-squared:  0.7487 
## F-statistic: 664.9 on 6 and 1331 DF,  p-value: < 2.2e-16
coef(m1)
##    (Intercept)            age    sex_numeric            bmi       children 
##    -12209.2930       257.6201      -128.0694       325.2642       471.5998 
## smoker_numeric region_numeric 
##     23834.9126       299.8846

Παρατειρείται στην σύνοψη πως οι μεταβλητές που έχουν το μεγαλήτερο significance για το πώς συμπεριφέρεται η charges έιναι:

  • age
  • bmi
  • children
  • smoker_numeric

Οπότε, επαναλαμβάνουμε το μοντέλο αφαιρόντας τις μη σημαντικές μεταβλητες: * sex_numeric * region_numeric.

Δοκιμή 2η

m2 <- lm(charges ~ age + bmi + children + smoker_numeric,  data = insurance_data)

summary (m2)
## 
## Call:
## lm(formula = charges ~ age + bmi + children + smoker_numeric, 
##     data = insurance_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11897.9  -2920.8   -986.6   1392.2  29509.6 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -12102.77     941.98 -12.848  < 2e-16 ***
## age               257.85      11.90  21.675  < 2e-16 ***
## bmi               321.85      27.38  11.756  < 2e-16 ***
## children          473.50     137.79   3.436 0.000608 ***
## smoker_numeric  23811.40     411.22  57.904  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6068 on 1333 degrees of freedom
## Multiple R-squared:  0.7497, Adjusted R-squared:  0.7489 
## F-statistic: 998.1 on 4 and 1333 DF,  p-value: < 2.2e-16
coef(m2)
##    (Intercept)            age            bmi       children smoker_numeric 
##    -12102.7694       257.8495       321.8514       473.5023     23811.3998

Αφαιρόντας τις δύο μεταβλητες δεν υπάρχει σημαντική αλλαγή στο στο Multiple R-squared και Adjusted R-squared. Παρόλα αυτά, όσο λιγοτερες οι μεταβλητές, τοσο το καλύτερο. Αφαιρεθεί, το children για ελεγχο ιδανικότερου μοντέλου που έχει το λιγότερο significance.

Δοκιμή 3η

m3 <- lm(charges ~ age + bmi + smoker_numeric,  data = insurance_data)

summary (m3)
## 
## Call:
## lm(formula = charges ~ age + bmi + smoker_numeric, data = insurance_data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12415.4  -2970.9   -980.5   1480.0  28971.8 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -11676.83     937.57  -12.45   <2e-16 ***
## age               259.55      11.93   21.75   <2e-16 ***
## bmi               322.62      27.49   11.74   <2e-16 ***
## smoker_numeric  23823.68     412.87   57.70   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6092 on 1334 degrees of freedom
## Multiple R-squared:  0.7475, Adjusted R-squared:  0.7469 
## F-statistic:  1316 on 3 and 1334 DF,  p-value: < 2.2e-16
coef(m3)
##    (Intercept)            age            bmi smoker_numeric 
##    -11676.8304       259.5475       322.6151     23823.6845

Για την 2η και 3η δοκιμή έχουμε:

Δοκιμή 2η

  • Multiple R-squared: 0.7497
  • Adjusted R-squared: 0.7489

Δοκιμή 3η

  • Multiple R-squared: 0.7475
  • Adjusted R-squared: 0.7469

Παρατειρείται πως οι Multiple R-squared και Adjusted R-squared μικραίνουν στην 3η δοκιμή. Άρα η 2η δοκιμή είναι η ιδανική.

Το plot της δοκιμή 2η

Απαντήσεις στις ερωτήσεις

1)Πόσο μεταβάλλεται (σε €) το αναμενόμενο ετήσιο κόστος για κάθε επιπλέον έτος ηλικίας, κρατώντας τα υπόλοιπα σταθερά;

ggplot(insurance_data, aes(age, charges)) +
      geom_point() + 
      geom_abline(aes(intercept = coef(m2)[1], 
slope = coef(m2)[2]), colour = "red")

Παρατειρείται πως όσο αυξάνεται η ηλικία τόσο πιο ακριβή γινεται η ασφάλεια.