Διερεύνηση του Dataset

Αρχική Παρουσίαση & Σχολιασμός

Το dataset που επιλέχθηκε προέρχεται από τον Παγκόσμιο Οργανισμό Υγείας (WHO) και παρακολουθεί το προσδόκιμο ζωής σε 193 χώρες. Περιλαμβάνει δεδομένα που συνδυάζουν την υγεία με την οικονομική και κοινωνική ανάπτυξη.

Μεταβλητές ανά Θεματική Περιοχή

📈 Υγεία & Θνησιμότητα

  • Adult Mortality: Πιθανότητα θανάτου ενηλίκων ανά 1000 άτομα.
  • Infant Deaths: Αριθμός θανάτων βρεφών ανά 1000 άτομα.
  • HIV/AIDS: Θάνατοι ανά 1000 γεννήσεις (ηλικίες 0-4).
  • BMI: Μέσος Δείκτης Μάζας Σώματος του πληθυσμού.

💉 Πρόληψη & Εμβολιασμοί

  • Hepatitis B: Εμβολιαστική κάλυψη σε παιδιά 1 έτους (%).
  • Polio: Εμβολιαστική κάλυψη σε παιδιά 1 έτους (%).
  • Diphtheria: Εμβολιαστική κάλυψη (DTP3) σε παιδιά 1 έτους (%).

💰 Οικονομικοί Δείκτες

  • GDP: Ακαθάριστο Εγχώριο Προϊόν ανά κάτοικο (σε USD).
  • Percentage Expenditure: Δαπάνες για την υγεία ως % του ΑΕΠ.
  • Total Expenditure: Γενικές κυβερνητικές δαπάνες για την υγεία.

🎓 Κοινωνικοί Παράγοντες

  • Schooling: Αριθμός ετών εκπαίδευσης.
  • Alcohol: Κατανάλωση αλκοόλ ανά κάτοικο (λίτρα καθαρού αλκοόλ).
  • Status: Κατάταξη χώρας ως “Developed” (Αναπτυγμένη) ή “Developing” (Αναπτυσσόμενη).

Διαδραστική Προβολή Δεδομένων

Μπορείτε να περιηγηθείτε στις πρώτες γραμμές του καθαρισμένου dataset παρακάτω:

# Εμφάνιση πίνακα με σελίδες και αναζήτηση
rmarkdown::paged_table(df)
Ανάλυση Σχέσεων & Διαγράμματα


Note:

Κύριο στοιχείο γύρω από το οποίο στοχεύουμε να προσανατολίσουμε την ανάλυσή μας, είναι η θνησιμότητα ενηλίκων (adult_mortality), καθώς και οι παράγοντες που είναι καθορσιτικής σημασίας για αυτή ή φαίνεται να συσχετίζονται με αυτή.


Visualization 1 - Κατανομή Προσδοκίμου Ζωής

Σε πρώτη ανάλυση, για στατιστικούς λόγους είναι χρήσιμο να δούμε την κατανομή των διάφορων τιμών των προσδοκίμων ζωής των χωρών.

ggplot(df, aes(x = life_expectancy)) +
  # Το bins=25 ορίζει πόσες "μπάρες" θα έχει το γράφημα
  geom_histogram(fill = health_blue, color = "white", bins = 25) +
  labs(
    title = "Παγκόσμια Κατανομή Προσδοκίμου Ζωής",
    x = "Έτη Ζωής (Life Expectancy)",
    y = "Συχνότητα (Αριθμός Χωρών)"
  )

Το ιστόγραμμα παρουσιάζει μια έντονη αριστερή ασυμμετρία, με την πλειοψηφία των χωρών να συγκεντρώνεται σε υψηλά επίπεδα προσδοκίμου ζωής, κυρίως μεταξύ 72 και 75 ετών. Η μακρά “ουρά” προς τα αριστερά αποκαλύπτει τις έντονες παγκόσμιες ανισότητες, αναδεικνύοντας τις χώρες που υστερούν σημαντικά με προσδόκιμο κάτω των 50 ετών. Η κορυφή (mode) του διαγράμματος επιβεβαιώνει ότι, παρά τις αποκλίσεις, η παγκόσμια τάση κλίνει σαφώς προς τη μακροζωία.


Visualization 2 - Θνησιμότητα / Προσδόκιμο Ζωής

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

ggplot(df, aes(x = adult_mortality, y = life_expectancy)) +
  geom_point(alpha = 0.4, color = health_blue2, size = 2) +
  labs(
    title = "Life Expectancy vs Adult Mortality",
    x = "Adult Mortality",
    y = "Life Expectancy"
  )

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


