About dataset

Data source:

File name: StrokeDataRepositoryFinal.xlsx

URL: https://dataverse.harvard.edu/file.xhtml?fileId=10123155&version=2.0

Dataset contains clinical data collected from Crouse Hospital ED records, covering incidents from January 2019 to January 2021. Tabular data with 1731 rows (each row representing a patient record) and 35 columns. These include quantitative variables (e.g., lab results like Blood Glucose, Systolic Extraction, LDL, as well as patient’s Age and Days in Hospital), ordinal variables (e.g., Blood Pressure Category, NIHSS Score) and categorical (mostly related to medical history, such as Diabetes Indicator, Hyperlipidemia, as well as Race, Gender, Stroke Type).

Dataset analysis

Load dataset

#load stroke dataset
stroke = read_csv("stroke.csv") 
## Rows: 1731 Columns: 35
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (28): numberOfVisits, strokeTypeType, disChargeDisposition, gender, race...
## dbl  (7): daysInHospital, age, systolicExtractionBP, bloodGlucose, LDL, hemo...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Create subset of stroke dataset with predictor variables

# Create subset of stroke dataframe
stroke_sub <- stroke %>% select (daysInHospital,disChargeDisposition, strokeTypeType, age, gender, race, previousStroke,
                                 systolicExtractionBP, bloodGlucose, LDL,
                                 hemoglobinA1C, smokingStatus, hyperlipidemia, 
                                 diabetes, finalNIHS,  tPaAdministrated , under4_5_hoursForTPa)

Check NA values

  # visualise NA values
  stroke_sub %>% vis_dat()

  # missing data
  stroke_sub %>% vis_miss()

Convert columns into factor or numeric datatype and format values.

Patients who died due to stroke should be marked as Expired. Patients discharges to home or 2nd facility should be marked as Discharged.

# change patient discharge status
stroke_sub <- stroke_sub %>% 
  mutate(disChargeDisposition = ifelse(disChargeDisposition != "Expired", "Discharged", disChargeDisposition ))

Check and clean outliers. Check finalNIHS NAs. Stroke severity is crucial factor to predict stroke outcome. Incorrect imputation might lead to wrong prediction outcomes.

# mark patients  hyperlipidemia = x to Yes, other values to No
stroke_sub <- stroke_sub %>% 
  mutate(hyperlipidemia = case_when(hyperlipidemia == "x" ~ "Yes", is.na(hyperlipidemia) ~"No" ))

# mark patients  diabetes = x to Yes, other values to No
stroke_sub <- stroke_sub %>% 
  mutate(diabetes = case_when(diabetes == "x" ~ "Yes", is.na(diabetes) ~"No" ))

#remove records where finalNIHS is NA 
stroke_sub <- stroke_sub %>% filter(!is.na(finalNIHS))

Convert categorical values into factors and show basic statistical summary

# change columns types to factors
factor_cols <- c("strokeTypeType", "gender", "race",   "smokingStatus", "previousStroke",
                  "disChargeDisposition",  "diabetes", "hyperlipidemia", "under4_5_hoursForTPa")

stroke_sub[factor_cols] <- lapply(stroke_sub[factor_cols],  function(x) factor(trimws(as.character(x))))

stroke_sub$tPaAdministrated <- factor(trimws(as.character(stroke_sub$tPaAdministrated)))

# view statistical summary of dataset
stroke_sub %>% select(finalNIHS, daysInHospital, 
         systolicExtractionBP, bloodGlucose, LDL, age, hemoglobinA1C) %>%
  summary()
##    finalNIHS      daysInHospital systolicExtractionBP  bloodGlucose 
##  Min.   : 0.000   Min.   : 0.0   Min.   : 74.0        Min.   :  44  
##  1st Qu.: 0.000   1st Qu.: 1.0   1st Qu.:134.0        1st Qu.:  98  
##  Median : 2.000   Median : 3.0   Median :151.0        Median : 115  
##  Mean   : 4.878   Mean   : 4.2   Mean   :150.6        Mean   : 138  
##  3rd Qu.: 6.000   3rd Qu.: 5.0   3rd Qu.:166.0        3rd Qu.: 147  
##  Max.   :40.000   Max.   :28.0   Max.   :262.0        Max.   :1207  
##                                  NA's   :3            NA's   :11    
##       LDL              age         hemoglobinA1C   
##  Min.   :  5.00   Min.   : 15.00   Min.   : 3.500  
##  1st Qu.: 68.00   1st Qu.: 63.00   1st Qu.: 5.500  
##  Median : 94.00   Median : 73.00   Median : 6.100  
##  Mean   : 99.56   Mean   : 72.17   Mean   : 6.703  
##  3rd Qu.:125.00   3rd Qu.: 83.00   3rd Qu.: 7.300  
##  Max.   :367.00   Max.   :102.00   Max.   :15.600  
##  NA's   :127                       NA's   :684

