Framingham Dataset
Petropoulos Sokratis
2025-05-14
Περιγραφή του Dataset
Το παρόν dataset απεικονίζει μια καρδιαγγειακή έρευνα τεσσάρων χιλιάδων περίπου ασθενών από την πόλη της Φράνινγχαμ στην Μασαχουσέτη, ΗΠΑ. Σε αυτό βρίσκεται μια πλειθώρα πληροφοριών για τους ασθενείς όπως δημογραφικά στοιχεία(ηλικία, φύλο και επίπεδο εκπαίδευσης), ιατρικό ιστορικό δηλαδή αν ο ασθενής πάσχει από υπέρταση, διαβήτη και αν υπέστει εγκεφαλικό επεισόδιο. Επίσης, διατρέχονται και άλλες μετρήσεις σαν η πίεση του αίματος, τα επίπεδα χοληστερόλης τα επίπεδα γληκόζης ακόμη και αν είναι καπνιστής και πόσα τσιγάρα καταναλώνει καθημερινά.
- Αιτιολόγηση της επιλογής σε σχέση με την επιχειρηματική αναλυτική:
Ο κύριος λόγος επιλογής του επιμέρους συνόλου δεδομένων είναι η πρόβλεψη για το αν θα παρουσιαστεί σε 10 χρόνια στους κατεγραμμένους ασθενείς μία καρδιακή ασθένεια δηλαδή ένα καρδιακό επεισόδιο ή καρδιακή προσβολή. Επιπρόσθετα, θα αιτιόλογηθεί και το γιατί θα υπάρξει αυτή η ασθένεια δίνοντας επακριβείς στοιχεία από τα δοσμένα δεδομένα.
- Πιθανά επιχειρηματικά ερωτήματα που θα μπορούσαν να απαντηθούν:
-Ποίος είναι ο κύριος παράγοντας που αυξάνει τον κίνδυνο μιας μελλοντικής καρδιακής ασθένειας;
-Ποιοί παράγοντες μπορούν να αντιμετωπιστούν εγκαίρως;
-Κατά πόσο παίζουν ρόλο κάποιες μεταβλητές στην μελλοντική ανάπτυξη καρδιακής ασθένειας όπως για παράδειγμα η ηλικία;
- Περιγραφή Μεταβλητών:
1.male(Categorical): Δείχνει αν ο ασθενής είναι άνδρας με το 1 ή αν είναι γυναίκα με το 0.2.age(Numeric): Ηλικία του ασθενή.3.education(integer): Επίπεδο εκπαίδευσης του ασθενή.4.currentSmoker(Categorical): Φαίνεται αν ο ασθενής είναι καπνιστής από το 1 και αν δέν είναι από το 0.5.cigsPerDay(numeric): Πόσα τσιγάρα καπνίζει ο ασθενής ημερησίως.6.BPMeds(Categorical): Εξετάζεται αν ο ασθενής χωρηγείται με φάρμακα για την πίεση του αίματος του με το 1 και αν όχι με το 0.7.prelaventStroke(Categorical): Εστιάζει αν ο ασθενής είχε πότε εγκεφαλικό επεισόδιο με το 1 και αν δέν είχε με το 0 .8.prelaventHyp(Categorical): Εστιάζει αν ο ασθενής υπήρξε θύμα υπέρτασης με το 1 και αν όχι με το 0.9.diabetes(Categorical): Παρουσιάζει αν ο ασθενής πάσχει από διαβήτη με το 1 ή όχι με το 0.10.totChol(Numeric): Η συνολική χοληστερόλη του ασθενή.11.sysBP(Numeric): Η συστολική πίεση αίματος του ασθενή.12.diaBP(Numeric): Η διαστολική πίεση αίματος του ασθενή.13.BMI(Numeric): Ο συνολικός δείχτης μάζας σώματος του ασθενή.14.heartRate(Numeric): Ο καρδιακός ρυθμός του ασθενή .15.glucose(Numeric): Το επίπεδο γλυκόζης του ασθενή.16.TenYearCHD(Categorical): Υποδυκνύει αν ο ασθενής βρίσκεται σε κίνδυνο για μια καρδιακή ασθένεια σε μια δεκαετία ( 1 θα παρουσιάσει ασθένεια και 0 αν όχι ).Υπολογισμός και παρουσίαση περιγραφικών στατιστικών:
summary(framingham)## male age education currentSmoker
## Min. :0.0000 Min. :32.00 Min. :1.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:42.00 1st Qu.:1.000 1st Qu.:0.0000
## Median :0.0000 Median :49.00 Median :2.000 Median :0.0000
## Mean :0.4292 Mean :49.58 Mean :1.979 Mean :0.4941
## 3rd Qu.:1.0000 3rd Qu.:56.00 3rd Qu.:3.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :70.00 Max. :4.000 Max. :1.0000
## NA's :105
## cigsPerDay BPMeds prevalentStroke prevalentHyp
## Min. : 0.000 Min. :0.00000 Min. :0.000000 Min. :0.0000
## 1st Qu.: 0.000 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:0.0000
## Median : 0.000 Median :0.00000 Median :0.000000 Median :0.0000
## Mean : 9.006 Mean :0.02962 Mean :0.005896 Mean :0.3106
## 3rd Qu.:20.000 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:1.0000
## Max. :70.000 Max. :1.00000 Max. :1.000000 Max. :1.0000
## NA's :29 NA's :53
## diabetes totChol sysBP diaBP
## Min. :0.00000 Min. :107.0 Min. : 83.5 Min. : 48.0
## 1st Qu.:0.00000 1st Qu.:206.0 1st Qu.:117.0 1st Qu.: 75.0
## Median :0.00000 Median :234.0 Median :128.0 Median : 82.0
## Mean :0.02571 Mean :236.7 Mean :132.4 Mean : 82.9
## 3rd Qu.:0.00000 3rd Qu.:263.0 3rd Qu.:144.0 3rd Qu.: 90.0
## Max. :1.00000 Max. :696.0 Max. :295.0 Max. :142.5
## NA's :50
## BMI heartRate glucose TenYearCHD
## Min. :15.54 Min. : 44.00 Min. : 40.00 Min. :0.0000
## 1st Qu.:23.07 1st Qu.: 68.00 1st Qu.: 71.00 1st Qu.:0.0000
## Median :25.40 Median : 75.00 Median : 78.00 Median :0.0000
## Mean :25.80 Mean : 75.88 Mean : 81.96 Mean :0.1519
## 3rd Qu.:28.04 3rd Qu.: 83.00 3rd Qu.: 87.00 3rd Qu.:0.0000
## Max. :56.80 Max. :143.00 Max. :394.00 Max. :1.0000
## NA's :19 NA's :1 NA's :388Οπτικοποίηση Δεδομένων
Scatterplot
## Warning: Removed 48 rows containing missing values or values outside the scale range
## (`geom_point()`).
Στο συγκεκριμένο διάγραμμα παρατηρούμε το εξής:
Όσο περισσότερα τσιγάρα καπνίζει ο ασθενής τόσο μειώνεται ο δείχτης μάζας σώματος του.
Τα outliers των τιμών είναι σταθερά αρχικά αλλά αργότερα μεταβάλλονται με κατυφορικό τόνο.
Boxplot
## Warning: Removed 29 rows containing missing values or values outside the scale range
## (`stat_boxplot()`).## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_boxplot()`).
Απο το παραπάνω διάγραμμα παρατηρείται ότι:
Η διάμεσος μέχρι τα 10 τσιγάρα ημερησίως είναι σταθερή μετά μεταβάλλεται ανάλογα.
Τα περισσότερα outliers των σφιγμών των ασθενών βρίσκονται μεταξύ των τιμών 100 και 125.
Histogram
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
## $title
## [1] "Ιστόγραμμα του καρδιακού ρυθμού των ασθενών "
##
## attr(,"class")
## [1] "labels"Από το ιστόγραμμα φαίνεται:
Το μεγαλύτερο ποσοστό ασθενών βρίσκεται μεταξύ 70-75 παλμούς το δευτερόλεπτο.
Το μικρότερο ποσοστό των ασθενών βρίσκεται μεταξύ 100-120 παλμούς το δευτερόλεπτο.
Λογιστική Παλινδρόμηση
Δημιουργία Δεδομένων σε training και test set
Για να πραγματοποιηθεί η λογιστική παλινδρόμηση θα πρέπει πρώτα απ’όλα να διαχωριστούν τυχαία τα δεδομένα σε σε δύο υποκατηγορίες οι οποίες είναι: η training set η οποία αποτελείτε από το 65% των συλλεγόμενων δεδομένων και η test set η οποία αποτελείτε από το 35% το συλλεγόμενων δεδομένων.
table(framingham$TenYearCHD)##
## 0 1
## 3596 644library(caTools)
library(ROCR)
set.seed(940)
split <- sample.split(framingham$TenYearCHD, SplitRatio = 0.65)
CHDTrain <- subset(framingham, split == TRUE)
CHDTest <- subset(framingham, split == FALSE)
cat("Καταχωρήσεις στο training set:", nrow(CHDTrain))## Καταχωρήσεις στο training set: 2756cat("Καταχωρήσεις στο test set:", nrow(CHDTest))## Καταχωρήσεις στο test set: 1484Δημιουργία μοντέλου λογιστικής παλινδρόμησης
Θα δημιουργήσουμε το μοντέλο λογιστικής παλινδρόμησης για την πρόβλεψη με την συναρτηση glm(). Με αυτό το τρόπο θα αποκαλυφθεί ποία από τις ανεξάρτητες μεταβλητές έχουν την μεγαλύτερη συσχέτιση με την εξαρτημένη μεταβλητή και ποιό είναι το significance αυτό.
library(caTools)
library(ROCR)
model <- glm(TenYearCHD ~ . , data = CHDTrain, family = "binomial")
summary(model)##
## Call:
## glm(formula = TenYearCHD ~ ., family = "binomial", data = CHDTrain)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.512495 0.891577 -9.548 < 2e-16 ***
## male 0.480266 0.133329 3.602 0.000316 ***
## age 0.058451 0.008261 7.076 1.49e-12 ***
## education -0.014950 0.061086 -0.245 0.806661
## currentSmoker 0.132767 0.192752 0.689 0.490951
## cigsPerDay 0.017382 0.007827 2.221 0.026371 *
## BPMeds 0.177416 0.295680 0.600 0.548489
## prevalentStroke 0.450540 0.620673 0.726 0.467906
## prevalentHyp 0.357608 0.169249 2.113 0.034608 *
## diabetes 0.205435 0.383251 0.536 0.591935
## totChol 0.002188 0.001410 1.552 0.120706
## sysBP 0.009458 0.004804 1.969 0.048967 *
## diaBP 0.008462 0.008190 1.033 0.301531
## BMI 0.016145 0.015549 1.038 0.299137
## heartRate -0.005301 0.005393 -0.983 0.325618
## glucose 0.007790 0.002917 2.671 0.007570 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2029.8 on 2370 degrees of freedom
## Residual deviance: 1793.7 on 2355 degrees of freedom
## (385 observations deleted due to missingness)
## AIC: 1825.7
##
## Number of Fisher Scoring iterations: 5Η αξιολόγηση του μοντέλου βασίστηκε στις τιμές που βρίσκονται στην p-value. Με αυτό το τρόπο τα συμπεράσματα που επιτεύχθηκαν είναι τα εξής:
Η μεταβλητή με την πιο σημαντική επίδραση για την υπόδειξη ότι ο ασθενής θα παρουσιάσει σε μια δεκαετία μια καρδιακή ασθένεια είναι η ηλικία με την p-value της να είναι 7.08. Αυτό σημένει ότι όσο μεγαλύτερος είναι ο ασθενής σε ηλικία έχει πιό πολύ αυξημένη πιθανότητα να πάθει μια καρδιακή ασθένεια από κάποιον ο οποίος είναι μικρότερος σε ηλικία.
Η δεύτερη πιο σημαντική μεταβλητή είναι το φύλο δηλαδή αν είναι άνδρας ο ασθενής ενδέχεται να έχει υψηλότερη ρίσκο για την καρδιακή ασθένεια παρά μια γυναίκα ασθενής.
Η τρίτη πιο σημαντική μεταβλητή είναι το επίπεδο γλυκόζης του ασθενή. Δηλαδή αν το επίπεδο γλυκόζης του ασθενή βρισκεταί ποσοτικά σε υψηλή θέση τότε οι πιθανότητες για μια καρδιακή ασθένεια ακμάζουν.
Η λιγότερη σημαντική μεταβλητή που δεν παίζει ρόλο για την μελλοντική ύπαρξη μιας καρδιακής ασθένειας του ασθενή είναι ο καρδιακός ρυθμός του ασθενή με την p-value του να είναι ένα εξωπραγματικό -0.98. Αυτό δείχνει ότι, παρ’όλες τις πιθανότητες ο ρυθμός της καρδίας δεν σχετίζεται με την σταδιακή δημιουργία ασθένειας της.
Η δεύτερη λιγότερη σημαντική μεταβλητή είναι το επίπεδο εκπαίδευσης του ασθενή το οποίο και βάση λογικής είναι απόλυτα προσιτό.
Η τρίτη μεταβλητή που δεν έχει τοσο μεγάλη σημασία ως προς την καλλιέργεια καρδιακής ασθένειας είναι αν κάποιος ασθενής έχει διαβήτη.
Προβλέψεις όσο αφορά το Test Set
Μετά το πέρας της δημιουργίας μοντέλου λογιστικής παληνδρόμησης θα εφαρμοστούν προβλέψεις στο Test Set. Για να βγούν οι συγκεκριμένες πιθανότητες έγινε χρήση της συνάρτησης predict().
library(caTools)
library(ROCR)
predictTest <- predict(model, newdata = CHDTest , type = "response")
head(predictTest)## 5 12 13 18 21 26
## 0.10086774 0.04902497 0.19438538 0.08544919 0.05894130 0.10859728Τα συμπεράσματα που προέκυψαν είναι τα εξής:
Όλες οι παρατηρήσεις που παρουσιάζονται εδώ είναι κάτω από την τίμη του συνηθές κατοφλίου το οποίο είναι 0.5. Δηλαδή όλοι οι ασθενέις που βρίσκονται στις συγκεκριμένες γραμμές του Test Set έχουν πιθανότητα λιγότερη του 20% να αποκτήσουν στο κοντινό μέλλον μια καρδιακή ασθένεια.
Η τιμή που είναι πιο ψηλά από τις άλλες βρίσκεται στην δέκατη τρίτη γραμμή με πιθανότητα 19.4%. Ωστόσο, δεν παύει να είναι μια χαμηλή πιθανότητα ο ασθενής αυτός να πάθει μια καρδιακή ασθένεια στο μέλλον. Η πρόβλεψη αυτή δεν σημειώνεται σαν σημαντική.
Η τιμή που είναι πιο χαμηλά από τις άλλες βρίσκεται στην δωδέκατη γραμμή με πιθανότητα 4.9%. Η πρόβλεψη αυτή είναι η πιό ασύμαντη και ο ασθενής τείνει περισσότερο στην κατηγορία του 0 δηλαδή να μην έχει καρδιακή ασθένεια σε 10 χρόνια.
Ο λόγος που οι πιθανότητες του μοντέλου είναι γενικά χαμηλές μπορεί να οφείλεται στο ότι το μοντέλο έχει δυσκολευτεί να αναγνωρίσει τους ασθενείς με την πιθανότητα να έχουν μια καρδιακή ασθένεια σε 10 χρόνια. Συνολικά, η ακρίβεια του μοντέλου δεν συμπίπτει με το επιθυμητό αποτέλεσμα που μπορεί και να συμβεί αυτό ορισμένες φορές στην πρόβλεψη τέτοιων μοντέλων.
Δημιουργία δεύτερου μοντέλου λογιστικής παλινδρόμησης
Στο δεύτερο μοντέλο λογιστικής παλινδρόμησης θα ακολουθήσουμε την ίδια διαδικασία με το πρώτο απλώς θα δούμε τι επίδραση θα έχει αν αφαιρέσουμε δύο μεταβλητές με υψηλό significance οπώς είναι το κάπνισμα (currentSmoker and cigsPerDay) στο αποτέλεσμα της πρόβλεψης για την στεφανιαία νόσο.
library(caTools)
library(ROCR)
model2 <- glm(TenYearCHD ~ . - currentSmoker - cigsPerDay, data = CHDTrain, family = "binomial")
summary(model2)##
## Call:
## glm(formula = TenYearCHD ~ . - currentSmoker - cigsPerDay, family = "binomial",
## data = CHDTrain)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.052340 0.870905 -9.246 < 2e-16 ***
## male 0.649761 0.125197 5.190 2.10e-07 ***
## age 0.051455 0.007998 6.434 1.24e-10 ***
## education -0.017517 0.060627 -0.289 0.77263
## BPMeds 0.161713 0.294108 0.550 0.58243
## prevalentStroke 0.401281 0.615658 0.652 0.51453
## prevalentHyp 0.337085 0.168250 2.003 0.04513 *
## diabetes 0.182450 0.383033 0.476 0.63384
## totChol 0.002397 0.001404 1.707 0.08785 .
## sysBP 0.009957 0.004769 2.088 0.03681 *
## diaBP 0.007545 0.008136 0.927 0.35375
## BMI 0.009792 0.015366 0.637 0.52397
## heartRate -0.002639 0.005303 -0.498 0.61869
## glucose 0.007642 0.002896 2.639 0.00832 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2029.8 on 2370 degrees of freedom
## Residual deviance: 1810.1 on 2357 degrees of freedom
## (385 observations deleted due to missingness)
## AIC: 1838.1
##
## Number of Fisher Scoring iterations: 5Απο τα αποτελέσματα του summary κατανοούμε τα εξής:
- Οι μεταβλητές που έχουν την σημαντικότερη επίδραση στην παρουσίαση μιας στεφανιαίας νόσου τα επόμενα 10 χρόνια παραμένουν οι ίδιες.
2.Οι μεταβλητές που έχουν την λιγότερη επίδραση στην παρουσίαση μιας στεφανιαίας νόσου τα επόμενα 10 χρόνια παραμένουν οι ίδιες.
- Δέν υπάρχουν ιδιαίτερα σημαντικές αλλαγές στις ενδείξεις των τιμών p-value παρά μόνο στην τιμή του φύλου με την τιμή από 3.60 να μεταμορφόνεται σε 5.19.
Προβλέψεις όσο αφορά το Test Set
Εφαρμόζουμε προβλέψεις βάσει του test set του δεύτερου μοντέλου λογιστικής παλινδρόμησης.
library(caTools)
library(ROCR)
predictTest2 <- predict(model2, newdata = CHDTest , type = "response")
summary(predictTest2)## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.01476 0.07170 0.12694 0.15859 0.21240 0.87939 187head(predictTest2)## 5 12 13 18 21 26
## 0.07761474 0.05909781 0.19778616 0.06778039 0.03944547 0.09592203Τα συμπεράσματα είναι τα ίδια με το πρώτο μοντέλο λογιστικής παλινδρόμησης που έχει εφαρμοστεί.
Δημιουργία του confusion matrix του δεύτερου μοντέλου γραμμικής παλινδρόμησης
Θα δημιουργήσουμε το confusion matrix του δεύτερου μοντέλου ούτως ώστε στη συνέχεια να το εφαρμόσουμε στην κατασκευή της καμπύλης AUC
library(caTools)
library(ROCR)
table(CHDTest$TenYearCHD, predictTest2 > 0.5)##
## FALSE TRUE
## 0 1092 9
## 1 183 13- Υπολογισμός μετρικών confusion matrix:
cat("Overall Acuraccy: ", sum((1092 + 13)/1484))## Overall Acuraccy: 0.7446092cat("Sensitivity: ", sum(13/(13 + 183)))## Sensitivity: 0.06632653cat("Specifity: ", sum(1092/(1092 + 9)))## Specifity: 0.9918256cat("Overall Error Rate:", sum((9 + 183)/1484))## Overall Error Rate: 0.1293801cat("False Negative Error Rate:", sum(183/(13 + 183)))## False Negative Error Rate: 0.9336735cat("False Positive Error Rate:", sum(9/(1092 + 9)))## False Positive Error Rate: 0.008174387Τα παραπάνω αποτελέσματα μας οδηγούν στα πιο κάτω συμπεράσματα:
Η γενική ακρίβεια του μοντέλου στο test set βρίσκεται στο 74%. Αυτό μας δείχνει ότι βρίσκεται σε ένα καλό σημείο πιό πάνω από το threshold αλλά αυτό δεν σημαίνει πάντα ότι η προβλέψεις είναι όλες σωστές.
Η ευαισθησία του μοντέλου βρίσκεται στο 7% πράγμα που το καθιστά καθόλου ελαστικό.
Το μοντέλο μας δείχνει μια ιδιαιτερότητα 99% και αυτό οφείλεται μάλλον στην γενική ακρίβεια που είναι πιο υψηλή από το κατώφλι.
Ο γενικός δείχτης σφαλμάτων βρίσκεται στο 13% πράγμα που σημαίνει ότι το μοντέλο δεν υπαίστει σχεδόν καθόλου σφάλματα.
Ο γενικός δείχτης σφαλμάτων False Negative προωθήτε στο 93% κανόντας το πολύ αξιόλογο.
Ο γενικός δείχτης σφαλμάτων False Positive είναι 0%.
Δημιουργία καμπύλης Area Of Curve (AUC)
library(caTools)
library(ROCR)
CHDTrain2 = na.omit(CHDTrain)
CHDTest2 = na.omit(CHDTest)
model3 <- glm(TenYearCHD ~ . - currentSmoker - cigsPerDay, data = CHDTrain2, family = "binomial")
predictTest3 <- predict(model3, newdata = CHDTest2 , type = "response")
ROCRpred <- prediction(predictTest3, CHDTest2$TenYearCHD)
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
plot(ROCRperf,colorize = TRUE,main = "ROC Curve")
AUC <- as.numeric(performance(ROCRpred, "auc")@y.values)
cat("Δείχτης AUC: ", round(AUC,2))## Δείχτης AUC: 0.74Τα συμπεράσματα που παρατηρούνται είναι τα εξής:
Το AUC βρίσκεται στο 0,74 πράγμα που σημαίνει ότι το μοντέλο μπορεί να καταλάβει πιοί ασθενείς έχουν μεγαλύτερο κίνδυνο εκδήλωσης καρδιακής ασθένειας και πιοί όχι. Έχει ικανοποιητική απόδοση.
Από την ROC καμπύλη φαίνεται ότι η απόδοση του μοντέλου είναι σταθερή και αποδοτική βάσει των διαφόρων κατοφλίων που αποδύδει.