Περιγραφή του Dataset

Το Framingham Heart Study dataset περιέχει πληροφορίες από συμμετέχοντες σε μία μακροχρόνια μελέτη πρόληψης καρδιαγγειακών παθήσεων. Κάθε γραμμή αντιπροσωπεύει ένα άτομο και οι στήλες είναι χαρακτηριστικά που σχετίζονται με τον καρδιαγγειακό κίνδυνο.

Περιγραφή Δεδομένων

Το dataset περιλαμβάνει 15 χαρακτηριστικά για κάθε συμμετέχοντα, όπως: Ηλικία: Η ηλικία του ατόμου. Φύλο: Άνδρας ή γυναίκα. Επίπεδα χοληστερόλης: Συνολικά επίπεδα χοληστερόλης στο αίμα. Αρτηριακή πίεση: Συστολική και διαστολική πίεση. Κάπνισμα: Αν καπνίζει το άτομο ή όχι. BMI: Δείκτης Μάζας Σώματος. Γλυκόζη: Επίπεδα γλυκόζης στο αίμα. TenYearCHD: Αν το άτομο ανέπτυξε καρδιοπάθεια μέσα σε 10 χρόνια.

Βήμα 1: Εισαγωγή Βιβλιοθηκών και Δεδομένων

library(caTools)
## Warning: package 'caTools' was built under R version 4.4.3
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.4.3
data <- read.csv("C:/Users/Tasos/Downloads/framingham.csv")
str(data)
## 'data.frame':  4240 obs. of  16 variables:
##  $ male           : int  1 0 1 0 0 0 0 0 1 1 ...
##  $ age            : int  39 46 48 61 46 43 63 45 52 43 ...
##  $ education      : int  4 2 1 3 3 2 1 2 1 1 ...
##  $ currentSmoker  : int  0 0 1 1 1 0 0 1 0 1 ...
##  $ cigsPerDay     : int  0 0 20 30 23 0 0 20 0 30 ...
##  $ BPMeds         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ prevalentStroke: int  0 0 0 0 0 0 0 0 0 0 ...
##  $ prevalentHyp   : int  0 0 0 1 0 1 0 0 1 1 ...
##  $ diabetes       : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ totChol        : int  195 250 245 225 285 228 205 313 260 225 ...
##  $ sysBP          : num  106 121 128 150 130 ...
##  $ diaBP          : num  70 81 80 95 84 110 71 71 89 107 ...
##  $ BMI            : num  27 28.7 25.3 28.6 23.1 ...
##  $ heartRate      : int  80 95 75 65 85 77 60 79 76 93 ...
##  $ glucose        : int  77 76 70 103 85 99 85 78 79 88 ...
##  $ TenYearCHD     : int  0 0 0 1 0 0 1 0 0 0 ...
summary(data)
##       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

Βήμα 2: Διαχωρισμός Δεδομένων

Χωρίζουμε τυχαία τα δεδομένα σε training set (75%) και test set (25%) για να εκπαιδεύσουμε και να αξιολογήσουμε το μοντέλο μας.

  set.seed(922)
  split <- sample.split(data$TenYearCHD, SplitRatio = 0.75)
  train <- subset(data, split == TRUE)
  test <- subset(data, split == FALSE)
  
  nrow(train)
## [1] 3180
  nrow(test)
## [1] 1060

Βήμα 3: Δημιουργία Μοντέλου

Εδώ δημιουργούμε το λογιστικό μοντέλο, χρησιμοποιώντας όλες τις ανεξάρτητες μεταβλητές

  model <- glm(TenYearCHD ~ ., data = train, family = "binomial")
  summary(model)
## 
## Call:
## glm(formula = TenYearCHD ~ ., family = "binomial", data = train)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)     -7.888947   0.822393  -9.593  < 2e-16 ***
## male             0.576737   0.125738   4.587 4.50e-06 ***
## age              0.055384   0.007703   7.190 6.46e-13 ***
## education       -0.070534   0.057549  -1.226  0.22033    
## currentSmoker   -0.065219   0.182417  -0.358  0.72070    
## cigsPerDay       0.018880   0.007192   2.625  0.00866 ** 
## BPMeds           0.090316   0.265242   0.341  0.73348    
## prevalentStroke  0.692132   0.572757   1.208  0.22688    
## prevalentHyp     0.293913   0.158768   1.851  0.06414 .  
## diabetes         0.454542   0.346394   1.312  0.18945    
## totChol          0.003292   0.001283   2.567  0.01026 *  
## sysBP            0.014033   0.004419   3.176  0.00149 ** 
## diaBP           -0.001259   0.007588  -0.166  0.86822    
## BMI              0.003647   0.014744   0.247  0.80465    
## heartRate       -0.003324   0.004791  -0.694  0.48787    
## glucose          0.005033   0.002516   2.001  0.04543 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2345.9  on 2755  degrees of freedom
## Residual deviance: 2078.5  on 2740  degrees of freedom
##   (424 observations deleted due to missingness)
## AIC: 2110.5
## 
## Number of Fisher Scoring iterations: 5

Παπαρατηρούμε τις τιμές p-value — αν είναι κάτω από 0.05, θεωρούμε ότι η μεταβλητή έχει σημαντική συσχέτιση. Στην περίπτωσή μας οι σημαντικές είναι cigsPerDay και sysBP

Βήμα 4: Προβλέψεις στο Test Set και Train Set

Τώρα κάνουμε προβλέψεις στο test set και Train Set.

  predictTest <- predict(model, type = "response", new = test)
  predictTrain <- predict(model, type = "response")
  head(predictTest)
##          4          5         10         20         25         26 
## 0.31122141 0.09132529 0.24844745 0.07188210 0.21965737 0.10423828
  head(predictTrain)
##          1          2          3          6          7          8 
## 0.04019244 0.05256122 0.15168502 0.13426969 0.16810319 0.06464907

Παρατηρήσεις

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