75% of patients stay in hospital less than 5 days. Maximum hospital stay is 28 days. Prolonged hospital stay is related to severe neurological outcomes.

# view statistical summary of dataset
stroke_sub %>% select(strokeTypeType,
          tPaAdministrated,  disChargeDisposition, diabetes, hyperlipidemia) %>%
  summary()
##     strokeTypeType tPaAdministrated disChargeDisposition diabetes 
##  Hemorrhage: 117   No :1475         Discharged:1538      No :665  
##  Ischemic  :1239   Yes: 174         Expired   : 111      Yes:984  
##  TIA       : 293                                                  
##  hyperlipidemia
##  No :813       
##  Yes:836       
##

Ischemic stroke type is most common with 1263 patients diagnosed out of 1733.

Remove outliers

# remove outliers with bloodGlucose > 1000
stroke_sub <- stroke_sub %>% filter(bloodGlucose < 1000)

Visualize the relationship between stroke severity, inpatient days and other variables. Mark patient discharge status with different colors.

# Distribution of continuous numerical variables
stroke_sub %>% 
  select(finalNIHS, daysInHospital, 
         systolicExtractionBP, bloodGlucose, LDL, age, hemoglobinA1C, disChargeDisposition) %>% 
  drop_na() %>%
  ggpairs(aes(color = disChargeDisposition, alpha = 0.5)) 
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

There is a positive correlation between NIH stroke severity (finalNIHS) and the number of inpatient days (daysInHospital). Older patients tend to have higher stroke severity, and those with more severe strokes show a higher mortality rate. The systolic blood pressure (systolicExtractionBP), blood glucose, and hemoglobin A1C levels are positively correlated with stroke severity among patients who expired. This suggests that individuals with diabetes, hyperlipidemia, and hypertension are at higher risk of experiencing severe strokes.

# Distribution of categorical variables
stroke_sub %>% 
  select(finalNIHS, daysInHospital,  strokeTypeType,
          tPaAdministrated,  disChargeDisposition) %>% 
  drop_na() %>%
  ggpairs(aes(color = disChargeDisposition, alpha = 0.5)) 
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Time plays a crucial role in the outcome of ischemic stroke. Tissue Plasminogen Activator (tPA) is an effective medication that should be administered within 4.5 hours of stroke onset. In the graph above, we observe that the median stroke severity among patients who expired is higher than the median severity among those who received tPA.

Previous stroke is an another risk factor of stroke severity and outcome.

# plot hospital stay days for patients with and without previous stroke
ggplot(stroke_sub, aes(x = previousStroke, y = daysInHospital, fill = disChargeDisposition)) +
  geom_boxplot() +
  facet_wrap(~disChargeDisposition) +
  labs(title = "Hospital Stay Days by Previous Stroke and Discharge Status", x = "Previous Stroke", y = "Days in Hospital")

From the boxplot, we observe that the overall hospital stay is longer for expired patients than for discharged ones. Among expired patients, both the median and interquartile range (IQR) are higher for those with a previous stroke. For discharged patients, previous stroke status does not make a significant difference, suggesting that other factors may play a more decisive role in their outcomes.

# Box plot with age groups on x-axis and color by smoking status
stroke_sub %>% filter(!is.na(smokingStatus) & !is.na(age)) %>%
  mutate(age_group = cut(age, breaks = seq(0, 110, by = 10), right = FALSE)) %>%
ggplot( aes(x = age_group, y = finalNIHS, fill = smokingStatus)) +
  geom_boxplot(position = position_dodge(width = 0.8)) +
  labs(
    title = "NIHSS Score by Age Group and Smoking Status",
    x = "Age Group",
    y = "Stroke severity (NIHSS)",
    fill = "Smoking Status"
  ) +
  theme_minimal()

Current and Former smokers Stroke severity score is higher after 40 years old.