Build and deploy a stroke prediction model using R
Kenneth Paul Nodado
2023-09-22
About Data Analysis Report
This RMarkdown file contains the report of the data analysis done for the project on building and deploying a stroke prediction model in R. It contains analysis such as data exploration, summary statistics and building the prediction models. The final report was completed on Fri Sep 22 09:29:36 2023.
Data Description:
According to the World Health Organization (WHO) stroke is the 2nd leading cause of death globally, responsible for approximately 11% of total deaths.
This data set is used to predict whether a patient is likely to get stroke based on the input parameters like gender, age, various diseases, and smoking status. Each row in the data provides relevant information about the patient.
Task One: Import data and data preprocessing
Load data and install packages
if(!require('tidyverse')){
install.packages('tidyverse')
library('tidyverse')
}## Loading required package: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif(!require('lubridate')){
install.packages('lubridate')
library('lubridate')
}if(!require('ggplot2')){
install.packages('ggplot2')
library('ggplot2')
}if(!require('dplyr')){
install.packages('dplyr')
library('dplyr')
}if(!require('caret')) {
install.packages('caret')
library('caret')
}## Loading required package: caret## Loading required package: lattice##
## Attaching package: 'caret'## The following object is masked from 'package:purrr':
##
## liftif(!require('randomForest')) {
install.packages('randomForest')
library('randomForest')
}## Loading required package: randomForest## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginif(!require('skimr')) {
install.packages('skimr')
library('skimr')
}## Loading required package: skimrif(!require('gridExtra')) {
install.packages('gridExtra')
library('gridExtra')
}## Loading required package: gridExtra##
## Attaching package: 'gridExtra'## The following object is masked from 'package:randomForest':
##
## combine## The following object is masked from 'package:dplyr':
##
## combineif(!require('caTools')) {
install.packages('caTools')
library('caTools')
}## Loading required package: caToolsif(!require('corrplot')) {
install.packages('corrplot')
library('corrplot')
}## Loading required package: corrplot## corrplot 0.92 loadedif(!require('ggcorrplot')) {
install.packages('ggcorrplot')
library('ggcorrplot')
}## Loading required package: ggcorrplotif(!require('naniar')){
install.packages('naniar')
library('naniar')
}## Loading required package: naniar##
## Attaching package: 'naniar'## The following object is masked from 'package:skimr':
##
## n_complete##import files
setwd("C:/Users/kenne/Desktop/StrokePredictionCaseStudy/StrokePrediction")
Data_Stroke <- read.csv('healthcare-dataset-stroke-data.csv')Describe and explore the data
summary(Data_Stroke)## id gender age hypertension
## Min. : 67 Length:5110 Min. : 0.08 Min. :0.00000
## 1st Qu.:17741 Class :character 1st Qu.:25.00 1st Qu.:0.00000
## Median :36932 Mode :character Median :45.00 Median :0.00000
## Mean :36518 Mean :43.23 Mean :0.09746
## 3rd Qu.:54682 3rd Qu.:61.00 3rd Qu.:0.00000
## Max. :72940 Max. :82.00 Max. :1.00000
## heart_disease ever_married work_type Residence_type
## Min. :0.00000 Length:5110 Length:5110 Length:5110
## 1st Qu.:0.00000 Class :character Class :character Class :character
## Median :0.00000 Mode :character Mode :character Mode :character
## Mean :0.05401
## 3rd Qu.:0.00000
## Max. :1.00000
## avg_glucose_level bmi smoking_status stroke
## Min. : 55.12 Length:5110 Length:5110 Min. :0.00000
## 1st Qu.: 77.25 Class :character Class :character 1st Qu.:0.00000
## Median : 91.89 Mode :character Mode :character Median :0.00000
## Mean :106.15 Mean :0.04873
## 3rd Qu.:114.09 3rd Qu.:0.00000
## Max. :271.74 Max. :1.00000glimpse(Data_Stroke)## Rows: 5,110
## Columns: 12
## $ id <int> 9046, 51676, 31112, 60182, 1665, 56669, 53882, 10434…
## $ gender <chr> "Male", "Female", "Male", "Female", "Female", "Male"…
## $ age <dbl> 67, 61, 80, 49, 79, 81, 74, 69, 59, 78, 81, 61, 54, …
## $ hypertension <int> 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1…
## $ heart_disease <int> 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0…
## $ ever_married <chr> "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "Yes", "No…
## $ work_type <chr> "Private", "Self-employed", "Private", "Private", "S…
## $ Residence_type <chr> "Urban", "Rural", "Rural", "Urban", "Rural", "Urban"…
## $ avg_glucose_level <dbl> 228.69, 202.21, 105.92, 171.23, 174.12, 186.21, 70.0…
## $ bmi <chr> "36.6", "N/A", "32.5", "34.4", "24", "29", "27.4", "…
## $ smoking_status <chr> "formerly smoked", "never smoked", "never smoked", "…
## $ stroke <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…skim(Data_Stroke)| Name | Data_Stroke |
| Number of rows | 5110 |
| Number of columns | 12 |
| _______________________ | |
| Column type frequency: | |
| character | 6 |
| numeric | 6 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| gender | 0 | 1 | 4 | 6 | 0 | 3 | 0 |
| ever_married | 0 | 1 | 2 | 3 | 0 | 2 | 0 |
| work_type | 0 | 1 | 7 | 13 | 0 | 5 | 0 |
| Residence_type | 0 | 1 | 5 | 5 | 0 | 2 | 0 |
| bmi | 0 | 1 | 2 | 4 | 0 | 419 | 0 |
| smoking_status | 0 | 1 | 6 | 15 | 0 | 4 | 0 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| id | 0 | 1 | 36517.83 | 21161.72 | 67.00 | 17741.25 | 36932.00 | 54682.00 | 72940.00 | ▇▇▇▇▇ |
| age | 0 | 1 | 43.23 | 22.61 | 0.08 | 25.00 | 45.00 | 61.00 | 82.00 | ▅▆▇▇▆ |
| hypertension | 0 | 1 | 0.10 | 0.30 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| heart_disease | 0 | 1 | 0.05 | 0.23 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
| avg_glucose_level | 0 | 1 | 106.15 | 45.28 | 55.12 | 77.24 | 91.88 | 114.09 | 271.74 | ▇▃▁▁▁ |
| stroke | 0 | 1 | 0.05 | 0.22 | 0.00 | 0.00 | 0.00 | 0.00 | 1.00 | ▇▁▁▁▁ |
miss_scan_count(data = Data_Stroke, search = list("Unknown","N/A","Other"))## # A tibble: 12 × 2
## Variable n
## <chr> <int>
## 1 id 0
## 2 gender 1
## 3 age 0
## 4 hypertension 0
## 5 heart_disease 0
## 6 ever_married 0
## 7 work_type 0
## 8 Residence_type 0
## 9 avg_glucose_level 0
## 10 bmi 201
## 11 smoking_status 1544
## 12 stroke 0##Convert NA to median in BMI
Data_Stroke$bmi <- as.numeric(Data_Stroke$bmi)## Warning: NAs introduced by coercionidx <- complete.cases(Data_Stroke)
bmi_idx <- is.na(Data_Stroke$bmi)
median_bmi <- median(Data_Stroke$bmi, na.rm = TRUE)
Data_Stroke[bmi_idx,]$bmi <- median_bmi
colSums(is.na(Data_Stroke))## id gender age hypertension
## 0 0 0 0
## heart_disease ever_married work_type Residence_type
## 0 0 0 0
## avg_glucose_level bmi smoking_status stroke
## 0 0 0 0##Check duplicates
sum(duplicated(Data_Stroke))## [1] 0colSums(Data_Stroke == 'N/A')## id gender age hypertension
## 0 0 0 0
## heart_disease ever_married work_type Residence_type
## 0 0 0 0
## avg_glucose_level bmi smoking_status stroke
## 0 0 0 0colSums(Data_Stroke == '')## id gender age hypertension
## 0 0 0 0
## heart_disease ever_married work_type Residence_type
## 0 0 0 0
## avg_glucose_level bmi smoking_status stroke
## 0 0 0 0Data_Stroke %>% count(gender)## gender n
## 1 Female 2994
## 2 Male 2115
## 3 Other 1##Remove ID and filter out 'Other' values in Gender
Data_Stroke <- Data_Stroke %>%
select(-c(id)) %>%
filter(gender != "Other")
str(Data_Stroke)## 'data.frame': 5109 obs. of 11 variables:
## $ gender : chr "Male" "Female" "Male" "Female" ...
## $ age : num 67 61 80 49 79 81 74 69 59 78 ...
## $ hypertension : int 0 0 0 0 1 0 1 0 0 0 ...
## $ heart_disease : int 1 0 1 0 0 0 1 0 0 0 ...
## $ ever_married : chr "Yes" "Yes" "Yes" "Yes" ...
## $ work_type : chr "Private" "Self-employed" "Private" "Private" ...
## $ Residence_type : chr "Urban" "Rural" "Rural" "Urban" ...
## $ avg_glucose_level: num 229 202 106 171 174 ...
## $ bmi : num 36.6 28.1 32.5 34.4 24 29 27.4 22.8 28.1 24.2 ...
## $ smoking_status : chr "formerly smoked" "never smoked" "never smoked" "smokes" ...
## $ stroke : int 1 1 1 1 1 1 1 1 1 1 ...##Convert non-numeric variables to factors
Data_Stroke$stroke <- factor(Data_Stroke$stroke, levels = c(0,1), labels = c("No", "Yes"))
Data_Stroke$hypertension <- factor(Data_Stroke$hypertension, levels = c(0,1), labels = c("No", "Yes"))
Data_Stroke$heart_disease <- factor(Data_Stroke$heart_disease, levels = c(0,1), labels = c("No", "Yes"))Task Two: Build prediction models
d1 <- Data_Stroke %>%
ggplot(aes(x = gender, fill = gender)) +
geom_bar(fill = c("red", "blue")) +
ggtitle("Gender Distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
d2 <- Data_Stroke %>%
ggplot(aes(x = hypertension, fill = hypertension)) +
geom_bar(fill = c("red", "blue")) +
ggtitle("Hypertenstion Distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
d3 <- Data_Stroke %>%
ggplot(aes(x = heart_disease, fill = heart_disease)) +
geom_bar(fill = c("red", "blue")) +
ggtitle("Heart Disease Distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
d4 <- Data_Stroke %>%
ggplot(aes(x = ever_married, fill = ever_married)) +
geom_bar(fill = c("red","blue")) +
ggtitle("Married distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
d5 <- Data_Stroke %>%
ggplot(aes(x = work_type, fill = work_type)) +
geom_bar(fill = c("red", "blue","green","orange","aquamarine")) +
ggtitle("Work type distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
d6 <- Data_Stroke %>%
ggplot(aes(x = stroke, fill = stroke)) +
geom_bar(fill = c("red", "blue")) +
ggtitle("Stroke distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
d7 <- Data_Stroke %>%
ggplot(aes(x = Residence_type, fill = Residence_type)) +
geom_bar(fill = c("red", "blue")) +
ggtitle("Residence distribution") +
geom_text(aes(label=..count..), stat = "Count", vjust = 1.0)
grid.arrange(d1,d2,d3,d4,d5,d6,d7, ncol=2)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Data_Stroke %>%
ggplot(aes(x = gender, fill = stroke)) +
geom_bar(position = "fill") +
scale_fill_manual(values=c("aquamarine3",
"blueviolet")) +
ggtitle("Gender vs. Stroke") 
Data_Stroke %>%
ggplot(aes(x = hypertension, fill = stroke)) +
geom_bar(position = "fill") +
scale_fill_manual(values=c("aquamarine3",
"blueviolet")) +
ggtitle("Hypertension vs. Stroke")
Data_Stroke %>%
ggplot(aes(x = heart_disease, fill = stroke)) +
geom_bar(position = "fill") +
scale_fill_manual(values=c("aquamarine3",
"blueviolet")) +
ggtitle("Heart disease vs. Stroke") 
Data_Stroke %>%
ggplot(aes(x = Residence_type, fill = stroke)) +
geom_bar(position = "fill") +
scale_fill_manual(values=c("aquamarine3",
"blueviolet")) +
ggtitle("Residence type vs. Stroke")
Data_Stroke %>%
ggplot(aes(x = smoking_status, fill = stroke)) +
geom_bar(position = "fill") +
scale_fill_manual(values=c("aquamarine3",
"blueviolet")) +
ggtitle("Smoking status vs. Stroke")
Data_Stroke %>%
ggplot(aes(x = work_type, fill = stroke)) +
geom_bar(position = "fill") +
scale_fill_manual(values=c("aquamarine3",
"blueviolet"
)) +
ggtitle("Type of Work vs. Stroke")
Data_Stroke %>%
ggplot(aes(x = avg_glucose_level, fill = stroke)) +
geom_density(alpha = 0.7) +
scale_fill_manual(values=c("aquamarine3",
"blueviolet"
)) +
ggtitle("Average Glucose level vs. Stroke") 
Data_Stroke %>% filter(between(bmi, 0, 60)) %>%
ggplot(aes(x = bmi, fill = stroke)) +
geom_density(alpha = 0.7) +
scale_fill_manual(values=c("aquamarine3",
"blueviolet"
)) +
ggtitle("Body Mass Index vs. Stroke")
#grid.arrange(desc1,desc2,desc3,desc4, ncol = 4) #grid.arrange(p1,p2,
ncol = 2) #grid.arrange(m1,m2,ncol = 2)
# Task Three: Evaluate and select prediction models
```r
sample.split(Data_Stroke$stroke,SplitRatio = 0.8)->split_tag
train<-subset(Data_Stroke,split_tag==TRUE)
test<-subset(Data_Stroke,split_tag==FALSE)
dim(train)## [1] 4087 11dim(test)## [1] 1022 11Task Four: Deploy the prediction model
set.seed(123)
rf <- randomForest(formula = stroke~.,data = train)
rf##
## Call:
## randomForest(formula = stroke ~ ., data = train)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 3
##
## OOB estimate of error rate: 4.99%
## Confusion matrix:
## No Yes class.error
## No 3883 5 0.001286008
## Yes 199 0 1.000000000plot(rf)
confusionMatrix(predict(rf,test),test$stroke)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 972 50
## Yes 0 0
##
## Accuracy : 0.9511
## 95% CI : (0.936, 0.9635)
## No Information Rate : 0.9511
## P-Value [Acc > NIR] : 0.5375
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 4.219e-12
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9511
## Neg Pred Value : NaN
## Prevalence : 0.9511
## Detection Rate : 0.9511
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : No
## Task Five: Findings and Conclusions
As depicted above, our model boasts an accuracy rate exceeding 95%, indicating that it underwent effective training.