Το Medical Cost Personal Dataset περιέχει δεδομένα ασφαλισμένων και το κόστος ιατρικής ασφάλισης (charges).

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

data <- read.csv("insurance.csv")

str(data)
## 'data.frame':    1338 obs. of  7 variables:
##  $ age     : int  19 18 28 33 32 31 46 37 37 60 ...
##  $ sex     : chr  "female" "male" "male" "male" ...
##  $ bmi     : num  27.9 33.8 33 22.7 28.9 ...
##  $ children: int  0 1 3 0 0 0 1 3 2 0 ...
##  $ smoker  : chr  "yes" "no" "no" "no" ...
##  $ region  : chr  "southwest" "southeast" "southeast" "northwest" ...
##  $ charges : num  16885 1726 4449 21984 3867 ...
summary(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

Η ηλικία κυμαίνεται από 18 έως 64. Το BMI κυμαίνεται περίπου από 15 έως 53. Υπάρχουν 274 καπνιστές και 1064 μη καπνιστές. Το charges έχει μεγάλη διασπορά, ιδιαίτερα υψηλές τιμές για καπνιστές.

Ο smoker φαίνεται να είναι η πιο σημαντική μεταβλητή για το κόστος. Υπάρχει θετική συσχέτιση ανάμεσα σε age και charges. Το bmi μπορεί να επηρεάζει το κόστος, ειδικά σε συνδυασμό με smoker.

library(ggplot2)
ggplot(data, aes(x=age, y=charges)) +
  geom_point(color="blue", alpha=0.6) +
  labs(title="Charges vs Age",
       x="Age",
       y="Charges") +
  theme_minimal()

ggplot(data, aes(x=bmi, y=charges)) +
  geom_point(color="darkgreen", alpha=0.6) +
  labs(title="Charges vs BMI",
       x="BMI",
       y="Charges") +
  theme_minimal()

ggplot(data, aes(x=sex, y=charges, fill=sex)) +
  geom_boxplot() +
  labs(title="Charges vs Sex",
       x="Sex",
       y="Charges") +
  theme_minimal() 

  ggplot(data, aes(x=age, y=charges, color=smoker)) +
  geom_point(alpha=0.6) +
  labs(title="Charges vs Age by Smoker",
       x="Age",
       y="Charges") +
  theme_minimal()

  model1 <- lm(charges ~ age, data=data)
  summary(model1)
## 
## Call:
## lm(formula = charges ~ age, data = data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##  -8059  -6671  -5939   5440  47829 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   3165.9      937.1   3.378 0.000751 ***
## age            257.7       22.5  11.453  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11560 on 1336 degrees of freedom
## Multiple R-squared:  0.08941,    Adjusted R-squared:  0.08872 
## F-statistic: 131.2 on 1 and 1336 DF,  p-value: < 2.2e-16
  ggplot(data, aes(age, charges)) +
      geom_point() + 
      geom_abline(aes(intercept = coef(model1)[1], 
  slope = coef(model1)[2]), colour = "red")

  model2 <- lm(charges ~ age + bmi + smoker, data=data)
  summary(model2)
## 
## Call:
## lm(formula = charges ~ age + bmi + smoker, data = 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 ***
## smokeryes    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
  ggplot(data, aes(age, charges)) +
      geom_point() + 
      geom_abline(aes(intercept = coef(model2)[1], 
  slope = coef(model2)[2]), colour = "red")

  ggplot(data, aes(bmi, charges)) +
      geom_point() + 
      geom_abline(aes(intercept = coef(model2)[1], 
  slope = coef(model2)[2]), colour = "red")

  ggplot(data, aes(smoker, charges)) +
      geom_point() + 
      geom_abline(aes(intercept = coef(model2)[1], 
  slope = coef(model2)[2]), colour = "red")

cor(data$age, data$bmi)
## [1] 0.1092719
cor(data$age, data$children)
## [1] 0.042469
cor(data$age, data$charges)
## [1] 0.2990082
cor(data$bmi, data$children)
## [1] 0.0127589
cor(data$bmi, data$charges)
## [1] 0.198341
cor(data$children, data$charges)
## [1] 0.06799823
#model1: Charges ~ age
SSE1 <- sum(residuals(model1)^2)
SSE1
## [1] 1.78544e+11
summary(model1)
## 
## Call:
## lm(formula = charges ~ age, data = data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##  -8059  -6671  -5939   5440  47829 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   3165.9      937.1   3.378 0.000751 ***
## age            257.7       22.5  11.453  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11560 on 1336 degrees of freedom
## Multiple R-squared:  0.08941,    Adjusted R-squared:  0.08872 
## F-statistic: 131.2 on 1 and 1336 DF,  p-value: < 2.2e-16
#model6 charges ~ age, bmi
model6 <- lm(charges ~ age + bmi, data=data)
  SSE6 <- sum(residuals(model6)^2)
  SSE6
## [1] 173097580364
  summary(model6)
## 
## Call:
## lm(formula = charges ~ age + bmi, data = data)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -14457  -7045  -5136   7211  48022 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -6424.80    1744.09  -3.684 0.000239 ***
## age           241.93      22.30  10.850  < 2e-16 ***
## bmi           332.97      51.37   6.481 1.28e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11390 on 1335 degrees of freedom
## Multiple R-squared:  0.1172, Adjusted R-squared:  0.1159 
## F-statistic:  88.6 on 2 and 1335 DF,  p-value: < 2.2e-16
#model2: charges ~ age, bmi, smoker

SSE2 <- sum(residuals(model2)^2)
SSE2
## [1] 49513219514
summary(model2)
## 
## Call:
## lm(formula = charges ~ age + bmi + smoker, data = 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 ***
## smokeryes    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
#model3: charges ~ age, bmi, smoker, sex
  model3 <- lm(charges ~ age + bmi + smoker + sex, data=data)
  SSE3 <- sum(residuals(model3)^2)
  SSE3
## [1] 49509276603
  summary(model3)
## 
## Call:
## lm(formula = charges ~ age + bmi + smoker + sex, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -12364.7  -2972.2   -983.2   1475.8  29018.3 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -11633.49     947.27 -12.281   <2e-16 ***
## age            259.45      11.94  21.727   <2e-16 ***
## bmi            323.05      27.53  11.735   <2e-16 ***
## smokeryes    23833.87     414.19  57.544   <2e-16 ***
## sexmale       -109.04     334.66  -0.326    0.745    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6094 on 1333 degrees of freedom
## Multiple R-squared:  0.7475, Adjusted R-squared:  0.7467 
## F-statistic: 986.5 on 4 and 1333 DF,  p-value: < 2.2e-16
#model4: charges ~ age, bmi, smoker, sex, children
  model4 <- lm(charges ~ age + smoker + bmi + children + sex, data=data)
  SSE4 <- sum(residuals(model4)^2)
  SSE4
## [1] 49072964053
  summary(model4)
## 
## Call:
## lm(formula = charges ~ age + smoker + bmi + children + sex, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11837.2  -2916.7   -994.2   1375.3  29565.5 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -12052.46     951.26 -12.670  < 2e-16 ***
## age            257.73      11.90  21.651  < 2e-16 ***
## smokeryes    23823.39     412.52  57.750  < 2e-16 ***
## bmi            322.36      27.42  11.757  < 2e-16 ***
## children       474.41     137.86   3.441 0.000597 ***
## sexmale       -128.64     333.36  -0.386 0.699641    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6070 on 1332 degrees of freedom
## Multiple R-squared:  0.7497, Adjusted R-squared:  0.7488 
## F-statistic:   798 on 5 and 1332 DF,  p-value: < 2.2e-16
#model5: charges ~ age, smoker, bmi, sex, children, region
  model5 <- lm(charges ~ age + smoker + bmi + sex + children + region, data=data)
  SSE5 <- sum(residuals(model5)^2)
  SSE5
## [1] 48839532844
  summary(model5)
## 
## Call:
## lm(formula = charges ~ age + smoker + bmi + sex + children + 
##     region, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11304.9  -2848.1   -982.1   1393.9  29992.8 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -11938.5      987.8 -12.086  < 2e-16 ***
## age                256.9       11.9  21.587  < 2e-16 ***
## smokeryes        23848.5      413.1  57.723  < 2e-16 ***
## bmi                339.2       28.6  11.860  < 2e-16 ***
## sexmale           -131.3      332.9  -0.394 0.693348    
## children           475.5      137.8   3.451 0.000577 ***
## regionnorthwest   -353.0      476.3  -0.741 0.458769    
## regionsoutheast  -1035.0      478.7  -2.162 0.030782 *  
## regionsouthwest   -960.0      477.9  -2.009 0.044765 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6062 on 1329 degrees of freedom
## Multiple R-squared:  0.7509, Adjusted R-squared:  0.7494 
## F-statistic: 500.8 on 8 and 1329 DF,  p-value: < 2.2e-16
data1 <- read.csv("TEST1.csv")

Prediction <- predict(model5, newdata=data1)

SSE <- sum((Prediction - data1$charges)^2)
SSE
## [1] 3387882001
SST <- sum((mean(data$charges) - data1$charges)^2)
SST
## [1] 18103088966
R2 <- 1 - SSE/SST
R2
## [1] 0.8128561

Από την αρχική διερεύνηση των δεδομένων παρατηρούμε: Smoker: Η πιο σημαντική μεταβλητή. Οι καπνιστές εμφανίζουν πολύ υψηλότερο κόστος ασφάλισης σε σχέση με τους μη καπνιστές. Αυτό επιβεβαιώνεται από τα μοντέλα πολλαπλής παλινδρόμησης. Age: Υπάρχει θετική συσχέτιση με το κόστος, καθώς μεγαλύτερης ηλικίας άτομα τείνουν να έχουν μεγαλύτερες ανάγκες υγειονομικής περίθαλψης. BMI: Η επίδρασή του είναι πιο ήπια από τον smoker, αλλά μπορεί να ενισχύσει το μοντέλο όταν συνδυάζεται με smoker. Children: Έχει μικρή αλλά θετική επίδραση στα charges. Sex και Region: Οι επιδράσεις είναι πολύ μικρές ή μη στατιστικά σημαντικές σύμφωνα με τα R-squared. Ανάλυση των μοντέλων. Μοντέλο 1 (charges ~ age): R-squared είναι σχετικά χαμηλό (~0.14), δείχνοντας ότι μόνο η ηλικία δεν εξηγεί επαρκώς τη διασπορά των charges. Μοντέλο 2 (charges ~ age + bmi + smoker): Προσθήκη του BMI και του smoker βελτιώνει πολύ το R-squared, μειώνει το SSE. Το smoker κυριαρχεί στην εξήγηση του κόστους, ενώ το BMI προσθέτει μικρή επιπλέον πληροφορία. Μοντέλα 3,4,5: Η προσθήκη sex, children και region αυξάνει ελαφρώς το R-squared και μειώνει το SSE. Συμπέρασμα: Τα charges επηρεάζονται κυρίως από smoker, age, και bmi. Η πρόβλεψη στο νέο dataset με το μοντέλο 5 έδωσε υψηλό R-squared, επιβεβαιώνοντας την ικανότητα γενίκευσης του μοντέλου.