Vizualization 3 - Κατάσταση Χώρας / Προσδόκιμο Ζωής

Σε επόμενη φάση, αρκετά ενδιαφέρον για ερευνητικούς σκοπούς θα είναι να εξετάσουμε την κατανομή των τιμών προσδοκίμου ζωής με βάση το αναπτυξιακό επίπεδο των χωρών (αναπτυγμένες ή αναπτυσσόμενες)

ggplot(df, aes(x = status, y = life_expectancy, fill = status)) +
  geom_boxplot(alpha = 0.7) +
  scale_fill_manual(values = c(health_blue, health_blue2)) +
  labs(title = "Προσδόκιμο Ζωής ανά Κατάσταση Χώρας")

Οι αναπτυγμένες χώρες παρουσιάζουν πολύ υψηλότερη διάμεσο (κοντά στα 80 έτη) και πολύ μικρότερη διασπορά, γεγονός που υποδηλώνει σταθερότητα και ομοιογένεια στις συνθήκες διαβίωσης. Αντίθετα, στις αναπτυσσόμενες χώρες η διάμεσος είναι αισθητά χαμηλότερη (περίπου 69 έτη), με το εύρος των τιμών να είναι πολύ μεγαλύτερο, αντικατοπτρίζοντας τις έντονες κοινωνικοοικονομικές ανισότητες μεταξύ τους. Ιδιαίτερο ενδιαφέρον παρουσιάζουν οι ακραίες τιμές (outliers) στις αναπτυσσόμενες χώρες, όπου το προσδόκιμο πέφτει ακόμα και κάτω από τα 40-45 έτη, υποδεικνύοντας κρίσιμα προβλήματα σε συγκεκριμένες περιοχές. Επομένως, η αναπτυξιακή κατάσταση της χώρας (Status) φαίνεται να αποτελεί καθοριστικό προγνωστικό παράγοντα για τη μακροζωία του πληθυσμού.


Vizualization 4 - Διαχρονική Εξέλιξη Προσδοκίμου Ζωής

Για στατιστικούς λόγους και προκειμένου να διαπιστώσουμε εάν η επιστημονική πρόοδος και καινοτομία έχει πράγματι συνεπικουρήσει στην άνοδο του προσδοκίμου ζωής, αλλά και κατά πόσο αυτή η συνεισφορά είναι διακριτή όχι μόνο στις αναπτυγμένες αλλά και τις αναπτυσσόμενες χώρες, μπορούμε να απεικονίσουμε διαγραμματικά και την εξέλιξη των καμπυλών προσδοκίμου ζωής ανά αναπτυξιακό επίπεδο.

df_trend <- df %>% 
  group_by(year, status) %>% 
  summarise(mean_life = mean(life_expectancy))

ggplot(df_trend, aes(x = year, y = mean_life, color = status)) +
  geom_line(linewidth = 1.2) +
  geom_point() +
  scale_color_manual(values = c(health_blue, health_blue2)) +
  labs(title = "Διαχρονική Εξέλιξη Προσδοκίμου Ζωής (2000-2015)", x = "Έτος", y = "Μέσο Προσδόκιμο")

Το γράφημα απεικονίζει μια σταθερή ανοδική τάση στο μέσο προσδόκιμο ζωής παγκοσμίως κατά την περίοδο 2000-2015, επιβεβαιώνοντας τη βελτίωση των συνθηκών υγείας διαχρονικά. Παρά την πρόοδο, παραμένει ένα έντονο χάσμα περίπου 10-12 ετών ανάμεσα στις αναπτυγμένες και τις αναπτυσσόμενες χώρες, το οποίο διατηρείται σχεδόν παράλληλο καθ’ όλη τη διάρκεια της δεκαπενταετίας. Οι αναπτυσσόμενες χώρες ξεκινούν από τα 65 έτη και προσεγγίζουν τα 70, ενώ οι αναπτυγμένες αγγίζουν πλέον τα 81 έτη. Η παράλληλη αυτή εξέλιξη υποδηλώνει ότι, αν και η ποιότητα ζωής βελτιώνεται παντού, οι δομικές ανισότητες μεταξύ των δύο ομάδων δεν έχουν ακόμη γεφυρωθεί.

Γραμμική Παλινδρόμηση (Linear Regression)

Διευκρινίσεις και Μέθοδος

