R Shiny App for MIMIC-IV ICU Cohort

The Shiny app is a web application that allows users to interact with the MIMIC-IV ICU cohort data. The app provides two main functionalities:

1. Patient’s Summary Information: Users can select the type of summary information they want to view (Demographics, Lab Measurements, or Vitals) and then select the specific information they want to display (e.g., age, gender, heart rate, blood pressure, etc.). The app will generate a summary table and a plot of the selected information.

2. Patient’s ADT & ICU Stay Information: Users can enter a patient’s ID and view the patient’s admission, discharge, and transfer (ADT) information, as well as their ICU stay information. The app will display a timeline of the patient’s ADT events and ICU stay, as well as a summary table of the patient’s ICU stay.

The app is built using the Shiny package in R, which allows for the creation of interactive web applications directly from R code. The app connects to the MIMIC-IV database using the bigrquery package and retrieves the necessary data for display.

However, the app is not fully functional in this static environment, as it requires a live connection to the MIMIC-IV database to retrieve the data. To run the app and interact with the data, you can copy the code below and run it in your local R environment or on a Shiny server. And you will need to have access to the BigQuery MIMIC-IV database to retrieve the data.

Display machine information:

sessionInfo()

R version 4.3.1 (2023-06-16)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Sonoma 14.6.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: America/Los_Angeles
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
 [1] htmlwidgets_1.6.4 compiler_4.3.1    fastmap_1.2.0     cli_3.6.2        
 [5] tools_4.3.1       htmltools_0.5.8.1 rstudioapi_0.16.0 yaml_2.3.8       
 [9] rmarkdown_2.27    knitr_1.47        jsonlite_1.8.8    xfun_0.44        
[13] digest_0.6.35     rlang_1.1.4       evaluate_0.23    

Display my machine memory.

memuse::Sys.meminfo()

Totalram:    8.000 GiB 
Freeram:   109.656 MiB 

R Shiny App for MIMIC-IV ICU Cohort:

# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

# Load required libraries
library(shiny)
library(ggplot2)
library(readr)
library(bigrquery)
library(dbplyr)
library(dplyr)
library(stringr)
library(shinyWidgets)
library(shinyjs)

# Path to the service account token
satoken <- "biostat-203b-2024-winter-313290ce47a6.json"

# BigQuery authentication using service account
bq_auth(path = satoken)

# Connect to the BigQuery database `biostat-203b-2024-winter.mimic4_v2_2`
con_bq <- dbConnect(
  bigrquery::bigquery(),
  project = "biostat-203b-2024-winter",
  dataset = "mimic4_v2_2",
  billing = "biostat-203b-2024-winter"
)

# Load MIMIC-IV cohort data
mimic_icu_cohort <- read_rds("./mimic_icu_cohort.rds")

# Define UI for application
ui <- fluidPage(
  shinyjs::useShinyjs(),
  titlePanel("MIMIC-IV ICU Cohort"),
  tabsetPanel(
    tabPanel("Patient's Summary Information", 
             sidebarLayout(
               sidebarPanel(
                 selectInput("summary", "Patient's Summary Information", 
                             choices = c("Demographics", "Lab Measurements", "Vitals")),
                 conditionalPanel(
                   condition = "input.summary == 'Demographics'",
                   selectInput("demographics", "Demographics", 
                               choices = c("age_intime", "gender", "race", 
                                           "insurance", "marital_status", 
                                           "language"))
                 ),
                 conditionalPanel(
                   condition = "input.summary == 'Vitals'",
                   selectInput("vitals", "Vitals",
                               choices = c("respiratory_rate",
                                           "systolic_non_invasive_blood_pressure",
                                           "heart_rate",
                                           "temperature_in_Fahrenheit", 
                                           "diastolic_non_invasive_blood_pressure"
                               ))
                 )
               ),
               mainPanel(
                 plotOutput("selected_summary")
               )
             )
    ),
    tabPanel("Patient's ADT & ICU stay information", 
             sidebarLayout(
               sidebarPanel(
                 textInput("patient_id", "Patient ID", placeholder = "Enter patient ID...")
               ),
               mainPanel(
                 plotOutput("ADT_history"),
                 plotOutput("vitals_line_plot")
               )
             )
    )
  )
)

