iis22171
Aikaterini Styliani Zacharopoulou
2026-07-01
#Θέμα 1ο - Κόστος ιατροφαρμακευτικής ασφάλισης
#Ποια μέθοδο θα επιλέξετε με βάση τα παραπάνω; Η μέθοδος, που θα χρησιμοποιηθεί είναι η “Γραμμική Παλινδρόμηση”.
1.Διερεύνηση του συνόλου δεδομένων (dataset)
Περιγραφή του dataset και της πηγής του
Το σύνολο δεδομένων που αναλύεται είναι το Medical Cost Personal — kaggle.com/datasets/mirichoi0218/insurance , το οποίο αντλήθηκε από την πλατφόρμα Kaggle.
Δεδομένα 1.338 ατόμων: ηλικία, φύλο, BMI, αριθμός παιδιών, κάπνισμα, περιοχή.
Eπιχειρηματικά ερωτήματα, που θα μπορούσαν να απαντηθούν
- Πόσο μεταβάλλεται (σε €) το αναμενόμενο ετήσιο κόστος για κάθε επιπλέον έτος ηλικίας, κρατώντας τα υπόλοιπα σταθερά;
- Πόσο ακριβότερο είναι, κατά μέσο όρο, ένα συμβόλαιο καπνιστή έναντι μη καπνιστή με ίδια λοιπά χαρακτηριστικά;
- Ποιο ποσοστό της μεταβλητότητας του κόστους εξηγείται από τα διαθέσιμα χαρακτηριστικά;
- Υπάρχει ένδειξη ότι η επίδραση του BMI στο κόστος είναι διαφορετική για καπνιστές και μη (αλληλεπίδραση);
- Να προβλεψετε το κόστος για έναν 45χρονο μη καπνιστή, BMI 28, με 2 παιδιά.
##* Φόρτωση Δεδομένων*
# Φόρτωση των δεδομένων
ins_data <- read.csv("insurance.csv", stringsAsFactors = TRUE)
# Έλεγχος των πρώτων γραμμών για να δούμε αν φορτώθηκαν σωστά
head(ins_data)## age sex bmi children smoker region charges
## 1 19 female 27.900 0 yes southwest 16884.924
## 2 18 male 33.770 1 no southeast 1725.552
## 3 28 male 33.000 3 no southeast 4449.462
## 4 33 male 22.705 0 no northwest 21984.471
## 5 32 male 28.880 0 no northwest 3866.855
## 6 31 female 25.740 0 no southeast 3756.622##* Διαχωρισμός dataset σε train και test*
# Καθορισμός σταθεράς
set.seed(71)
# Δημιουργία δείκτη για το 65% των δεδομένων
index <- sample(1:nrow(ins_data), 0.65 * nrow(ins_data))
# Χωρισμός σε Train (65%) και Test (35%)
train_set <- ins_data[index, ]
test_set <- ins_data[-index, ]
str(train_set) ## 'data.frame': 869 obs. of 7 variables:
## $ age : int 26 31 33 23 56 42 33 26 52 38 ...
## $ sex : Factor w/ 2 levels "female","male": 2 2 2 2 1 1 1 2 2 2 ...
## $ bmi : num 35.4 38.4 42.4 41.9 35.8 ...
## $ children: int 0 2 5 0 1 1 2 1 1 3 ...
## $ smoker : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 2 1 1 1 ...
## $ region : Factor w/ 4 levels "northeast","northwest",..: 3 3 4 3 4 4 1 4 4 3 ...
## $ charges : num 2323 4463 6666 1837 11674 ...summary(train_set) ## age sex bmi children smoker
## Min. :18.00 female:435 Min. :16.82 Min. :0.000 no :692
## 1st Qu.:27.00 male :434 1st Qu.:26.12 1st Qu.:0.000 yes:177
## Median :39.00 Median :30.21 Median :1.000
## Mean :39.19 Mean :30.44 Mean :1.113
## 3rd Qu.:51.00 3rd Qu.:34.32 3rd Qu.:2.000
## Max. :64.00 Max. :47.60 Max. :5.000
## region charges
## northeast:218 Min. : 1122
## northwest:223 1st Qu.: 4686
## southeast:227 Median : 9305
## southwest:201 Mean :13084
## 3rd Qu.:16233
## Max. :62593# Δημιουργία model1
model1 <- lm(charges ~ age, data = train_set)
summary(model1)##
## Call:
## lm(formula = charges ~ age, data = train_set)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7876 -6484 -5683 5611 48038
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3161.19 1134.08 2.787 0.00543 **
## age 253.19 27.24 9.295 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11280 on 867 degrees of freedom
## Multiple R-squared: 0.09062, Adjusted R-squared: 0.08957
## F-statistic: 86.4 on 1 and 867 DF, p-value: < 2.2e-16# Υπολογισμός SSE
SSE_train <- sum(model1$residuals^2)
print(paste("SSE στο Training Set:", round(SSE_train, 2)))## [1] "SSE στο Training Set: 110387384459.19"# Υπολογισμός RMSE
RMSE_train <- sqrt(SSE_train / nrow(train_set))
print(paste("RMSE στο Training Set:", round(RMSE_train, 2)))## [1] "RMSE στο Training Set: 11270.67"# Δημιουργία διαγράμματος διασποράς με τη γραμμή παλινδρόμησης
library(ggplot2)
ggplot(train_set, aes(x = age, y = charges)) +
geom_point(alpha = 0.5, color = "darkblue") +
geom_abline(intercept = coef(model1)[1],
slope = coef(model1)[2],
color = "red",
linewidth = 1) +
labs(title = "Γραμμή Παλινδρόμησης: charges vs age",
x = "ηλικία",
y = "κόστος") +
theme_minimal()
# Δημιουργία model2
model2 <- lm(charges ~ age + bmi + children, data = train_set) #
summary(model2)##
## Call:
## lm(formula = charges ~ age + bmi + children, data = train_set)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10919 -6654 -5241 6921 48572
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3960.43 2142.59 -1.848 0.064881 .
## age 237.34 27.33 8.685 < 2e-16 ***
## bmi 240.47 64.42 3.733 0.000202 ***
## children 380.50 313.81 1.213 0.225637
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11200 on 865 degrees of freedom
## Multiple R-squared: 0.1068, Adjusted R-squared: 0.1037
## F-statistic: 34.48 on 3 and 865 DF, p-value: < 2.2e-16# Υπολογισμός SSE
SSE_train_2 <- sum(model2$residuals^2) #
print(paste("SSE Model 2 (Train):", round(SSE_train_2, 2)))## [1] "SSE Model 2 (Train): 108422700891.09"# 4. Υπολογισμός RMSE
RMSE_train_2 <- sqrt(SSE_train_2 / nrow(train_set))
print(paste("RMSE Model 2 (Train):", round(RMSE_train_2, 2)))## [1] "RMSE Model 2 (Train): 11169.92"# Σύγκριση Adjusted R-squared
adj_r1 <- summary(model1)$adj.r.squared
adj_r2 <- summary(model2)$adj.r.squared
print(paste("Adjusted R-squared Model 1:", round(adj_r1, 4)))## [1] "Adjusted R-squared Model 1: 0.0896"# Δημιουργία model3
model3 <- lm(charges ~ age + bmi + children + sex + smoker, data = train_set) #
summary(model3)##
## Call:
## lm(formula = charges ~ age + bmi + children + sex + smoker, data = train_set)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12107.2 -2665.3 -1054.6 982.1 29718.5
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -11261.82 1180.24 -9.542 < 2e-16 ***
## age 268.79 14.80 18.165 < 2e-16 ***
## bmi 277.12 34.86 7.949 5.87e-15 ***
## children 434.68 169.74 2.561 0.0106 *
## sexmale 273.25 411.83 0.664 0.5072
## smokeryes 23353.95 511.81 45.630 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6055 on 863 degrees of freedom
## Multiple R-squared: 0.7394, Adjusted R-squared: 0.7378
## F-statistic: 489.6 on 5 and 863 DF, p-value: < 2.2e-16# Υπολογισμός SSE
SSE_train_3 <- sum(model3$residuals^2) #
print(paste("SSE Model 3 (Train):", round(SSE_train_3, 2)))## [1] "SSE Model 3 (Train): 31638682290.02"# 4. Υπολογισμός RMSE
RMSE_train_3 <- sqrt(SSE_train_3 / nrow(train_set))
print(paste("RMSE Model 3 (Train):", round(RMSE_train_3, 2)))## [1] "RMSE Model 3 (Train): 6033.92"Συμπεράσματα
Παρατηρούμε ότι η μεταβλητή, που επηρεάζει το κόστος είναι η ηλικία. Παρατηρούμε ότι το SSE του model2 είναι μικρότερο του SSE του model1, που σημαίνει ότι βελτιώθηκε το μοντέλο και πλέον είναι πιο προσαρμοσμένο στα δεδομένα με την προσθήκη των επιπλέον μεταβλητών. Στην περίπτωση όμως του model3 παρατηρούμε ότι υπάρχει αύξηση του SSE και αυτό δείχνει ότι η προσθήκη και της μεταβλητής smoker δυσχεραίνει το μοντέλο και γίνεται αντιληπτό ότι το επηρεάζει, οπότε θα επικεντρωθούμε στο μοντέλο 2. Παρατηρούμε επίσης ότι το Multiple R-squared του model2 είναι υψηλότερο από αυτό του model1, γεγονός που υποδηλώνει ότι το δεύτερο μοντέλο εξηγεί μεγαλύτερο ποσοστό της διακύμανσης των δεδομένων.
3.Εφαρμογή σε νέο σύνολο δεδομένων - Πρόβλεψη
Σε αυτό το βήμα χρησιμοποιούμε το test_set, δηλαδή το 35% των δεδομένων, ώστε να δοκιμάσουμε το model2, για να δούμε τις διαφορές, που υπάρχουν σε σχέση με το training set.
Predictions_test <- predict(model2, newdata = test_set)
# Υπολογισμός SSE
# Μετράμε τη διαφορά μεταξύ πραγματικών τιμών και προβλέψεων
SSE_test <- sum((test_set$charges - Predictions_test)^2)
# Υπολογισμός SST (Total Sum of Squares)
# Η διακύμανση των πραγματικών τιμών σε σχέση με τον μέσο όρο του training set
SST_test <- sum((test_set$charges - mean(train_set$charges))^2)
# Υπολογισμός out-of-sample R-squared
R2_test <- 1 - (SSE_test / SST_test)
# Υπολογισμός RMSE (Root-Mean-Square Error)
# Ο δείκτης αυτός δηλώνει τον μέσο όρο σφάλματος σε ευρώ
RMSE_test <- sqrt(SSE_test / nrow(test_set))
# Εμφάνιση αποτελεσμάτων
print(paste("R-squared στο Test Set:", round(R2_test, 4)))## [1] "R-squared στο Test Set: 0.1355"print(paste("Μέσο σφάλμα (RMSE) στο Test Set:", round(RMSE_test, 2)))## [1] "Μέσο σφάλμα (RMSE) στο Test Set: 11737.05"Predictions_test <- predict(model3, newdata = test_set)
# Υπολογισμός SSE
# Μετράμε τη διαφορά μεταξύ πραγματικών τιμών και προβλέψεων
SSE_test <- sum((test_set$charges - Predictions_test)^2)
# Υπολογισμός SST (Total Sum of Squares)
# Η διακύμανση των πραγματικών τιμών σε σχέση με τον μέσο όρο του training set
SST_test <- sum((test_set$charges - mean(train_set$charges))^2)
# Υπολογισμός out-of-sample R-squared
R3_test <- 1 - (SSE_test / SST_test)
# Υπολογισμός RMSE (Root-Mean-Square Error)
# Ο δείκτης αυτός δηλώνει τον μέσο όρο σφάλματος σε ευρώ
RMSE_test <- sqrt(SSE_test / nrow(test_set))
# Εμφάνιση αποτελεσμάτων
print(paste("R-squared στο Test Set:", round(R2_test, 4)))## [1] "R-squared στο Test Set: 0.1355"print(paste("Μέσο σφάλμα (RMSE) στο Test Set:", round(RMSE_test, 2)))## [1] "Μέσο σφάλμα (RMSE) στο Test Set: 6136.28"4.Παραδείγματα
# Δημιουργία παραδειγμάτων
# Έναν 45χρονο, BMI 28, με 2 παιδιά
# Και ένας Έναν 25χρονο, BMI 28, με 2 παιδιά
new_people <- data.frame(
age = c(45, 25),
bmi = c(28, 28),
children = c(2, 2)
)
row.names(new_people) <- c("45χρονος", "25χρονος")
# Πρόβλεψη
final_predictions <- predict(model2, newdata = new_people)
# Εμφάνιση των προβλέψεων
print("Προβλεπόμενο Κόστος:")## [1] "Προβλεπόμενο Κόστος:"print(round(final_predictions, 2))## 45χρονος 25χρονος
## 14214.34 9467.47Παρατηρούμε ότι για τον 45χρονο το κόστος ασφάλισης είναι μεγαλύτερο από ότι για τον 25χρονο με μόνη διαφορά τους την ηλίκια τους, πράγμα, που δείχνει ότι πράγματι ο σημαντικότερος παράγοντας για το πόσο θα κοστίσει η ασφάλιση αποτελεί η ηλικία.
#```{r step-4b} # Δημιουργία παραδειγμάτων # Έναν 45χρονο μη καπνιστή, BMI 28, με 2 παιδιά # Και ένας Έναν 45χρονο καπνιστή, BMI 28, με 2 παιδιά #new_people <- data.frame( # age = c(45, 45), # bmi = c(28, 28), # children = c(2, 2), # smoker = c(1, 2) #) #row.names(new_people) <- c(“μη καπνιστής”, “καπνιστής”)
Πρόβλεψη
#final_predictions <- predict(model3, newdata = new_people)
Εμφάνιση των προβλέψεων
#print(“Προβλεπόμενο Κόστος:”) #print(round(final_predictions, 2)) ```
Από τα προηγούμενα δεδομένα γίνεται αντιληπτό ότι ο μη καπνιστής θα έχει μικρότερο κόστος ασφάλισης.