Στην ανάλυση, πρόκειται να ασχοληθούμε με το πώς οι διάφορες παράμετροι που θα επιλέγουμε, επηρεάζουν το Προσδόκιμο Ζωής, που συνιστά και το κυρίως μελετώμενο στατιστικό μας μέγεθος. Οι επιλογές παραμέτρων που θα λαμβάνουμε κάθε φορά υπόψιν δεν θα είναι αυθαίρετες και θα αιτιολογούνται. Για το training των μοντέλων μας, θα χρησιμοποιήσουμε το 80% των δεδομένων του dataset και για το Testing το υπόλοιπο 20%. Η διαδικασία του διαχωρισμού των δεδομένων φαίνεται παρακάτω.

library(caTools)

set.seed(123) 

split <- sample.split(df$life_expectancy, SplitRatio = 0.8)
train_set <- subset(df, split == TRUE)
test_set  <- subset(df, split == FALSE)

cat("Training Set:", nrow(train_set), "παρατηρήσεις\n")
## Training Set: 2341 παρατηρήσεις
cat("Test Set:", nrow(test_set), "παρατηρήσεις")
## Test Set: 587 παρατηρήσεις
Walkthrough στη Γραμμική Παλινδρόμηση

Σε αρχικό επίπεδο, στο πρώτο μοντέλο εξετάζουμε πώς η Εκπαίδευση (Schooling) επηρεάζει το προσδόκιμο ζωής. Η επιλογή έγινε διότι η εκπαίδευση αποτελεί τον βασικότερο δείκτη κοινωνικής ανάπτυξης και κατ’ επέκταση καλύτερου βιοτικού επιπέδου.

model_1 <- lm(life_expectancy ~ schooling, data = train_set)

ggplot(df, aes(x = schooling, y = life_expectancy)) +
  geom_point(alpha = 0.4, color = health_blue2, size = 2) +
  geom_abline(aes(intercept = coef(model_1)[1],
                  slope= coef(model_1)[2]), colour = health_blue) +
  labs(
    title = "Life Expectancy vs Schooling",
    x = "Έτη Εκπαίδευσης",
    y = "Προσδόκιμο Ζωής"
  )

library(kableExtra)
library(dplyr)

# 1. Υπολογισμοί για το model_1 (Schooling)
# ----------------------------------------
pred_train1 <- predict(model_1, newdata = train_set)
pred_test1  <- predict(model_1, newdata = test_set)

# SSE με στρογγυλοποίηση σε 2 δεκαδικά
sse_train1 <- round(sum((train_set$life_expectancy - pred_train1)^2, na.rm = TRUE), 2)
sse_test1  <- round(sum((test_set$life_expectancy - pred_test1)^2, na.rm = TRUE), 2)

# R-Squared Model (Training) με στρογγυλοποίηση
r2_train1 <- round(summary(model_1)$r.squared, 2)

# R-Squared Test με στρογγυλοποίηση
sst_test1 <- sum((test_set$life_expectancy - mean(test_set$life_expectancy, na.rm = TRUE))^2, na.rm = TRUE)
r2_test1  <- round(1 - (sse_test1 / sst_test1), 2)

# 2. Δημιουργία του Πίνακα και Προσθήκη της 1ης Εγγραφής
# ----------------------------------------------------
comparison_table <- data.frame(
  Variables = "Schooling",
  R2_Model = r2_train1,
  R2_Test  = r2_test1,
  SSE_Model = sse_train1,
  SSE_Test  = sse_test1,
  stringsAsFactors = FALSE
)

# 3. Εμφάνιση Πίνακα με Μπλε Μορφοποίηση και 2 Δεκαδικά
# --------------------------------------
comparison_table %>%
  kbl(digits = 2, 
      format.args = list(big.mark = ","), # Προσθέτει κόμμα στις χιλιάδες για να διαβάζεται εύκολα το SSE
      booktabs = TRUE, 
      caption = "Συγκριτικός Πίνακας Επιδόσεων Μοντέλων (2 Δεκαδικά)",
      col.names = c("Μεταβλητές", "R2 Model", "R2 Test", "SSE Model", "SSE Test")) %>%
  kable_classic_2(full_width = F, html_font = "Arial") %>%
  row_spec(0, bold = T, color = "white", background = "#0056b3") %>% 
  column_spec(1, bold = T, border_right = T, color = "#0056b3") %>%
  column_spec(2:5, width = "10em")
Συγκριτικός Πίνακας Επιδόσεων Μοντέλων (2 Δεκαδικά)
Μεταβλητές R2 Model R2 Test SSE Model SSE Test
Schooling 0.57 0.6 85,193.53 20,164.15

