Η παρούσα εργασία εκπονήθηκε στο πλαίσιο του μαθήματος Επιχειρηματικής Αναλυτικής, το οποίο διδάσκεται στο 8ο εξάμηνο του Τμήματος Εφαρμοσμένης Πληροφορικής του Πανεπιστημίου Μακεδονίας. Στόχος της εργασίας είναι η εφαρμογή στατιστικής ανάλυσης και η αξιοποίηση της μεθόδου της λογιστικής παλινδρόμησης σε ένα επιλεγμένο σύνολο δεδομένων.
Το σύνολο δεδομένων είναι δημόσια διαθέσιμο στον ιστότοπο του Kaggle και προέρχεται από μια συνεχιζόμενη καρδιαγγειακή μελέτη σε κατοίκους της πόλης Framingham της Μασαχουσέτης. Ο στόχος της ταξινόμησης είναι να προβλεφθεί εάν ο ασθενής έχει 10ετή κίνδυνο μελλοντικής στεφανιαίας νόσου (CHD). Το σύνολο δεδομένων παρέχει τις πληροφορίες των ασθενών. Περιλαμβάνει πάνω από 4.000 αρχεία και 15 χαρακτηριστικά.
Στο παρόν έγγραφο, παρουσιάζεται αρχικά η δομή των δεδομένων, ακολουθεί η στατιστική ανάλυση και η οπτικοποίηση βασικών χαρακτηριστικών, ενώ στη συνέχεια εφαρμόζεται μοντέλο γραμμικής παλινδρόμησης για την επιλογή των σημαντικότερων μεταβλητών. Σκοπός είναι η ελαχιστοποίηση του σφάλματος και η βελτίωση της προβλεπτικής ικανότητας του μοντέλου.
Ο παρακάτω πίνακας παρουσιάζει τα βασικά χαρακτηριστικά του συνόλου δεδομένων που χρησιμοποιήθηκε στην ανάλυση. Κάθε χαρακτηριστικό αποτελεί έναν πιθανό παράγοντα κινδύνου περιλαμβάνοντας δημογραφικά, συμπεριφολογικά και ιατρικά παράγοντες.
| Χαρακτηριστικό | Περιγραφή |
|---|---|
| Demographic: | |
Sex |
male or female(Nominal) |
Age |
Age of the patient;(Continuous - Although the recorded ages have been truncated to whole numbers, the concept of age is continuous). |
| Behavioral: | |
Current Smoker |
whether or not the patient is a current smoker (Nominal). |
Cigs Per Day |
the number of cigarettes that the person smoked on average in one day.(can be considered continuous as one can have any number of cigarettes, even half a cigarette.). |
| Medical (History): | |
BP Meds |
whether or not the patient was on blood pressure medication (Nominal) |
Prevalent Stroke |
whether or not the patient had previously had a stroke (Nominal) |
Prevalent Hyp |
whether or not the patient was hypertensive (Nominal). |
Diabetes |
whether or not the patient had diabetes (Nominal) |
| Medical (Current): | |
Tot Chol |
total cholesterol level (Continuous) |
Sys BP |
systolic blood pressure (Continuous) |
Dia BP |
diastolic blood pressure (Continuous) |
BMI |
Body Mass Index (Continuous) |
Heart Rate |
heart rate (Continuous - In medical research, variables such as heart rate though in fact discrete, yet are considered continuous because of large number of possible values.) |
Glucose |
glucose level (Continuous) |
| Predict Variable: | |
10 year risk of coronary heart disease CHD |
(binary: “1”, means “Yes”, “0” means “No”) |
| male | age | education | currentSmoker | cigsPerDay | BPMeds | prevalentStroke | prevalentHyp | diabetes | totChol | sysBP | diaBP | BMI | heartRate | glucose | TenYearCHD |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 39 | 4 | 0 | 0 | 0 | 0 | 0 | 0 | 195 | 106.0 | 70 | 26.97 | 80 | 77 | 0 |
| 0 | 46 | 2 | 0 | 0 | 0 | 0 | 0 | 0 | 250 | 121.0 | 81 | 28.73 | 95 | 76 | 0 |
| 1 | 48 | 1 | 1 | 20 | 0 | 0 | 0 | 0 | 245 | 127.5 | 80 | 25.34 | 75 | 70 | 0 |
| 0 | 61 | 3 | 1 | 30 | 0 | 0 | 1 | 0 | 225 | 150.0 | 95 | 28.58 | 65 | 103 | 1 |
| 0 | 46 | 3 | 1 | 23 | 0 | 0 | 0 | 0 | 285 | 130.0 | 84 | 23.10 | 85 | 85 | 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.003 Mean :0.02963 Mean :0.005899 Mean :0.3105
## 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.00
## 1st Qu.:0.00000 1st Qu.:206.0 1st Qu.:117.0 1st Qu.: 75.00
## Median :0.00000 Median :234.0 Median :128.0 Median : 82.00
## Mean :0.02572 Mean :236.7 Mean :132.4 Mean : 82.89
## 3rd Qu.:0.00000 3rd Qu.:263.0 3rd Qu.:144.0 3rd Qu.: 89.88
## Max. :1.00000 Max. :696.0 Max. :295.0 Max. :142.50
## NA's :50
## BMI heartRate glucose TenYearCHD
## Min. :15.54 Min. : 44.00 Min. : 40.00 Min. :0.000
## 1st Qu.:23.07 1st Qu.: 68.00 1st Qu.: 71.00 1st Qu.:0.000
## Median :25.40 Median : 75.00 Median : 78.00 Median :0.000
## Mean :25.80 Mean : 75.88 Mean : 81.97 Mean :0.152
## 3rd Qu.:28.04 3rd Qu.: 83.00 3rd Qu.: 87.00 3rd Qu.:0.000
## Max. :56.80 Max. :143.00 Max. :394.00 Max. :1.000
## NA's :19 NA's :1 NA's :388| Missing_Values | Absolute | |
|---|---|---|
| male | 0 % | 0 |
| age | 0 % | 0 |
| education | 0.0247758376592732 % | 105 |
| currentSmoker | 0 % | 0 |
| cigsPerDay | 0.00684285040113261 % | 29 |
| BPMeds | 0.0125058990089665 % | 53 |
| prevalentStroke | 0 % | 0 |
| prevalentHyp | 0 % | 0 |
| diabetes | 0 % | 0 |
| totChol | 0.0117980179329873 % | 50 |
| sysBP | 0 % | 0 |
| diaBP | 0 % | 0 |
| BMI | 0.00448324681453516 % | 19 |
| heartRate | 0.000235960358659745 % | 1 |
| glucose | 0.0915526191599811 % | 388 |
| TenYearCHD | 0 % | 0 |
## [1] "645 total empty values"Παρατηρούμε πως υπάρχουν κενές τιμές na που πρέπει
αφαιρεθούν.
clean_framingham <- na.omit(framingham)
print(paste(nrow(framingham) - nrow(clean_framingham) , "rows removed"))## [1] "582 rows removed"library(caTools)## Warning: package 'caTools' was built under R version 4.4.3set.seed(983);
split_fra <- sample.split(clean_framingham$TenYearCHD, SplitRatio = 0.65)
train <- subset(clean_framingham, split_fra == TRUE)
test <- subset(clean_framingham, split_fra == FALSE)
print( paste(nrow(train), "rows of train set" ) )## [1] "2376 rows of train set"print( paste(nrow(test), "rows of test set" ) )## [1] "1280 rows of test set"# Build formula string
predictors <- paste(setdiff(names(framingham), "TenYearCHD"), collapse = " + ")
formula_str <- paste("TenYearCHD ~", predictors)
# Convert to formula and fit model
model <- glm(as.formula(formula_str), data = train, family = binomial)
summary(model)##
## Call:
## glm(formula = as.formula(formula_str), family = binomial, data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.726455 0.902628 -9.668 < 2e-16 ***
## male 0.550068 0.134604 4.087 4.38e-05 ***
## age 0.062443 0.008423 7.413 1.23e-13 ***
## education -0.021549 0.060805 -0.354 0.7230
## currentSmoker 0.098633 0.194824 0.506 0.6127
## cigsPerDay 0.019427 0.007826 2.482 0.0131 *
## BPMeds 0.164761 0.298861 0.551 0.5814
## prevalentStroke 0.460607 0.683340 0.674 0.5003
## prevalentHyp 0.122383 0.174650 0.701 0.4835
## diabetes 0.035800 0.428604 0.084 0.9334
## totChol 0.003452 0.001389 2.486 0.0129 *
## sysBP 0.019727 0.004843 4.073 4.63e-05 ***
## diaBP -0.008906 0.008101 -1.099 0.2716
## BMI 0.020240 0.016226 1.247 0.2123
## heartRate -0.005890 0.005264 -1.119 0.2631
## glucose 0.004901 0.002998 1.635 0.1021
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2028.0 on 2375 degrees of freedom
## Residual deviance: 1786.8 on 2360 degrees of freedom
## AIC: 1818.8
##
## Number of Fisher Scoring iterations: 5Στατιστικά σημαντικές μεταβλητές (p < 0.05):
| Μεταβλητή | Συντελεστής (Estimate) | p-τιμή (Pr(>|z|)) | Ερμηνεία |
|---|---|---|---|
| male | +0.550 | 4.38e-05 | Οι άντρες έχουν αυξημένη πιθανότητα |
| age | +0.062 | 1.23e-13 | Η ηλικία σχετίζεται θετικά με τον κίνδυνο |
| cigsPerDay | +0.019 | 0.0131 | Περισσότερα τσιγάρα αυξάνουν τον κίνδυνο |
| totChol | +0.003 | 0.0129 | Υψηλή ολική χοληστερίνη αυξάνει τον κίνδυνο |
| sysBP | +0.019 | 4.63e-05 | Η συστολική πίεση σχετίζεται θετικά |
predictTest <- predict(model, type = 'response', newdata = test)
kable(predictTest[1:10])| x |
|---|
| 0.0378918 |
| 0.1610080 |
| 0.0632276 |
| 0.2094808 |
| 0.0825888 |
| 0.0475649 |
| 0.1729154 |
| 0.0547690 |
| 0.0650213 |
| 0.1209629 |
Η συνάρτηση predict μας δείχνει την εκτιμώμενη
πιθανότητα το αποτέλεσμα της εξαρτημένης μεταβλητής μέσα στο όριο 0 έως
1.