1. Introduction

This project uses simulated hospital data to build a model predicting the likelihood of patient readmission within 30 days after discharge. It demonstrates a full data science workflow using R: from data generation and exploration to model building and evaluation.

2. Load and Prepare Data

# Load cleaned data
patient_data <- read_csv("data/patient_data_clean.csv")
## Rows: 1000 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (5): sex, admission_type, primary_diagnosis, discharge_disposition, read...
## dbl (5): patient_id, age, comorbidity_count, length_of_stay, prior_admissions
## 
## ℹ 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.
# Convert relevant columns to factors
patient_data <- patient_data %>%
  mutate(across(
    c(sex, admission_type, primary_diagnosis, discharge_disposition, readmitted_30_days),
    as.factor
  ))

glimpse(patient_data)
## Rows: 1,000
## Columns: 10
## $ patient_id            <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1…
## $ age                   <dbl> 66, 82, 42, 35, 66, 64, 41, 88, 54, 37, 43, 20, …
## $ sex                   <fct> Male, Male, Female, Female, Female, Female, Fema…
## $ admission_type        <fct> Urgent, Emergency, Emergency, Urgent, Emergency,…
## $ primary_diagnosis     <fct> COPD, COPD, Diabetes, Pneumonia, Kidney Disease,…
## $ comorbidity_count     <dbl> 5, 6, 2, 0, 6, 2, 1, 4, 0, 5, 5, 1, 0, 0, 2, 3, …
## $ length_of_stay        <dbl> 4, 11, 6, 6, 5, 4, 1, 9, 4, 3, 4, 7, 6, 8, 6, 5,…
## $ discharge_disposition <fct> Transferred, Transferred, Transferred, Home, Dec…
## $ prior_admissions      <dbl> 2, 1, 5, 5, 5, 0, 2, 5, 1, 1, 4, 1, 3, 5, 0, 3, …
## $ readmitted_30_days    <fct> Yes, Yes, No, Yes, No, No, No, No, No, No, No, N…

3. Exploratory Data Analysis

3.1 Age Distribution

ggplot(patient_data, aes(x = age)) +
  geom_histogram(binwidth = 5, fill = "steelblue", color = "white") +
  labs(title = "Age Distribution of Patients", x = "Age", y = "Count")

3.2 Readmission by Diagnosis

patient_data %>%
  count(primary_diagnosis, readmitted_30_days) %>%
  ggplot(aes(x = primary_diagnosis, y = n, fill = readmitted_30_days)) +
  geom_col(position = "dodge") +
  labs(title = "Readmission by Diagnosis", x = "Diagnosis", y = "Count") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

3.3 Comorbidities and Readmission Risk

ggplot(patient_data, aes(x = comorbidity_count, fill = readmitted_30_days)) +
  geom_bar(position = "fill") +
  labs(title = "Comorbidities and Readmission Risk", x = "# of Comorbidities", y = "Proportion") +
  scale_y_continuous(labels = scales::percent)

3.4 Length of Stay by Admission Type

ggplot(patient_data, aes(x = admission_type, y = length_of_stay, fill = admission_type)) +
  geom_boxplot() +
  labs(title = "Length of Stay by Admission Type", x = "Admission Type", y = "Days") +
  theme(legend.position = "none")

3.5 Readmission by Age Group

patient_data %>%
  mutate(age_group = cut(age, breaks = c(18, 30, 45, 60, 75, 90), right = FALSE)) %>%
  count(age_group, readmitted_30_days) %>%
  ggplot(aes(x = age_group, y = n, fill = readmitted_30_days)) +
  geom_col(position = "dodge") +
  labs(title = "Readmission Rate by Age Group", x = "Age Group", y = "Count")

4. Model Building

4.1 Split Data

set.seed(123)
train_index <- createDataPartition(patient_data$readmitted_30_days, p = 0.8, list = FALSE)
train_data <- patient_data[train_index, ]
test_data <- patient_data[-train_index, ]

4.2 Train Logistic Regression Model

model <- train(
  readmitted_30_days ~ age + sex + admission_type + primary_diagnosis +
    comorbidity_count + length_of_stay + prior_admissions,
  data = train_data,
  method = "glm",
  family = "binomial"
)

summary(model$finalModel)
## 
## Call:
## NULL
## 
## Coefficients:
##                                    Estimate Std. Error z value Pr(>|z|)  
## (Intercept)                       -0.997116   0.442508  -2.253   0.0242 *
## age                                0.002905   0.004386   0.662   0.5078  
## sexMale                           -0.177619   0.176181  -1.008   0.3134  
## admission_typeEmergency           -0.145475   0.222457  -0.654   0.5131  
## admission_typeUrgent              -0.058937   0.244151  -0.241   0.8092  
## primary_diagnosisDiabetes          0.059944   0.260989   0.230   0.8183  
## `primary_diagnosisHeart Failure`  -0.225737   0.284474  -0.794   0.4275  
## `primary_diagnosisKidney Disease` -0.048435   0.265691  -0.182   0.8553  
## primary_diagnosisPneumonia        -0.008623   0.278628  -0.031   0.9753  
## comorbidity_count                  0.009215   0.043678   0.211   0.8329  
## length_of_stay                    -0.019338   0.044619  -0.433   0.6647  
## prior_admissions                  -0.092873   0.053282  -1.743   0.0813 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 814.77  on 800  degrees of freedom
## Residual deviance: 808.51  on 789  degrees of freedom
## AIC: 832.51
## 
## Number of Fisher Scoring iterations: 4

5. Model Evaluation

5.1 Confusion Matrix

predictions <- predict(model, newdata = test_data)
conf_matrix <- confusionMatrix(predictions, test_data$readmitted_30_days)
conf_matrix
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  No Yes
##        No  158  41
##        Yes   0   0
##                                           
##                Accuracy : 0.794           
##                  95% CI : (0.7311, 0.8479)
##     No Information Rate : 0.794           
##     P-Value [Acc > NIR] : 0.5417          
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : 4.185e-10       
##                                           
##             Sensitivity : 1.000           
##             Specificity : 0.000           
##          Pos Pred Value : 0.794           
##          Neg Pred Value :   NaN           
##              Prevalence : 0.794           
##          Detection Rate : 0.794           
##    Detection Prevalence : 1.000           
##       Balanced Accuracy : 0.500           
##                                           
##        'Positive' Class : No              
##

5.2 ROC Curve and AUC

prob_predictions <- predict(model, newdata = test_data, type = "prob")
actual_binary <- ifelse(test_data$readmitted_30_days == "Yes", 1, 0)
predicted_prob <- prob_predictions[, "Yes"]

roc_obj <- roc(actual_binary, predicted_prob)
## Setting levels: control = 0, case = 1
## Setting direction: controls > cases
plot(roc_obj, main = "ROC Curve")

auc(roc_obj)
## Area under the curve: 0.4927

6. Conclusion

This logistic regression model provides a data-driven way to estimate 30-day hospital readmission risk based on patient characteristics. The analysis shows how variables like comorbidity count, diagnosis, and admission type influence readmission outcomes. The model’s ROC curve and AUC suggest it performs well and can support proactive care decisions if applied in real settings.