Το διάγραμμα διασποράς επιβεβαιώνει τη θετική γραμμική σχέση μεταξύ εκπαίδευσης και προσδοκίμου ζωής, καθώς η μπλε γραμμή παλινδρόμησης παρουσιάζει σταθερή ανοδική κλίση. Η συγκέντρωση των παρατηρήσεων γύρω από τη γραμμή υποδηλώνει ότι το μοντέλο ερμηνεύει ικανοποιητικά την τάση, ωστόσο η ύπαρξη διάσπαρτων τιμών (outliers) μακριά από αυτήν αντανακλά το σφάλμα SSE που υπολογίσαμε. Αυτή η διασπορά υποδεικνύει ότι η εκπαίδευση, αν και κρίσιμος παράγοντας, δεν αποτελεί τη μοναδική μεταβλητή πρόβλεψης. Η οπτική αυτή εικόνα τεκμηριώνει την ανάγκη μετάβασης σε ένα πολλαπλό μοντέλο, το οποίο θα ενσωματώνει επιπλέον παραμέτρους για τη μείωση των αποκλίσεων και την ακριβέστερη ερμηνεία των δεδομένων.

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

model_2 <- lm(life_expectancy ~ gdp, data = train_set)

ggplot(df, aes(x = gdp, y = life_expectancy)) +
  geom_point(alpha = 0.4, color = health_blue2, size = 2) +
  geom_abline(aes(intercept = coef(model_2)[1],
                  slope= coef(model_2)[2]), colour = health_blue) +
  labs(
    title = "Life Expectancy vs GDP",
    x = "Ακαθάριστο Εγχώριο Προϊόν",
    y = "Προσδόκιμο Ζωής"
  )

# 1. Φτιάχνουμε το μοντέλο με το GDP (ας το πούμε model_2)
model_2 <- lm(life_expectancy ~ schooling + gdp, data = train_set)

# 2. Υπολογισμοί για το model_2
p_train2 <- predict(model_2, newdata = train_set)
p_test2  <- predict(model_2, newdata = test_set)

sse_tr2 <- round(sum((train_set$life_expectancy - p_train2)^2, na.rm = TRUE), 2)
sse_te2 <- round(sum((test_set$life_expectancy - p_test2)^2, na.rm = TRUE), 2)
r2_tr2  <- round(summary(model_2)$r.squared, 2)
sst_te2 <- sum((test_set$life_expectancy - mean(test_set$life_expectancy, na.rm = TRUE))^2, na.rm = TRUE)
r2_te2  <- round(1 - (sse_te2 / sst_te2), 2)

# 3. Προσθήκη της νέας γραμμής στον υπάρχοντα πίνακα
comparison_table <- rbind(comparison_table, data.frame(
  Variables = "Schooling + GDP",
  R2_Model = r2_tr2,
  R2_Test  = r2_te2,
  SSE_Model = sse_tr2,
  SSE_Test  = sse_te2
))

# 4. Εμφάνιση του ανανεωμένου πίνακα
comparison_table %>%
  kbl(digits = 2, format.args = list(big.mark = ","), booktabs = TRUE, 
      caption = "Σύγκριση Μοντέλων: Προσθήκη GDP",
      col.names = c("Μεταβλητές", "R2 Model", "R2 Test", "SSE Model", "SSE Test")) %>%
  kable_classic_2(full_width = F, html_font = "Arial") %>%
  row_spec(0, bold = T, color = "white", background = "#0056b3") %>% 
  column_spec(1, bold = T, border_right = T, color = "#0056b3")
Σύγκριση Μοντέλων: Προσθήκη GDP
Μεταβλητές R2 Model R2 Test SSE Model SSE Test
Schooling 0.57 0.60 85,193.53 20,164.15
Schooling + GDP 0.59 0.65 77,051.69 17,680.35

Παρατηρούμε ότι η προσθήκη του GDP βελτίωσε το R^2 μόλις κατά 0.02. Αυτό υποδηλώνει ότι ο πλούτος μιας χώρας, αν και σημαντικός, δεν επηρεάζει το προσδόκιμο ζωής τόσο άμεσα όσο οι παράγοντες υγείας. Αυτό μας οδηγεί στο να εξετάσουμε μια μεταβλητή με ισχυρότερη βιολογική συνάφεια, όπως η Θνησιμότητα Ενηλίκων (Adult Mortality).

model_3 <- lm(life_expectancy ~ adult_mortality, data = train_set)

