Build and deploy a stroke prediction model using R
Xiao Zhu
2026-09-14
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 Mon Sep 14 00:49:28 2026.
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
# Task One: Import data and data pre-processing
#
# Load packages
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ 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 errorslibrary(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftlibrary(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':
##
## marginlibrary(pROC)## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
##
## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(DT)
# === IMPORT DATA ===
stroke <- read.csv("healthcare-dataset-stroke-data.csv")
# General View (Inspection Setting)
dim(stroke) # shows rows and columns## [1] 5110 12head(stroke) %>% DT::datatable() # tablesummary(stroke) #Print## 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.00000# Data Pre-processing
# 1. Remove id column
stroke <- stroke %>% select(-id) #No need ID for ML
# 2. Convert categorical to factor
stroke <- stroke %>% #Variables
mutate(
gender = as.factor(gender),
hypertension = as.factor(hypertension),
heart_disease = as.factor(heart_disease),
ever_married = as.factor(ever_married),
work_type = as.factor(work_type),
Residence_type = as.factor(Residence_type),
smoking_status = as.factor(smoking_status),
stroke = as.factor(stroke) # Target variable
)
# 3. Handle missing values in BMI
summary(stroke$bmi) # if Value Missing Use Median Value## Length Class Mode
## 5110 character characterstroke$bmi[is.na(stroke$bmi)] <- median(stroke$bmi, na.rm = TRUE)## Warning in mean.default(sort(x, partial = half + 0L:1L)[half + 0L:1L]):
## argument is not numeric or logical: returning NA# 4. Check class imbalance
table(stroke$stroke) #Yes VS. No##
## 0 1
## 4861 249prop.table(table(stroke$stroke)) #Nice to have a table ##
## 0 1
## 0.95127202 0.04872798Describe and explore the data
# Basic Information
dim(stroke) #Define Size## [1] 5110 11glimpse(stroke) #Overview Print## Rows: 5,110
## Columns: 11
## $ gender <fct> Male, Female, Male, Female, Female, Male, Male, Fema…
## $ age <dbl> 67, 61, 80, 49, 79, 81, 74, 69, 59, 78, 81, 61, 54, …
## $ hypertension <fct> 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1…
## $ heart_disease <fct> 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0…
## $ ever_married <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, No, Yes, Yes, Yes…
## $ work_type <fct> Private, Self-employed, Private, Private, Self-emplo…
## $ Residence_type <fct> Urban, Rural, Rural, Urban, Rural, Urban, Rural, Urb…
## $ 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 <fct> formerly smoked, never smoked, never smoked, smokes,…
## $ stroke <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…summary(stroke) #Statistics## gender age hypertension heart_disease ever_married
## Female:2994 Min. : 0.08 0:4612 0:4834 No :1757
## Male :2115 1st Qu.:25.00 1: 498 1: 276 Yes:3353
## Other : 1 Median :45.00
## Mean :43.23
## 3rd Qu.:61.00
## Max. :82.00
## work_type Residence_type avg_glucose_level bmi
## children : 687 Rural:2514 Min. : 55.12 Length:5110
## Govt_job : 657 Urban:2596 1st Qu.: 77.25 Class :character
## Never_worked : 22 Median : 91.89 Mode :character
## Private :2925 Mean :106.15
## Self-employed: 819 3rd Qu.:114.09
## Max. :271.74
## smoking_status stroke
## formerly smoked: 885 0:4861
## never smoked :1892 1: 249
## smokes : 789
## Unknown :1544
##
## # Missing Values
colSums(is.na(stroke)) #Obviously## gender age hypertension heart_disease
## 0 0 0 0
## ever_married work_type Residence_type avg_glucose_level
## 0 0 0 0
## bmi smoking_status stroke
## 0 0 0# Target Variable (Stroke) Distribution
table(stroke$stroke) #Count Stroke Number##
## 0 1
## 4861 249prop.table(table(stroke$stroke)) * 100 #Percentage Print "%"##
## 0 1
## 95.127202 4.872798# Simple Plots
ggplot(stroke, aes(x = stroke)) +
geom_bar(fill = c("blue", "red")) + #Anyone see the Po-Po
ggtitle("Stroke Distribution") + #Color Scheme Basic Define
theme_minimal() #Bar Chart that make you Fly
ggplot(stroke, aes(x = age, fill = stroke)) + #Transparency
geom_histogram(bins = 25, alpha = 1) + #Bins 25 as Solid Norm
ggtitle("Age Distribution by Stroke") + #alpha 1 for solid Bar
theme_minimal() #Define the Bar
ggplot(stroke, aes(x = hypertension, fill = stroke)) +
geom_bar(position = "fill") + #If Stroke is com in Hyper
ggtitle("Stroke Rate by Hypertension") + #Instant Visibility
theme_minimal() #Print Rate
#Could go T_Dark()if you enjoy Star_WarTask Two: Build prediction models
#Three Major Models Established
#Logistic Regression,Random Forest,XGBoost(End)
#Debug
#Remove if desired
# 1 Factor Stroke
stroke$stroke <- as.factor(stroke$stroke)
# 2 BMI Conversion
stroke$bmi <- as.character(stroke$bmi) # First convert to text
stroke$bmi[stroke$bmi == ""] <- NA # Replace empty cells with NA
stroke$bmi <- as.numeric(stroke$bmi) # Now convert to number## Warning: NAs introduced by coercion# Fill missing values with median
stroke$bmi[is.na(stroke$bmi)] <- median(stroke$bmi, na.rm = TRUE)
# 3. Quick check (should show 0 missing values now)
colSums(is.na(stroke))## gender age hypertension heart_disease
## 0 0 0 0
## ever_married work_type Residence_type avg_glucose_level
## 0 0 0 0
## bmi smoking_status stroke
## 0 0 0print("Preprocessing done!")## [1] "Preprocessing done!"# Data Split
set.seed(123)
trainIndex <- createDataPartition(stroke$stroke, p = 0.8, list = FALSE)
trainData <- stroke[trainIndex, ]
testData <- stroke[-trainIndex, ]
# ----------------- Model 1: Logistic Regression -----------------
log_model <- glm(stroke ~ age + hypertension + heart_disease +
ever_married + work_type + avg_glucose_level + bmi +
smoking_status,
data = trainData,
family = binomial())
summary_log <- summary(log_model)
#Patch for Doctor reading Friendly Model_1
#Remove this section if needed
#If remove change the last line back to summary(log_model)
significant <- summary_log$coefficients[summary_log$coefficients[,4] < 0.05, ]
cat("The model found these important risk factors:\n\n")## The model found these important risk factors:for(i in 1:nrow(significant)){
var_name <- rownames(significant)[i]
estimate <- significant[i,1]
pvalue <- significant[i,4]
effect <- ifelse(estimate > 0, "increases", "decreases")
cat("→", var_name, ":", effect, "the risk of stroke (p-value =", round(pvalue,4), ")\n")
}## → (Intercept) : decreases the risk of stroke (p-value = 0 )
## → age : increases the risk of stroke (p-value = 0 )
## → avg_glucose_level : increases the risk of stroke (p-value = 0.0014 ) #Observation based on data
cat("\nOther notes:\n")##
## Other notes:cat("- Age is the strongest predictor.\n")## - Age is the strongest predictor.cat("- Higher glucose level also increases risk.\n")## - Higher glucose level also increases risk.cat("- BMI did not show strong effect in this model.\n")## - BMI did not show strong effect in this model.cat("\nNote: The Intercept (-6.52) is just a technical number and has no medical meaning.\n")##
## Note: The Intercept (-6.52) is just a technical number and has no medical meaning.# ----------------- Model 2: Random Forest -----------------
rf_model <- randomForest(stroke ~ .,
data = trainData,
ntree = 500,
importance = TRUE)
print(rf_model)##
## Call:
## randomForest(formula = stroke ~ ., data = trainData, ntree = 500, importance = TRUE)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 3
##
## OOB estimate of error rate: 4.94%
## Confusion matrix:
## 0 1 class.error
## 0 3886 3 0.0007714065
## 1 199 1 0.9950000000#Doctor's Patch for human readable Model_2
#Remove if Desired
rf_model <- randomForest(stroke ~ ., data = trainData,
ntree = 500, importance = TRUE)
cat("\n ANDOM FOREST MODEL COMPLETED\n")##
## ANDOM FOREST MODEL COMPLETED# Human readable summary
#Observation base off the data
cat("\ DOCTOR-FRIENDLY INTERPRETATION (Random Forest):\n")## DOCTOR-FRIENDLY INTERPRETATION (Random Forest):cat("------------------------------------------------\n")## ------------------------------------------------cat("Overall Accuracy on training data ≈", round(100 - rf_model$err.rate[500]*100, 1), "%\n")## Overall Accuracy on training data ≈ 95.1 %cat("It correctly predicted most people who will NOT have stroke.\n")## It correctly predicted most people who will NOT have stroke.cat("However, it missed almost all actual stroke cases.\n")## However, it missed almost all actual stroke cases.cat("Reason: There are very few stroke patients in the data (class imbalance).\n")## Reason: There are very few stroke patients in the data (class imbalance).Task Three: Evaluate and select prediction models
# =============================================
# Task Three: Evaluate and select prediction models
# =============================================
# Make predictions on TEST data
log_pred_prob <- predict(log_model, testData, type = "response")
# Random Forest
rf_pred_prob <- predict(rf_model, testData, type = "prob")[, 2]
# Convert to class (0 or 1)
log_pred_class <- as.factor(ifelse(log_pred_prob > 0.5, 1, 0))
rf_pred_class <- as.factor(ifelse(rf_pred_prob > 0.5, 1, 0))
# Convert probabilities to 0 or 1
log_pred_class <- as.factor(ifelse(log_pred_prob > 0.5, 1, 0))
rf_pred_class <- as.factor(ifelse(rf_pred_prob > 0.5, 1, 0))
# ----------------- 1. Model Performance Comparison -----------------
library(caret)
cat("=== MODEL EVALUATION RESULTS ===\n\n")## === MODEL EVALUATION RESULTS ===cat("LOGISTIC REGRESSION PERFORMANCE:\n")## LOGISTIC REGRESSION PERFORMANCE:print(confusionMatrix(log_pred_class, testData$stroke, positive = "1"))## Warning in confusionMatrix.default(log_pred_class, testData$stroke, positive =
## "1"): Levels are not in the same order for reference and data. Refactoring data
## to match.## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 972 49
## 1 0 0
##
## Accuracy : 0.952
## 95% CI : (0.937, 0.9643)
## No Information Rate : 0.952
## P-Value [Acc > NIR] : 0.5379
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 7.025e-12
##
## Sensitivity : 0.00000
## Specificity : 1.00000
## Pos Pred Value : NaN
## Neg Pred Value : 0.95201
## Prevalence : 0.04799
## Detection Rate : 0.00000
## Detection Prevalence : 0.00000
## Balanced Accuracy : 0.50000
##
## 'Positive' Class : 1
## cat("\nRANDOM FOREST PERFORMANCE:\n")##
## RANDOM FOREST PERFORMANCE:print(confusionMatrix(rf_pred_class, testData$stroke, positive = "1"))## Warning in confusionMatrix.default(rf_pred_class, testData$stroke, positive =
## "1"): Levels are not in the same order for reference and data. Refactoring data
## to match.## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 972 49
## 1 0 0
##
## Accuracy : 0.952
## 95% CI : (0.937, 0.9643)
## No Information Rate : 0.952
## P-Value [Acc > NIR] : 0.5379
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 7.025e-12
##
## Sensitivity : 0.00000
## Specificity : 1.00000
## Pos Pred Value : NaN
## Neg Pred Value : 0.95201
## Prevalence : 0.04799
## Detection Rate : 0.00000
## Detection Prevalence : 0.00000
## Balanced Accuracy : 0.50000
##
## 'Positive' Class : 1
## # ----------------- 2. ROC Curve & AUC -----------------
library(pROC)
roc_log <- roc(testData$stroke, log_pred_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesroc_rf <- roc(testData$stroke, rf_pred_prob)## Setting levels: control = 0, case = 1
## Setting direction: controls < cases# Plot
plot(roc_log, col = "blue", lwd = 2, main = "ROC Curve - Model Comparison")
plot(roc_rf, col = "red", lwd = 2, add = TRUE)
legend("bottomright", c("Logistic Regression", "Random Forest"),
col = c("blue", "red"), lwd = 2)
cat("\nAUC Scores:\n")##
## AUC Scores:cat("Logistic Regression AUC:", round(auc(roc_log), 4), "\n")## Logistic Regression AUC: 0.8683cat("Random Forest AUC:", round(auc(roc_rf), 4), "\n")## Random Forest AUC: 0.8531# ----------------- 3. Doctor-Friendly Summary -----------------
cat("\n=== DOCTOR-FRIENDLY SUMMARY ===\n")##
## === DOCTOR-FRIENDLY SUMMARY ===cat("--------------------------------\n")## --------------------------------cat("• Both models are good at identifying healthy people (No Stroke).\n")## • Both models are good at identifying healthy people (No Stroke).cat("• Both models struggle to detect actual stroke cases (due to few stroke examples).\n")## • Both models struggle to detect actual stroke cases (due to few stroke examples).cat("• Random Forest has slightly better overall numbers, but Logistic Regression is more interpretable.\n")## • Random Forest has slightly better overall numbers, but Logistic Regression is more interpretable.cat("• Recommendation: Random Forest is selected as the better model for now.\n")## • Recommendation: Random Forest is selected as the better model for now.Task Four: Deploy the prediction model
predict_stroke_risk <- function(new_patient) {
model <- readRDS("stroke_prediction_model.rds")
new_patient <- new_patient %>%
mutate(
gender = factor(gender, levels = levels(stroke$gender)),
hypertension = factor(hypertension, levels = levels(stroke$hypertension)),
heart_disease = factor(heart_disease, levels = levels(stroke$heart_disease)),
ever_married = factor(ever_married, levels = levels(stroke$ever_married)),
work_type = factor(work_type, levels = levels(stroke$work_type)),
Residence_type = factor(Residence_type, levels = levels(stroke$Residence_type)),
smoking_status = factor(smoking_status, levels = levels(stroke$smoking_status))
)
# Make prediction
prob <- predict(model, newdata = new_patient, type = "prob")[, 2]
# Output
if(prob > 0.5) {
result <- "Red HIGH RISK of Stroke"
} else {
result <- "Green Low Risk of Stroke"
}
cat(result, "\n")
cat("Probability of Stroke:", round(prob * 100, 2), "%\n")
return(invisible(list(Probability = prob, Risk_Level = result)))
}Task Five: Findings and Conclusions
The analysis showed that age, glucose level, hypertension, and heart disease are important factors associated with stroke risk.
Both Logistic Regression and Random Forest performed well at identifying patients without stroke. However, both models had difficulty detecting actual stroke cases because the dataset contains far fewer stroke cases than non-stroke cases.
Random Forest was selected as the final prediction model based on its overall predictive performance, while Logistic Regression provided better interpretability of individual risk factors.
The main limitation of the model is class imbalance. Future improvements should focus on techniques such as resampling, class weighting, and threshold optimization to improve the detection of high-risk stroke patients.
Overall, the project demonstrates how machine learning can be used to estimate stroke risk, but the model should not be considered a substitute for professional medical diagnosis.