# Define server logic
server <- function(input, output, session) {
  
  output$selected_patient <- renderPrint({
    input$suggestion_select
  })
  
  output$selected_summary <- renderPlot({
    req(input$summary)  # Ensure input$summary has a value
    
    plot1 <- switch(input$summary,
                    "Demographics" = {
                      if (input$demographics == "race") {
                        ggplot(mimic_icu_cohort, 
                               aes_string(x = input$demographics)) +
                          geom_bar() +
                          labs(title = "Demographics statistics", 
                               x = input$demographics, 
                               y = "Count") +
                          theme_minimal() +
                          theme(axis.text.x = element_text(
                            angle = 90, vjust = 0.5, hjust = 1)) 
                      } else {
                        ggplot(mimic_icu_cohort, 
                               aes_string(x = input$demographics)) +
                          geom_bar() +
                          labs(title = "Demographics statistics", 
                               x = input$demographics, y = "Count") +
                          theme_minimal()
                      }
                    },
                    "Lab Measurements" = {
                      mimic_icu_cohort_long <- mimic_icu_cohort %>%
                        gather(key = "variable", value = "value", 
                               sodium, chloride, 
                               creatinine, potassium, 
                               glucose, bicarbonate)
                      ggplot(mimic_icu_cohort_long, 
                             aes(x = variable, y = value)) +
                        geom_boxplot() +
                        labs(title = "Lab Measurements statistics", 
                             x = "Lab Measurements", y = "Value") +
                        theme_minimal()
                    },
                    "Vitals" = {
                      ggplot(mimic_icu_cohort, 
                             aes_string(x = input$vitals)) +
                        geom_histogram() +
                        labs(title = "Vitals statistics", 
                             x = input$vitals, y = "Count") +
                        theme_minimal()
                    }
    )
    
    plot(plot1)
  })
  
  output$ADT_history <- renderPlot({
    req(input$patient_id)
    
    patient_id <- as.numeric(input$patient_id)
    
    race <- tbl(con_bq, "admissions") |>
      filter(subject_id == patient_id) |>
      collect() 
    
    demographics <- tbl(con_bq, "patients") |>
      filter(subject_id == patient_id) |>
      collect() |>
      mutate(race = tolower(race$race[1]))
    
    diagnoses_names <- tbl(con_bq, "d_icd_diagnoses") |>
      select(icd_code, icd_version, long_title) |>
      collect()
    
    top_3_diagnoses <- tbl(con_bq, "diagnoses_icd") |>
      filter(subject_id == patient_id) |>
      collect() |>
      left_join(diagnoses_names, by = c("icd_code" = "icd_code",
                                        "icd_version" = "icd_version")) |>
      group_by(long_title) |>
      summarise(freq = n()) |>
      arrange(desc(freq)) |>
      slice(1:3) 
    
    ADT <- tbl(con_bq, "transfers") |>
      filter(subject_id == patient_id) |>
      collect() |>
      filter(!is.na(careunit)) |>
      mutate(segment_thickness = if_else(
        str_detect(careunit, "(ICU|CCU)"), 10, 8))
    
    labevents <- tbl(con_bq, "labevents") |>
      select (subject_id, charttime) |>
      filter(subject_id == patient_id) |>
      distinct(subject_id, charttime) |>
      collect()
    
    icd_procedures <- tbl(con_bq, "d_icd_procedures") |>
      collect()
    
    procedures <- tbl(con_bq, "procedures_icd") |>
      filter(subject_id == patient_id) |>
      collect() |>
      left_join(icd_procedures, by = c("icd_code" = "icd_code",
                                       "icd_version" = "icd_version")) 
    
    procedures$chartdate <- as.POSIXct(procedures$chartdate)
    
    ggplot() +
      scale_x_datetime(name = "Calendar Time", 
                       limits = c(min(ADT$intime) - lubridate::days(1),
                                  max(ADT$outtime))) +
      scale_y_discrete(name = NULL, 
                       limits = c("Procedure", "Lab", "ADT")) +
      geom_point(data = procedures, 
                 aes(x = chartdate, 
                     y = "Procedure", 
                     shape = sub(",.*", "", long_title)),
                 size = 3) +
      scale_shape_manual(values = c(1:n_distinct(procedures$long_title))) +
      geom_point(data = labevents, 
                 aes(x = charttime, y = "Lab"), 
                 shape = 3, size = 2) +
      geom_segment(data = ADT, 
                   aes(x = intime, 
                       xend = outtime, 
                       y = "ADT", 
                       yend = "ADT", 
                       color = careunit, 
                       size = segment_thickness)) +
      theme_bw() +
      theme(legend.position = "bottom", 
            legend.box = "vertical", 
            legend.key.size = unit(0, "pt"),
            legend.text = element_text(size = 7)) +
      guides(color = guide_legend(title = "Care Unit", 
                                  ncol = 3,
                                  keywidth = 1),
             shape = guide_legend(title = "Procedure", 
                                  ncol = 2),
             size = FALSE) +
      labs(title = paste("Patient", demographics$subject_id[1], ", ",
                         demographics$gender[1], ", ",
                         demographics$anchor_age[1], "years old, ",
                         demographics$race[1]),
           subtitle = paste(top_3_diagnoses$long_title[1],
                            top_3_diagnoses$long_title[2],
                            top_3_diagnoses$long_title[3],
                            sep = "\n"))
  })
  
  output$vitals_line_plot <- renderPlot({
    req(input$patient_id)
    
    patient_id <- as.numeric(input$patient_id)
    
    items <- tbl(con_bq, "d_items") |>
      select(itemid, label, abbreviation) |>
      filter(abbreviation %in% c("HR", "NBPd", 
                                 "NBPs", "RR", 
                                 "Temperature F")) |>
      collect()
    
    chartevents <- tbl(con_bq, "chartevents") |>
      filter(subject_id == patient_id) |>
      filter(itemid %in% c(220045, 220179, 
                           220180, 220210, 
                           223761)) |>
      filter(subject_id == patient_id) |>
      select(-c(hadm_id, caregiver_id, storetime, warning)) |>
      collect() |>
      left_join(items, by = c("itemid" = "itemid")) 
    
    ggplot(chartevents,
           aes(x = charttime,
               y = valuenum,
               color = abbreviation)) +
      geom_point() +
      geom_line() +
      facet_grid(abbreviation ~ stay_id, scales = "free") +
      labs(title = paste("Patient", 
                         chartevents$subject_id[1], 
                         "ICU stays - Vitals"),
           x = "",
           y = "") +
      theme_light(base_size = 9) +
      theme(legend.position = "none") +
      guides(x = guide_axis(n.dodge = 2)) 
  })
}

# Run the application 
shinyApp(ui = ui, server = server)