ggplot(df, aes(x = adult_mortality, y = life_expectancy)) +
  geom_point(alpha = 0.4, color = health_blue2, size = 2) +
  geom_abline(aes(intercept = coef(model_3)[1],
                  slope= coef(model_3)[2]), colour = health_blue) +
  labs(
    title = "Life Expectancy vs Adult Mortality",
    x = "Θνησιμότητα Ενηλίκων (Στους 1000)",
    y = "Προσδόκιμο Ζωής"
  )

# 1. Φτιάχνουμε το μοντέλο με Schooling, GDP και Adult Mortality
# Προσοχή: Χρησιμοποιούμε τα ονόματα των στηλών όπως είναι στο train_set
model_3 <- lm(life_expectancy ~ schooling + gdp + adult_mortality, data = train_set)

# 2. Υπολογισμοί για το model_3
p_train3 <- predict(model_3, newdata = train_set)
p_test3  <- predict(model_3, newdata = test_set)

# SSE με στρογγυλοποίηση
sse_tr3 <- round(sum((train_set$life_expectancy - p_train3)^2, na.rm = TRUE), 2)
sse_te3 <- round(sum((test_set$life_expectancy - p_test3)^2, na.rm = TRUE), 2)

# R-Squared Model (Training)
r2_tr3  <- round(summary(model_3)$r.squared, 2)

# R-Squared Test
sst_te3 <- sum((test_set$life_expectancy - mean(test_set$life_expectancy, na.rm = TRUE))^2, na.rm = TRUE)
r2_te3  <- round(1 - (sse_te3 / sst_te3), 2)

# 3. Προσθήκη της 3ης εγγραφής στον υπάρχοντα πίνακα comparison_table
comparison_table <- rbind(comparison_table, data.frame(
  Variables = "Schooling + GDP + Mortality",
  R2_Model = r2_tr3,
  R2_Test  = r2_te3,
  SSE_Model = sse_tr3,
  SSE_Test  = sse_te3
))

# 4. Εμφάνιση του τελικού πίνακα με τις 3 εγγραφές
comparison_table %>%
  kbl(digits = 2, format.args = list(big.mark = ","), booktabs = TRUE, 
      caption = "Τελική Σύγκριση Μοντέλων: Η επίδραση της Θνησιμότητας",
      col.names = c("Μεταβλητές", "R2 Model", "R2 Test", "SSE Model", "SSE Test")) %>%
  kable_classic_2(full_width = F, html_font = "Arial") %>%
  row_spec(0, bold = T, color = "white", background = "#0056b3") %>% 
  column_spec(1, bold = T, border_right = T, color = "#0056b3") %>%
  # Highlight την τελευταία γραμμή ως την καλύτερη
  row_spec(3, background = "#e6f2ff")
Τελική Σύγκριση Μοντέλων: Η επίδραση της Θνησιμότητας
Μεταβλητές R2 Model R2 Test SSE Model SSE Test
Schooling 0.57 0.60 85,193.53 20,164.15
Schooling + GDP 0.59 0.65 77,051.69 17,680.35
Schooling + GDP + Mortality 0.73 0.78 50,938.89 11,262.13

Η σταδιακή προσθήκη μεταβλητών αποδεικνύει την ανωτερότητα του τρίτου μοντέλου, με το R2 Model να αυξάνεται σημαντικά από 0.57 σε 0.73. Η πιο εντυπωσιακή βελτίωση παρατηρείται στο SSE Test, το οποίο από 20,164.15 στο απλό μοντέλο, μειώθηκε σχεδόν στο μισό (11,262.13) στο πλήρες μοντέλο, γεγονός που υποδηλώνει τεράστια αύξηση της προγνωστικής ακρίβειας. Παράλληλα, το R2 Test στο τελικό μοντέλο ανέρχεται στο 0.78, ξεπερνώντας μάλιστα την επίδοση του Training Set (0.73), πράγμα που πιστοποιεί ότι το μοντέλο είναι εξαιρετικά σταθερό και γενικεύει άριστα σε νέα δεδομένα. Η καταλυτική επίδραση της Θνησιμότητας (Mortality) είναι εμφανής, καθώς η ενσωμάτωσή της μείωσε το συνολικό σφάλμα (SSE Model) κατά περίπου 26,000 μονάδες σε σχέση με το μοντέλο του GDP. Συνολικά, τα δεδομένα επιβεβαιώνουν ότι ο συνδυασμός εκπαίδευσης, πλούτου και υγειονομικών δεικτών προσφέρει μια ολοκληρωμένη και στατιστικά ισχυρή ερμηνεία του προσδοκίμου ζωής.

Παρατηρήσεις / Συμπεράσματα

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