EA - εργασία 005
Κωνσταντίνα Κυριάκου
2026-03-28
Σχολιασμός / παρουσίαση του dataset
Το dataset που επιλέχθηκε προέρχεται από την πλατφόρμα Kaggle(https://www.kaggle.com/datasets/kumarajarshi/life-expectancy-who) και αφορά το προσδόκιμο ζωής (Life Expectancy) σε παγκόσμιο επίπεδο, βασισμένο σε δεδομένα του World Health Organization και των Ηνωμένων Εθνών. Το σύνολο δεδομένων περιλαμβάνει πληροφορίες για 193 χώρες κατά την περίοδο 2000–2015, με συνολικά 2938 παρατηρήσεις και 22 μεταβλητές. Οι μεταβλητές αυτές καλύπτουν ένα ευρύ φάσμα παραγόντων, όπως ποσοστά εμβολιασμού (π.χ. για Ηπατίτιδα Β, Πολιομυελίτιδα και Διφθερίτιδα), δείκτες θνησιμότητας (βρεφική και ενήλικη), οικονομικούς δείκτες (GDP, δαπάνες υγείας), καθώς και κοινωνικούς παράγοντες (εκπαίδευση, ανάπτυξη).
Στόχος της ανάλυσης είναι η κατανόηση των παραγόντων που επηρεάζουν το προσδόκιμο ζωής και η δημιουργία ενός μοντέλου πρόβλεψης. Ως εξαρτημένη μεταβλητή (target variable) επιλέγεται το Life Expectancy, δηλαδή το μέσο προσδόκιμο ζωής των κατοίκων κάθε χώρας. Οι υπόλοιπες μεταβλητές λειτουργούν ως ανεξάρτητες (predictors), οι οποίες χρησιμοποιούνται για να εξηγήσουν και να προβλέψουν τις μεταβολές στο προσδόκιμο ζωής.
library(readr)
library(ggplot2)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionLife_Data <- read.csv("Life_Expectancy_Data.csv")
View(Life_Data)
glimpse(Life_Data)## Rows: 2,938
## Columns: 22
## $ Country <chr> "Afghanistan", "Afghanistan", "Afghani…
## $ Year <int> 2015, 2014, 2013, 2012, 2011, 2010, 20…
## $ Status <chr> "Developing", "Developing", "Developin…
## $ Life.expectancy <dbl> 65.0, 59.9, 59.9, 59.5, 59.2, 58.8, 58…
## $ Adult.Mortality <int> 263, 271, 268, 272, 275, 279, 281, 287…
## $ infant.deaths <int> 62, 64, 66, 69, 71, 74, 77, 80, 82, 84…
## $ Alcohol <dbl> 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.…
## $ percentage.expenditure <dbl> 71.279624, 73.523582, 73.219243, 78.18…
## $ Hepatitis.B <int> 65, 62, 64, 67, 68, 66, 63, 64, 63, 64…
## $ Measles <int> 1154, 492, 430, 2787, 3013, 1989, 2861…
## $ BMI <dbl> 19.1, 18.6, 18.1, 17.6, 17.2, 16.7, 16…
## $ under.five.deaths <int> 83, 86, 89, 93, 97, 102, 106, 110, 113…
## $ Polio <int> 6, 58, 62, 67, 68, 66, 63, 64, 63, 58,…
## $ Total.expenditure <dbl> 8.16, 8.18, 8.13, 8.52, 7.87, 9.20, 9.…
## $ Diphtheria <int> 65, 62, 64, 67, 68, 66, 63, 64, 63, 58…
## $ HIV.AIDS <dbl> 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1…
## $ GDP <dbl> 584.25921, 612.69651, 631.74498, 669.9…
## $ Population <dbl> 33736494, 327582, 31731688, 3696958, 2…
## $ thinness..1.19.years <dbl> 17.2, 17.5, 17.7, 17.9, 18.2, 18.4, 18…
## $ thinness.5.9.years <dbl> 17.3, 17.5, 17.7, 18.0, 18.2, 18.4, 18…
## $ Income.composition.of.resources <dbl> 0.479, 0.476, 0.470, 0.463, 0.454, 0.4…
## $ Schooling <dbl> 10.1, 10.0, 9.9, 9.8, 9.5, 9.2, 8.9, 8…summary(Life_Data)## Country Year Status Life.expectancy
## Length:2938 Min. :2000 Length:2938 Min. :36.30
## Class :character 1st Qu.:2004 Class :character 1st Qu.:63.10
## Mode :character Median :2008 Mode :character Median :72.10
## Mean :2008 Mean :69.22
## 3rd Qu.:2012 3rd Qu.:75.70
## Max. :2015 Max. :89.00
## NA's :10
## Adult.Mortality infant.deaths Alcohol percentage.expenditure
## Min. : 1.0 Min. : 0.0 Min. : 0.0100 Min. : 0.000
## 1st Qu.: 74.0 1st Qu.: 0.0 1st Qu.: 0.8775 1st Qu.: 4.685
## Median :144.0 Median : 3.0 Median : 3.7550 Median : 64.913
## Mean :164.8 Mean : 30.3 Mean : 4.6029 Mean : 738.251
## 3rd Qu.:228.0 3rd Qu.: 22.0 3rd Qu.: 7.7025 3rd Qu.: 441.534
## Max. :723.0 Max. :1800.0 Max. :17.8700 Max. :19479.912
## NA's :10 NA's :194
## Hepatitis.B Measles BMI under.five.deaths
## Min. : 1.00 Min. : 0.0 Min. : 1.00 Min. : 0.00
## 1st Qu.:77.00 1st Qu.: 0.0 1st Qu.:19.30 1st Qu.: 0.00
## Median :92.00 Median : 17.0 Median :43.50 Median : 4.00
## Mean :80.94 Mean : 2419.6 Mean :38.32 Mean : 42.04
## 3rd Qu.:97.00 3rd Qu.: 360.2 3rd Qu.:56.20 3rd Qu.: 28.00
## Max. :99.00 Max. :212183.0 Max. :87.30 Max. :2500.00
## NA's :553 NA's :34
## Polio Total.expenditure Diphtheria HIV.AIDS
## Min. : 3.00 Min. : 0.370 Min. : 2.00 Min. : 0.100
## 1st Qu.:78.00 1st Qu.: 4.260 1st Qu.:78.00 1st Qu.: 0.100
## Median :93.00 Median : 5.755 Median :93.00 Median : 0.100
## Mean :82.55 Mean : 5.938 Mean :82.32 Mean : 1.742
## 3rd Qu.:97.00 3rd Qu.: 7.492 3rd Qu.:97.00 3rd Qu.: 0.800
## Max. :99.00 Max. :17.600 Max. :99.00 Max. :50.600
## NA's :19 NA's :226 NA's :19
## GDP Population thinness..1.19.years
## Min. :1.681e+00 Min. :3.400e+01 Min. : 0.10
## 1st Qu.:4.639e+02 1st Qu.:1.958e+05 1st Qu.: 1.60
## Median :1.767e+03 Median :1.387e+06 Median : 3.30
## Mean :7.483e+03 Mean :1.275e+07 Mean : 4.84
## 3rd Qu.:5.911e+03 3rd Qu.:7.420e+06 3rd Qu.: 7.20
## Max. :1.192e+05 Max. :1.294e+09 Max. :27.70
## NA's :448 NA's :652 NA's :34
## thinness.5.9.years Income.composition.of.resources Schooling
## Min. : 0.10 Min. :0.0000 Min. : 0.00
## 1st Qu.: 1.50 1st Qu.:0.4930 1st Qu.:10.10
## Median : 3.30 Median :0.6770 Median :12.30
## Mean : 4.87 Mean :0.6276 Mean :11.99
## 3rd Qu.: 7.20 3rd Qu.:0.7790 3rd Qu.:14.30
## Max. :28.60 Max. :0.9480 Max. :20.70
## NA's :34 NA's :167 NA's :163missing_table <- data.frame(
Missing_Values = colSums(is.na(Life_Data)),
Percentage = (colSums(is.na(Life_Data)) / nrow(Life_Data)) * 100
)
print("--- Έλεγχος Κενών Τιμών ανά Στήλη ---")## [1] "--- Έλεγχος Κενών Τιμών ανά Στήλη ---"print(missing_table)## Missing_Values Percentage
## Country 0 0.0000000
## Year 0 0.0000000
## Status 0 0.0000000
## Life.expectancy 10 0.3403676
## Adult.Mortality 10 0.3403676
## infant.deaths 0 0.0000000
## Alcohol 194 6.6031314
## percentage.expenditure 0 0.0000000
## Hepatitis.B 553 18.8223281
## Measles 0 0.0000000
## BMI 34 1.1572498
## under.five.deaths 0 0.0000000
## Polio 19 0.6466984
## Total.expenditure 226 7.6923077
## Diphtheria 19 0.6466984
## HIV.AIDS 0 0.0000000
## GDP 448 15.2484683
## Population 652 22.1919673
## thinness..1.19.years 34 1.1572498
## thinness.5.9.years 34 1.1572498
## Income.composition.of.resources 167 5.6841389
## Schooling 163 5.5479918Περιγραφή των μεταβλητών (τύπος, εύρος τιμών, μονάδες μέτρησης)
Το dataset αποτελείται από τις εξής μεταβλητές:
Country: String. Όνομα χώρας.
Year: Integer (2000–2015). Χρονική περίοδος καταγραφής σε έτοι.
Status: String (“Developed” / “Developing”). Επίπεδο ανάπτυξης χώρας
Life expectancy: Decimal (36.30–89.00). Προσδόκιμο ζωής (target variable) σε έτοι
Adult Mortality: Integer (1–723). Θνησιμότητα ενηλίκων, ανά 1000 άτομα.
infant deaths: Integer (0–1000+). Θάνατοι βρεφών.
Alcohol: Decimal (0.01–17.87) Λίτρα/άτομο.Κατανάλωση αλκοόλ
percentage expenditure: Decimal (0–10000+)(%). Δαπάνες υγείας.
Hepatitis B: Integer (1–99)(%).Εμβολιαστική κάλυψη.
Measles: Integer (0-212183) Κρούσματα. Περιστατικά ιλαράς.
BMI: Decimal (1-87.30). Δείκτης μάζας σώματος.
under-five deaths: Integer (0–1000+). Θάνατοι κάτω των 5 ετών.
Polio: Integer (3–99)(%). Εμβολιαστική κάλυψη.
Total expenditure: Decimal (0.37–17.6) (% ΑΕΠ). Δαπάνες υγείας
Diphtheria: Integer (2–99). Εμβολιαστική κάλυψη.
HIV/AIDS: Decimal (0.1–50.6). Θνησιμότητα από HIV.
GDP: Decimal (0–100000+)-Δολάρια. ΑΕΠ ανά χώρα.
Population: Integer (1000–1B+). Πληθυσμός.
thinness (1-19 years): Decimal (0.1–27.7)-(%). Αδυναμία εφήβων.
thinness (5-9 years): Decimal (0.1–28.6)-(%). Αδυναμία παιδιών.
Income composition: Decimal (0–0.9480). Οικονομική ανάπτυξη.
Schooling: Decimal (0–20.7). Έτη εκπαίδευσης.
Διάγραμμα Διασποράς (Scatterplot)
ggplot(Life_Data, aes(x = Schooling, y = Life.expectancy)) +
geom_point(color = "purple", alpha = 0.4) +
geom_smooth(method = "lm", color = "orange") +
labs(title = "Σχέση Εκπαίδευσης και Μακροζωίας",
x = "Έτη Εκπαίδευσης",
y = "Προσδόκιμο Ζωής")## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 170 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 170 rows containing missing values or values outside the scale range
## (`geom_point()`).
Σχολιασμός γραφήματος
Το γράφημα αποκαλύπτει μια ισχυρή γραμμική σχέση μεταξύ της εκπαίδευσης και του προσδόκιμου ζωής, υποδεικνύοντας ότι η πρόσβαση στη γνώση αποτελεί έναν από τους σημαντικότερους δείκτες κοινωνικής ευημερίας. Η ανοδική πορεία της γραμμής τάσης δείχνει ότι όσο αυξάνονται τα έτη φοίτησης, τόσο βελτιώνεται το επίπεδο υγείας και η ποιότητα ζωής του πληθυσμού.
Διάγραμμα Boxplot
ggplot(Life_Data, aes(x = Status, y = Life.expectancy, fill = Status)) +
geom_boxplot(outlier.color = "red", outlier.shape = 16, outlier.size = 2) +
scale_fill_manual(values = c("Developed" = "#69b3a2", "Developing" = "#404080")) +
labs(title = "Κατανομή Προσδόκιμου Ζωής ανά Κατάσταση Χώρας",
subtitle = "Σύγκριση Αναπτυγμένων και Αναπτυσσόμενων Χωρών",
x = "Κατάσταση Χώρας (Status)",
y = "Προσδόκιμο Ζωής (Έτη)"
) +
theme_minimal() ## Warning: Removed 10 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
Σχολιασμός γραφήματος
Το boxplot απεικονίζει ξεκάθαρα το χάσμα στο προσδόκιμο ζωής μεταξύ των δύο κατηγοριών χωρών. Οι Developed χώρες παρουσιάζουν πολύ υψηλότερη διάμεσο και μικρότερη μεταβλητότητα, γεγονός που υποδηλώνει σταθερά υψηλό επίπεδο υγείας. Αντίθετα, οι Developing χώρες έχουν πολύ μεγαλύτερο εύρος τιμών και αρκετές ακραίες χαμηλές τιμές, που υποδεικνύουν την ύπαρξη χωρών που υστερούν σημαντικά ίσως λόγω κρίσεων ή έλλειψης υποδομών.
Διάγραμμα Bar Chart
ggplot(Life_Data, aes(x = Status, y = percentage.expenditure, fill = Status)) +
geom_bar(stat = "identity", width = 0.6) +
scale_fill_manual(values = c("Developed" = "#f39c12", "Developing" = "#3498db")) +
labs(title = "Μέση Δημόσια Δαπάνη για την Υγεία",
x = "Κατάσταση Χώρας",
y = "Μέση Δαπάνη (% του ΑΕΠ)") +
theme_minimal()
Σχολιασμός γραφήματος
Το ραβδόγραμμα (bar chart) απεικονίζει τη διαφορά στις επενδύσεις για την υγεία ως ποσοστό του ΑΕΠ. Παρατηρούμε ότι οι Developed χώρες διαθέτουν σταθερά μεγαλύτερο ποσοστό του προϋπολογισμού τους για τη δημόσια υγεία σε σύγκριση με τις Developing.
1. Διερεύνηση του συνόλου δεδομένων (dataset)
Life_Data_Train <- read.csv("Life_Expectancy_Data_Train.csv")
View(Life_Data_Train)
str(Life_Data_Train)## 'data.frame': 2350 obs. of 22 variables:
## $ Country : chr "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
## $ Year : int 2015 2014 2013 2012 2011 2010 2009 2008 2007 2006 ...
## $ Status : chr "Developing" "Developing" "Developing" "Developing" ...
## $ Life.expectancy : num 65 59.9 59.9 59.5 59.2 58.8 58.6 58.1 57.5 57.3 ...
## $ Adult.Mortality : int 263 271 268 272 275 279 281 287 295 295 ...
## $ infant.deaths : int 62 64 66 69 71 74 77 80 82 84 ...
## $ Alcohol : num 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.03 0.02 0.03 ...
## $ percentage.expenditure : num 71.3 73.5 73.2 78.2 7.1 ...
## $ Hepatitis.B : int 65 62 64 67 68 66 63 64 63 64 ...
## $ Measles : int 1154 492 430 2787 3013 1989 2861 1599 1141 1990 ...
## $ BMI : num 19.1 18.6 18.1 17.6 17.2 16.7 16.2 15.7 15.2 14.7 ...
## $ under.five.deaths : int 83 86 89 93 97 102 106 110 113 116 ...
## $ Polio : int 6 58 62 67 68 66 63 64 63 58 ...
## $ Total.expenditure : num 8.16 8.18 8.13 8.52 7.87 9.2 9.42 8.33 6.73 7.43 ...
## $ Diphtheria : int 65 62 64 67 68 66 63 64 63 58 ...
## $ HIV.AIDS : num 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 ...
## $ GDP : num 584.3 612.7 631.7 670 63.5 ...
## $ Population : int 33736494 327582 31731688 3696958 2978599 2883167 284331 2729431 26616792 2589345 ...
## $ thinness..1.19.years : num 17.2 17.5 17.7 17.9 18.2 18.4 18.6 18.8 19 19.2 ...
## $ thinness.5.9.years : num 17.3 17.5 17.7 18 18.2 18.4 18.7 18.9 19.1 19.3 ...
## $ Income.composition.of.resources: num 0.479 0.476 0.47 0.463 0.454 0.448 0.434 0.433 0.415 0.405 ...
## $ Schooling : num 10.1 10 9.9 9.8 9.5 9.2 8.9 8.7 8.4 8.1 ...summary(Life_Data_Train)## Country Year Status Life.expectancy
## Length:2350 Min. :2000 Length:2350 Min. :36.3
## Class :character 1st Qu.:2004 Class :character 1st Qu.:63.5
## Mode :character Median :2008 Mode :character Median :72.3
## Mean :2008 Mean :69.5
## 3rd Qu.:2012 3rd Qu.:76.0
## Max. :2015 Max. :89.0
## NA's :9
## Adult.Mortality infant.deaths Alcohol percentage.expenditure
## Min. : 1 Min. : 0.00 Min. : 0.0100 Min. : 0.000
## 1st Qu.: 73 1st Qu.: 0.00 1st Qu.: 0.6525 1st Qu.: 7.829
## Median :141 Median : 2.00 Median : 3.8650 Median : 72.592
## Mean :160 Mean : 33.36 Mean : 4.7282 Mean : 754.539
## 3rd Qu.:225 3rd Qu.: 19.00 3rd Qu.: 7.9975 3rd Qu.: 472.284
## Max. :699 Max. :1800.00 Max. :17.8700 Max. :18961.349
## NA's :9 NA's :144
## Hepatitis.B Measles BMI under.five.deaths
## Min. : 1.00 Min. : 0.0 Min. : 1.40 Min. : 0.0
## 1st Qu.:78.00 1st Qu.: 0.0 1st Qu.:19.20 1st Qu.: 0.0
## Median :93.00 Median : 12.0 Median :43.65 Median : 3.0
## Mean :81.81 Mean : 2612.9 Mean :38.17 Mean : 46.1
## 3rd Qu.:97.00 3rd Qu.: 318.8 3rd Qu.:56.20 3rd Qu.: 24.0
## Max. :99.00 Max. :212183.0 Max. :87.30 Max. :2500.0
## NA's :417 NA's :2
## Polio Total.expenditure Diphtheria HIV.AIDS
## Min. : 3.00 Min. : 1.100 Min. : 2.00 Min. : 0.100
## 1st Qu.:78.00 1st Qu.: 4.240 1st Qu.:79.00 1st Qu.: 0.100
## Median :93.00 Median : 5.780 Median :93.00 Median : 0.100
## Mean :82.84 Mean : 5.875 Mean :82.89 Mean : 1.394
## 3rd Qu.:97.00 3rd Qu.: 7.440 3rd Qu.:97.00 3rd Qu.: 0.700
## Max. :99.00 Max. :17.240 Max. :99.00 Max. :38.800
## NA's :6 NA's :163 NA's :6
## GDP Population thinness..1.19.years
## Min. :1.681e+00 Min. :3.400e+01 Min. : 0.100
## 1st Qu.:4.734e+02 1st Qu.:2.297e+05 1st Qu.: 1.600
## Median :1.873e+03 Median :1.452e+06 Median : 3.200
## Mean :7.654e+03 Mean :1.391e+07 Mean : 4.753
## 3rd Qu.:6.579e+03 3rd Qu.:7.588e+06 3rd Qu.: 7.200
## Max. :1.192e+05 Max. :1.294e+09 Max. :27.700
## NA's :307 NA's :508 NA's :2
## thinness.5.9.years Income.composition.of.resources Schooling
## Min. : 0.100 Min. :0.0000 Min. : 0.00
## 1st Qu.: 1.600 1st Qu.:0.4978 1st Qu.:10.00
## Median : 3.200 Median :0.6850 Median :12.40
## Mean : 4.773 Mean :0.6347 Mean :12.06
## 3rd Qu.: 7.200 3rd Qu.:0.7870 3rd Qu.:14.40
## Max. :28.600 Max. :0.9480 Max. :20.70
## NA's :2 NA's :102 NA's :99numeric_data <- Life_Data_Train[sapply(Life_Data_Train, is.numeric)]
# πίνακα συσχετίσεων (βάζουμε use="complete.obs" για να αγνοήσει τυχόν κενά κελιά NA)
cor_matrix <- cor(numeric_data, use = "complete.obs")
# Ζητάμε να δούμε μόνο τις συσχετίσεις του Προσδόκιμου Ζωής, ταξινομημένες
sort(cor_matrix[,"Life.expectancy"], decreasing = TRUE)## Life.expectancy Schooling
## 1.00000000 0.75920594
## Income.composition.of.resources BMI
## 0.75821105 0.56203493
## Alcohol GDP
## 0.47239767 0.45623362
## percentage.expenditure Diphtheria
## 0.42517347 0.38740473
## Polio Total.expenditure
## 0.32957935 0.21617459
## Hepatitis.B Year
## 0.20555873 0.02495707
## Population Measles
## -0.03318212 -0.07317065
## infant.deaths under.five.deaths
## -0.17967119 -0.20245547
## thinness.5.9.years thinness..1.19.years
## -0.47851890 -0.48301416
## HIV.AIDS Adult.Mortality
## -0.56946031 -0.70509686# Βγαινουμε στο συμπέρασμα για επιλογή Schooling
ggplot(Life_Data_Train, aes(Life.expectancy, Schooling)) +
geom_point() ## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
Σχολιασμός αποτελεσμάτων
Για εξαρτημένη μεταβλητή επιλέχθηκε το “Life.expectancy”. Για την έυρεση των ανεξάρτητων μεταβλητών που θα χρησιμοποιήσουμε θα είναι οι μεταβλητές που όσο πιο κοντά στο 1 ή στο -1 είναι το νούμερο, τόσο ισχυρότερη είναι η γραμμική σχέση, άρα τόσο καλύτερη είναι η μεταβλητή για το μοντέλο μας.Το Schooling έχει υψηλή θετική συσχέτιση (π.χ. > 0.70). Αντίθετα, μεταβλητή όπως το Adult.Mortality έχει ισχυρή αρνητική συσχέτιση.Στην περίπτωση αυτή θα επιλεχθεί το Schooling
2. Δημιουργία (και αξιολόγηση) μοντέλου παλινδρόμησης
# Δημιουργία του απλού μοντέλου γραμμικής παλινδρόμησης
model = lm(Schooling ~ Life.expectancy, data= Life_Data_Train)
# Εμφάνιση της σύνοψης (στατιστικά αποτελέσματα)
summary(model) ##
## Call:
## lm(formula = Schooling ~ Life.expectancy, data = Life_Data_Train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -13.4618 -1.0926 -0.0129 1.2368 6.4617
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.466661 0.342761 -21.78 <2e-16 ***
## Life.expectancy 0.280542 0.004881 57.48 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.165 on 2243 degrees of freedom
## (105 observations deleted due to missingness)
## Multiple R-squared: 0.5956, Adjusted R-squared: 0.5954
## F-statistic: 3304 on 1 and 2243 DF, p-value: < 2.2e-16#Scatterplot
ggplot(Life_Data_Train, aes(Schooling,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model)[1],
slope = coef(model)[2]), colour = "red")## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
SSE <- sum(model$residuals^2)
print(SSE)## [1] 10510.66RMSE <- sqrt(SSE/nrow(Life_Data_Train))
print(RMSE)## [1] 2.114857Σχολιασμός αποτελεσμάτων
p-value: Έχει αστεράκια (***), που σημαίνει ότι είναι κάτω από 0.05. Άρα η εκπαίδευση είναι στατιστικά σημαντική μεταβλητή. Multiple R-squared : Δείχνει το ποσοστό της μεταβλητότητας του προσδόκιμου ζωής που εξηγείται από την εκπαίδευση, βγαίνει 0.5954 , σημαίνει ότι το Schooling εξηγεί το 59.54% της διακύμανσης.
# Δημιουργία μοντέλου πολλαπλής γραμμικής παλινδρόμησης
model2 <- lm(Life.expectancy ~ Schooling + Adult.Mortality, data = Life_Data_Train)
# Εμφάνιση της σύνοψης
summary(model2)##
## Call:
## lm(formula = Life.expectancy ~ Schooling + Adult.Mortality, data = Life_Data_Train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -25.8459 -2.3616 0.4014 2.7909 24.0520
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 55.2458936 0.5186651 106.52 <2e-16 ***
## Schooling 1.6097301 0.0344815 46.68 <2e-16 ***
## Adult.Mortality -0.0319587 0.0009938 -32.16 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.927 on 2242 degrees of freedom
## (105 observations deleted due to missingness)
## Multiple R-squared: 0.7233, Adjusted R-squared: 0.723
## F-statistic: 2930 on 2 and 2242 DF, p-value: < 2.2e-16#Scatterplot1
ggplot(Life_Data_Train, aes(Schooling,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model2)[1],
slope = coef(model2)[2]), colour = "red")## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
#Scatterplot2
ggplot(Life_Data_Train, aes(Adult.Mortality,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model2)[1],
slope = coef(model2)[2]), colour = "red")## Warning: Removed 9 rows containing missing values or values outside the scale range
## (`geom_point()`).
SSE2 <- sum(model2$residuals^2)
print(SSE2)## [1] 54434.94RMSE2 <- sqrt(SSE2/nrow(Life_Data_Train))
print(RMSE2)## [1] 4.812879Σχολιασμός αποτελεσμάτων
p-value: Έχει αστεράκια (***), που σημαίνει ότι είναι κάτω από 0.05. Άρα η εκπαίδευση είναι στατιστικά σημαντική μεταβλητή. Multiple R-squared : Δείχνει το ποσοστό της μεταβλητότητας του προσδόκιμου ζωής που εξηγείται από τις προσθεθέμενες μεταβλητές, βγαίνει 0.723, σημαίνει ότι το Schooling εξηγεί το 72.3% της διακύμανσης. Tο Multiple R-squared είναι μεγαλύτερο από του πρώτου μοντέλου. Αυτό σημαίνει ότι η προσθήκη της νέας μεταβλητής βελτίωσε το μοντέλο!
model3 <- lm(Life.expectancy ~ Schooling + Adult.Mortality +Income.composition.of.resources, data = Life_Data_Train)
# Εμφάνιση της σύνοψης
summary(model3)##
## Call:
## lm(formula = Life.expectancy ~ Schooling + Adult.Mortality +
## Income.composition.of.resources, data = Life_Data_Train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -23.6558 -2.1383 0.2157 2.4721 24.9470
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 54.0048149 0.5057355 106.78 <2e-16 ***
## Schooling 1.0686859 0.0511038 20.91 <2e-16 ***
## Adult.Mortality -0.0296044 0.0009687 -30.56 <2e-16 ***
## Income.composition.of.resources 11.6498860 0.8384955 13.89 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.729 on 2241 degrees of freedom
## (105 observations deleted due to missingness)
## Multiple R-squared: 0.7452, Adjusted R-squared: 0.7449
## F-statistic: 2185 on 3 and 2241 DF, p-value: < 2.2e-16#Scatterplot1
ggplot(Life_Data_Train, aes(Schooling,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model3)[1],
slope = coef(model3)[2]), colour = "red")## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
#Scatterplot2
ggplot(Life_Data_Train, aes(Adult.Mortality,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model3)[1],
slope = coef(model3)[2]), colour = "red")## Warning: Removed 9 rows containing missing values or values outside the scale range
## (`geom_point()`).
#Scatterplot3
ggplot(Life_Data_Train, aes(Income.composition.of.resources,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model3)[1],
slope = coef(model3)[2]), colour = "red")## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
SSE3 <- sum(model3$residuals^2)
print(SSE3)## [1] 50117.84RMSE3 <- sqrt(SSE3/nrow(Life_Data_Train))
print(RMSE3)## [1] 4.618088Σχολιασμός αποτελεσμάτων
p-value: Έχει αστεράκια (***), που σημαίνει ότι είναι κάτω από 0.05. Άρα η εκπαίδευση είναι στατιστικά σημαντική μεταβλητή. Multiple R-squared : Δείχνει το ποσοστό της μεταβλητότητας του προσδόκιμου ζωής που εξηγείται από τις προσθεθέμενες μεταβλητές, βγαίνει 0.7452, σημαίνει ότι το Schooling εξηγεί το 74.52% της διακύμανσης. Tο Multiple R-squared είναι μεγαλύτερο από τo προηγούμενο μοντέλο. Αυτό σημαίνει ότι η προσθήκη της νέας μεταβλητής βελτίωσε το μοντέλο!
model4 <- lm(Life.expectancy ~ Schooling + Adult.Mortality + Income.composition.of.resources + HIV.AIDS , data = Life_Data_Train)
# Εμφάνιση της σύνοψης
summary(model4)##
## Call:
## lm(formula = Life.expectancy ~ Schooling + Adult.Mortality +
## Income.composition.of.resources + HIV.AIDS, data = Life_Data_Train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -21.2010 -2.1392 -0.1376 2.3160 24.0470
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 53.339168 0.459439 116.10 <2e-16 ***
## Schooling 1.103670 0.046353 23.81 <2e-16 ***
## Adult.Mortality -0.018532 0.001011 -18.32 <2e-16 ***
## Income.composition.of.resources 10.650378 0.761442 13.99 <2e-16 ***
## HIV.AIDS -0.620218 0.028101 -22.07 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.287 on 2240 degrees of freedom
## (105 observations deleted due to missingness)
## Multiple R-squared: 0.7907, Adjusted R-squared: 0.7903
## F-statistic: 2116 on 4 and 2240 DF, p-value: < 2.2e-16#Scatterplot1
ggplot(Life_Data_Train, aes(Schooling,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model4)[1],
slope = coef(model4)[2]), colour = "red")## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
#Scatterplot2
ggplot(Life_Data_Train, aes(Adult.Mortality,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model3)[1],
slope = coef(model3)[2]), colour = "red")## Warning: Removed 9 rows containing missing values or values outside the scale range
## (`geom_point()`).
#Scatterplot3
ggplot(Life_Data_Train, aes(Income.composition.of.resources,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model4)[1],
slope = coef(model4)[2]), colour = "red")## Warning: Removed 105 rows containing missing values or values outside the scale range
## (`geom_point()`).
#Scatterplot4
ggplot(Life_Data_Train, aes(HIV.AIDS,Life.expectancy)) +
geom_point() +
geom_abline(aes(intercept = coef(model4)[1],
slope = coef(model4)[2]), colour = "red")## Warning: Removed 9 rows containing missing values or values outside the scale range
## (`geom_point()`).
SSE4 <- sum(model4$residuals^2)
print(SSE4)## [1] 41165.34RMSE4 <- sqrt(SSE4/nrow(Life_Data_Train))
print(RMSE4)## [1] 4.185351Σχολιασμός αποτελεσμάτων
p-value: Έχει αστεράκια (***), που σημαίνει ότι είναι κάτω από 0.05. Άρα η εκπαίδευση είναι στατιστικά σημαντική μεταβλητή. Multiple R-squared : Δείχνει το ποσοστό της μεταβλητότητας του προσδόκιμου ζωής που εξηγείται από τις προσθεθέμενες μεταβλητές, βγαίνει 0.7907, σημαίνει ότι το Schooling εξηγεί το 79.07% της διακύμανσης. Tο Multiple R-squared είναι μεγαλύτερο από τo προηγούμενο μοντέλο. Αυτό σημαίνει ότι η προσθήκη της νέας μεταβλητής βελτίωσε το μοντέλο!
3.Εφαρμογή σε νέο σύνολο δεδομένων - Πρόβλεψη
Life_Data_Test <- read.csv("Life_Expectancy_Data_Test.csv")
Life_Data_predictions <- predict(model4, newdata = Life_Data_Test)
head(Life_Data_predictions)## 1 2 3 4 5 6
## 79.60403 81.06016 79.40530 80.80900 80.53142 80.09230test_errors <- Life_Data_Test$Life.expectancy - Life_Data_predictions
SSE_test <- sum(test_errors^2, na.rm = TRUE)
RMSE_test <- sqrt(SSE_test / nrow(Life_Data_Test))
print(paste("Το SSE στα νέα δεδομένα είναι:", SSE_test))## [1] "Το SSE στα νέα δεδομένα είναι: 10165.0114273602"print(paste("Το RMSE (μέσο σφάλμα σε χρόνια) είναι:", RMSE_test))## [1] "Το RMSE (μέσο σφάλμα σε χρόνια) είναι: 4.15781606138035"Σχολιασμός αποτελεσμάτων
Στο Βήμα 3 εφαρμόσαμε το μοντέλο μας στο νέο σύνολο δεδομένων (Test set) για να αξιολογήσουμε την ικανότητα πρόβλεψής του σε άγνωστα δεδομένα. Υπολογίσαμε το άθροισμα τετραγώνων των σφαλμάτων (SSE) το οποίο ανήλθε στο 41165.3366056393.
Το πιο σημαντικό μέτρο αξιολόγησης όμως είναι το RMSE (Root Mean Squared Error), το οποίο υπολογίστηκε στο 4.18535118156625. Αυτό πρακτικά σημαίνει ότι, κατά μέσο όρο, οι προβλέψεις του μοντέλου μας για το Προσδόκιμο Ζωής στα νέα δεδομένα πέφτουν έξω περίπου 4.2 χρόνια σε σχέση με τις πραγματικές τιμές. Το σφάλμα αυτό θεωρείταιικανοποιητικό με βάση τη φύση του προβλήματος
4.Παραδείγματα & Συμπεράσματα
Γενικό Συμπέρασμα Ανάλυσης: Η συγκεκριμένη ανάλυση αναδεικνύει επιτυχώς την πολυπαραγοντική φύση του προσδόκιμου ζωής. Μέσα από τη διερεύνηση των δεδομένων (Exploratory Data Analysis) και τη σταδιακή δημιουργία μοντέλων πολλαπλής γραμμικής παλινδρόμησης, προκύπτουν τα εξής βασικά συμπεράσματα:
Κοινωνικοοικονομικοί και Υγειονομικοί Παράγοντες: Η εκπαίδευση (Schooling) και η οικονομική ανάπτυξη (Income composition) παίζουν καθοριστικό ρόλο στην αύξηση του προσδόκιμου ζωής. Παράλληλα, δείκτες όπως η θνησιμότητα ενηλίκων (Adult Mortality) και η εξάπλωση του HIV/AIDS επιδρούν κατασταλτικά, αποδεικνύοντας ότι η μακροζωία εξαρτάται από έναν συνδυασμό παιδείας, πόρων και δημόσιας υγείας.
Το Χάσμα Ανάπτυξης: Όπως φάνηκε καθαρά από τις οπτικοποιήσεις (Boxplots και Bar charts), οι αναπτυγμένες χώρες επενδύουν περισσότερο στην υγεία και παρουσιάζουν υψηλότερα και πιο σταθερά επίπεδα μακροζωίας σε σχέση με τις αναπτυσσόμενες.
Ικανότητα Πρόβλεψης (Μοντέλο): Το τελικό μοντέλο (Model 4) καταφέρνει να ερμηνεύσει σχεδόν το 80% (Multiple R-squared: 0.7907) της μεταβλητότητας του προσδόκιμου ζωής, με το μέσο σφάλμα (RMSE) να περιορίζεται στα περίπου 4.2 έτη, ένα νούμερο εξαιρετικά ικανοποιητικό για μακροοικονομικά/υγειονομικά δεδομένα.