Θεμα 1: Κόστος ιατροφαρμακευτικής ασφάλισης - Γραμμική Παλινδρόμηση
Athanasios tratselas
2026-08-26
Επιλογή Μεθόδου & Στόχος Ανάλυσης
Η εξαρτημένη μεταβλητή charges (ετήσιο κόστος ασφάλισης)
είναι συνεχής αριθμητική άρα αποκλείονται εξ ορισμού η
λογιστική παλινδρόμηση και μέθοδοι ταξινόμησης. Επιπλέον, η εταιρεία δεν
θέλει μόνο πρόβλεψη αλλά και ποσοτική εξήγηση της
επίδρασης κάθε χαρακτηριστικού σε ευρώ — κάτι που παρέχεται άμεσα και
καθαρά μόνο από τους συντελεστές μιας γραμμικής
παλινδρόμησης.
Επιλογή μεθόδου:Γραμμική Παλινδρόμηση, με προσθήκη όρου αλληλεπίδρασης BMI × Καπνιστής για να ελεγχθεί το ερώτημα 4.
Διερεύνηση & Προετοιμασία Δεδομένων
library(tidyverse)
library(knitr)
set.seed(42)
# --- Φόρτωση δεδομένων ---
df <- read.csv("insurance.csv", stringsAsFactors = FALSE)
target_var <- "charges"
exclude_cols <- c()
if (length(exclude_cols) > 0) df <- df[, !(names(df) %in% exclude_cols), drop = FALSE]
df[] <- lapply(df, function(x) if (is.character(x)) as.factor(x) else x)
df <- na.omit(df)
str(df)## 'data.frame': 1338 obs. of 7 variables:
## $ age : int 19 18 28 33 32 31 46 37 37 60 ...
## $ sex : Factor w/ 2 levels "female","male": 1 2 2 2 2 1 1 1 2 1 ...
## $ bmi : num 27.9 33.8 33 22.7 28.9 ...
## $ children: int 0 1 3 0 0 0 1 3 2 0 ...
## $ smoker : Factor w/ 2 levels "no","yes": 2 1 1 1 1 1 1 1 1 1 ...
## $ region : Factor w/ 4 levels "northeast","northwest",..: 4 3 3 2 2 3 3 2 1 2 ...
## $ charges : num 16885 1726 4449 21984 3867 ...summary(df)## age sex bmi children smoker
## Min. :18.00 female:662 Min. :15.96 Min. :0.000 no :1064
## 1st Qu.:27.00 male :676 1st Qu.:26.30 1st Qu.:0.000 yes: 274
## Median :39.00 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
## region charges
## northeast:324 Min. : 1122
## northwest:325 1st Qu.: 4740
## southeast:364 Median : 9382
## southwest:325 Mean :13270
## 3rd Qu.:16640
## Max. :63770Το dataset περιέχει 1338 πελάτες, χωρίς ελλείπουσες τιμές. Οι
κατηγορικές μεταβλητές (sex, smoker,
region) μετατράπηκαν σε factors ώστε να κωδικοποιηθούν
αυτόματα ως μεταβλητές μέσα στο μοντέλο.
Κατανομή της εξαρτημένης μεταβλητής
ggplot(df, aes(x = .data[[target_var]])) +
geom_histogram(bins = 30, fill = "#1f4e79", color = "white") +
labs(title = paste("Κατανομή της", target_var), x = target_var, y = "Συχνότητα") +
theme_minimal()
charges_mean <- mean(df$charges)
charges_median <- median(df$charges)Κόστος ανά Κατηγορία Καπνιστή
ggplot(df, aes(x = smoker, y = charges, fill = smoker)) +
geom_boxplot(alpha = 0.8) +
scale_fill_manual(values = c("#2f855a", "#a23a3a")) +
labs(title = "Κόστος Ασφάλισης ανά Κατηγορία Καπνιστή", x = "Καπνιστής", y = "Κόστος (€)") +
theme_minimal() + theme(legend.position = "none")
Η διαφορά ανάμεσα σε καπνιστές και μη είναι οπτικά πολύ έντονη —
αναμένουμε το smoker να είναι ο ισχυρότερος μεμονωμένος
παράγοντας στο μοντέλο.
Πίνακας Συσχετίσεων (αριθμητικές μεταβλητές)
numeric_cols <- names(df)[sapply(df, is.numeric)]
cor_matrix <- round(cor(df[, numeric_cols], use = "complete.obs"), 3)
target_cors <- sort(abs(cor_matrix[target_var, ]), decreasing = TRUE)
best_predictor <- names(target_cors)[2]
kable(cor_matrix, caption = "Πίνακας συσχετίσεων (αριθμητικές μεταβλητές)")| age | bmi | children | charges | |
|---|---|---|---|---|
| age | 1.000 | 0.109 | 0.042 | 0.299 |
| bmi | 0.109 | 1.000 | 0.013 | 0.198 |
| children | 0.042 | 0.013 | 1.000 | 0.068 |
| charges | 0.299 | 0.198 | 0.068 | 1.000 |
Από τις αριθμητικές μεταβλητές, η ισχυρότερη γραμμική συσχέτιση με τη
charges είναι της age (0.299). Είναι αναμενόμενα
ασθενέστερη από την επίδραση του smoker, που όμως είναι
κατηγορική και δεν εμφανίζεται στον πίνακα συσχετίσεων.
Δημιουργία & Αξιολόγηση Μοντέλου
Γραμμική Παλινδρόμηση
formula_full <- as.formula(paste(target_var, "~ ."))
model2 <- lm(formula_full, data = df)
summary(model2)##
## Call:
## lm(formula = formula_full, data = df)
##
## 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 < 0.0000000000000002 ***
## age 256.9 11.9 21.587 < 0.0000000000000002 ***
## sexmale -131.3 332.9 -0.394 0.693348
## bmi 339.2 28.6 11.860 < 0.0000000000000002 ***
## children 475.5 137.8 3.451 0.000577 ***
## smokeryes 23848.5 413.1 57.723 < 0.0000000000000002 ***
## 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: < 0.00000000000000022SSE2 <- sum(model2$residuals^2)Με όλες τις μεταβλητές, το R² = 0.751 . Ο συντελεστής του
smokeryes είναι κατά πολύ ο μεγαλύτερος σε απόλυτη τιμή,
επιβεβαιώνοντας την υπόθεση από το boxplot.
Επιλογή Μεταβλητών με Backward Elimination
Ξεκινάμε από το πλήρες μοντέλο και αφαιρούμε επαναληπτικά τη μεταβλητή με το μεγαλύτερο p-value , μέχρι να μείνουν μόνο στατιστικά σημαντικές μεταβλητές (p < 0.05).
current_model <- model2
removal_log <- character(0)
repeat {
d <- drop1(current_model, test = "F")
d <- d[-1, , drop = FALSE] # αφαιρούμε τη γραμμή <none>
if (nrow(d) == 0) break
worst_p <- max(d[["Pr(>F)"]], na.rm = TRUE)
if (is.na(worst_p) || worst_p < 0.05) break
worst_term <- rownames(d)[which.max(d[["Pr(>F)"]])]
removal_log <- c(removal_log, sprintf("Αφαιρέθηκε `%s` (p-value = %.4f)", worst_term, worst_p))
current_model <- update(current_model, paste("~ . -", worst_term))
}
model3 <- current_model
summary(model3)##
## Call:
## lm(formula = charges ~ age + bmi + children + smoker, data = df)
##
## 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 < 0.0000000000000002 ***
## age 257.85 11.90 21.675 < 0.0000000000000002 ***
## bmi 321.85 27.38 11.756 < 0.0000000000000002 ***
## children 473.50 137.79 3.436 0.000608 ***
## smokeryes 23811.40 411.22 57.904 < 0.0000000000000002 ***
## ---
## 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: < 0.00000000000000022SSE3 <- sum(model3$residuals^2)Αφαιρέθηκε sex (p-value = 0.6933)· Αφαιρέθηκε
region (p-value = 0.0963). Το τελικό μοντέλο κρατά τις
μεταβλητές age, bmi, children, smoker, με R² = 0.75 και Adjusted R² =
0.749 — πρακτικά ίδιο με το πλήρες μοντέλο, δηλαδή οι μεταβλητές που
αφαιρέθηκαν δεν συνέβαλλαν ουσιαστικά.
Μοντέλο με Αλληλεπίδραση BMI × Καπνιστής
Για να ελέγξουμε αν η επίδραση του BMI στο κόστος διαφέρει ανάμεσα σε
καπνιστές και μη (ερώτημα 4), προσθέτουμε έναν όρο αλληλεπίδρασης
bmi:smoker στο πλήρες μοντέλο.
model4 <- lm(charges ~ . + bmi:smoker, data = df)
summary(model4)##
## Call:
## lm(formula = charges ~ . + bmi:smoker, data = df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -14580.7 -1857.2 -1360.8 -475.7 30552.4
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2223.454 865.611 -2.569 0.01032 *
## age 263.620 9.516 27.703 < 0.0000000000000002 ***
## sexmale -500.146 266.518 -1.877 0.06079 .
## bmi 23.533 25.601 0.919 0.35814
## children 516.403 110.179 4.687 0.00000306 ***
## smokeryes -20415.611 1648.277 -12.386 < 0.0000000000000002 ***
## regionnorthwest -585.478 380.859 -1.537 0.12447
## regionsoutheast -1210.131 382.750 -3.162 0.00160 **
## regionsouthwest -1231.108 382.218 -3.221 0.00131 **
## bmi:smokeryes 1443.096 52.647 27.411 < 0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4846 on 1328 degrees of freedom
## Multiple R-squared: 0.8409, Adjusted R-squared: 0.8398
## F-statistic: 780 on 9 and 1328 DF, p-value: < 0.00000000000000022SSE4 <- sum(model4$residuals^2)
interaction_coef <- coef(model4)["bmi:smokeryes"]
interaction_p <- summary(model4)$coefficients["bmi:smokeryes", "Pr(>|t|)"]Ο συντελεστής της αλληλεπίδρασης bmi:smokeryes είναι
1443.1 με p-value = <0.0000000000000002. Το μοντέλο με αλληλεπίδραση
έχει R² = 0.841 (Adjusted R² = 0.84), βελτιωμένο σε σχέση με το μοντέλο
χωρίς αλληλεπίδραση.
Σύγκριση Μοντέλων
comparison <- data.frame(
Model = c("Πλήρες (όλες)", "Backward Elimination (βέλτιστο)", "Με αλληλεπίδραση BMI×Smoker"),
SSE = round(c(SSE2, SSE3, SSE4), 0),
R_Squared = round(c(summary(model2)$r.squared,
summary(model3)$r.squared, summary(model4)$r.squared), 4),
Adjusted_R_Squared = round(c(summary(model2)$adj.r.squared,
summary(model3)$adj.r.squared, summary(model4)$adj.r.squared), 4)
)
kable(comparison, caption = "Σύγκριση μοντέλων γραμμικής παλινδρόμησης")| Model | SSE | R_Squared | Adjusted_R_Squared |
|---|---|---|---|
| Πλήρες (όλες) | 48839532844 | 0.7509 | 0.7494 |
| Backward Elimination (βέλτιστο) | 49078450117 | 0.7497 | 0.7489 |
| Με αλληλεπίδραση BMI×Smoker | 31191880482 | 0.8409 | 0.8398 |
final_model <- if (interaction_p < 0.05) model4 else model3
final_model_name <- if (interaction_p < 0.05) "το μοντέλο με αλληλεπίδραση BMI×Smoker" else "το μοντέλο μετά το backward elimination"Επιλέγουμε ως τελικό μοντέλο το μοντέλο με αλληλεπίδραση BMI×Smoker, καθώς η αλληλεπίδραση είναι στατιστικά σημαντική και βελτιώνει το Adjusted R².
Απαντήσεις στις Διερευνητικές Ερωτήσεις
1. Επίδραση της ηλικίας (σε €)
age_coef <- coef(model3)["age"]Κάθε επιπλέον έτος ηλικίας αυξάνει το αναμενόμενο ετήσιο κόστος κατά 257.85€, με τις υπόλοιπες μεταβλητές σταθερές.
2. Διαφορά κόστους καπνιστή vs μη καπνιστή (σε €, κατά μέσο όρο)
smoker_coef <- coef(model3)["smokeryes"]Ένας καπνιστής πληρώνει κατά μέσο όρο 23811€
περισσότερο ετησίως από έναν μη καπνιστή με ίδια λοιπά χαρακτηριστικά
(συντελεστής smokeryes από το μοντέλο μετά το backward
elimination, χωρίς αλληλεπίδραση — αυτή είναι η “μέση” διαφορά
ανεξαρτήτως BMI).
3. Ποσοστό εξηγούμενης μεταβλητότητας
Το μοντέλο μετά το backward elimination (χωρίς αλληλεπίδραση) εξηγεί το 75% της μεταβλητότητας του κόστους (R² = 0.75). Όπως όμως δείχνει το επόμενο ερώτημα, η αλληλεπίδραση BMI×Smoker είναι στατιστικά πολύ σημαντική· προσθέτοντάς την, το τελικό μοντέλο εξηγεί 84.1% της μεταβλητότητας (R² = 0.841, Adjusted R² = 0.84) — αυτή είναι η πιο ακριβής απάντηση στο ερώτημα.
4. Αλληλεπίδραση BMI × Καπνιστής
Ο συντελεστής αλληλεπίδρασης bmi:smokeryes = 1443.1
(p-value = <0.0000000000000002) είναι στατιστικά σημαντικός (p <
0.05), άρα ναι, υπάρχει ένδειξη αλληλεπίδρασης. Ο
θετικός συντελεστής σημαίνει ότι κάθε μονάδα αύξησης του BMI αυξάνει το
κόστος κατά 23.53€ για μη καπνιστές, αλλά κατά 1466.63€ (δηλ. πολύ
περισσότερο) για καπνιστές — το BMI ‘κοστίζει’ πολύ ακριβότερα σε
συνδυασμό με το κάπνισμα.
ggplot(df, aes(x = bmi, y = charges, color = smoker)) +
geom_point(alpha = 0.4) +
geom_smooth(method = "lm", se = FALSE) +
scale_color_manual(values = c("#2f855a", "#a23a3a")) +
labs(title = "Αλληλεπίδραση BMI × Καπνιστής στο Κόστος", x = "BMI", y = "Κόστος (€)") +
theme_minimal()
Το γράφημα δείχνει καθαρά δύο διαφορετικές κλίσεις: για τους καπνιστές, το κόστος αυξάνεται πολύ πιο απότομα με το BMI απ’ ό,τι για τους μη καπνιστές.
5. Πρόβλεψη για συγκεκριμένο πελάτη
mode_sex <- names(which.max(table(df$sex)))
mode_region <- names(which.max(table(df$region)))
new_customer <- data.frame(
age = 45, sex = mode_sex, bmi = 28, children = 2,
smoker = "no", region = mode_region
)
pred_q5 <- predict(final_model, newdata = new_customer, interval = "prediction", level = 0.95)
pred_q5## fit lwr upr
## 1 9620.906 88.67301 19153.14Για έναν 45χρονο μη καπνιστή με BMI 28 και 2 παιδιά (παραδοχή: sex = male, region = southeast), το μοντέλο προβλέπει ετήσιο κόστος 9621€ (95% διάστημα πρόβλεψης: [89€, 19153€]).
Συμπεράσματα
Επέλεξα γραμμική παλινδρόμηση επειδή η
charges είναι συνεχής και ζητείτε ρητά ποσοτική ερμηνεία
κάθε παράγοντα σε €. Τα ευρήματα:
- Κάθε έτος ηλικίας προσθέτει ~258€ στο ετήσιο κόστος.
- Το κάπνισμα είναι ο ισχυρότερος παράγοντας, προσθέτοντας ~23811€ κατά μέσο όρο.
- Το τελικό μοντέλο εξηγεί το 84.1% της μεταβλητότητας του κόστους.
- Υπάρχει σημαντική αλληλεπίδραση BMI×Smoker — το BMI κοστίζει πολύ περισσότερο στους καπνιστές.
- Για τον συγκεκριμένο πελάτη (45, μη καπνιστής, BMI 28, 2 παιδιά) η πρόβλεψη είναι ~9621€ ετησίως.