Fisseha Berhane, PhD

Data Scientist

443-970-2353 fisseha@jhu.edu CV Resume Linkedin GitHub twitter twitter

US Hospitals Ranking Shiny App




This is my shiny app that helps to see the performances of various US hospitals in heart attack, heart failure and pneumonia. The data is from the Hospital Compare web site, which is run by the U.S. Department of Health and Human Services. You can download the data here.

Shiny is an R package that makes it easy to build interactive web apps straight from R. For a nice look and feel, we will use the shinydashboard package.

We are using 30-day mortality rates for heart attack, heart failure, and pneumonia for over 4,000 hospitals across the USA.

I have deployed the app to Rstuio, so you can give it a try.


You can get the code on GitHub.

We can select a state and outcome and see the best hospitals in the state. Further, we can select a hospital from the drop down menu and see its rank in the state and compare its performance with all hospitals across the nation.

The screenshot below shows the top ten best hospitals in heart attack in MD. We also see that Johns Hopkins Hospital is the best hospital in the state and the vertical line shows average 30-day death rate in the hospital. The histogram is the average 30-day death rate from all hospitals in the USA.



Similarly, the screenshot below shows top ten best hospitals in NY in pneumonia. In the histogram, we see that Jamaica Hospital Medical Center is ranked 114. When we change the state, the hospital drop down menu in the left shows all hospitals in the selected state. Then, we can select any hospital from the drop down menu to see what its rank is and where in the histogram the average 30-day death rate in the hospital lies.



Usually Shiny apps have at least two parts. A server.R, which is R script, and ui.R, which controls the look and feel of the user interface.

My server.R and ui.R codes are given below. You can download them to the same folder and try the app.

ur.R

In [ ]:
library(shiny)
library(shinydashboard)

outcome_data=read.csv("data/outcome-of-care-measures-of-Medicare-certfied hospitals.csv",stringsAsFactors = F)
outcome_data=outcome_data[outcome_data[,6]!='Not Available',]
outcome_data=outcome_data[outcome_data[,7]!='Not Available',]
outcome_data=outcome_data[outcome_data[,8]!='Not Available',]



dashboardPage(
  dashboardHeader(title="US Hospital Ranking"),
  
  dashboardSidebar(width = 200,
                   selectInput("state", 
                               label = em("Select State",style="text-align:center;color:#FFA319;font-size:100%"),
                               unique(outcome_data$State),selected = 'MD'), 
        
            selectInput("outcome", 
                               label = em("Select Outcome",style="text-align:center;color:#FFA319;font-size:100%"),
                               choices = c("heart failure","heart attack","pneumonia"),
                               selected = "heart attack"),
                   
      selectInput('columns',em('Choose Hospital',style="text-align:center;color:#FFA319;font-size:100%"),"",
                  selectize = FALSE,selected = '')  
    ),
    
 
  dashboardBody(   
    
    fluidRow(
      column(width = 7,
  
          plotOutput("myplot")),
     
      
      column(width = 5,
    
          h5(strong("Best Hospitals in the State",style="text-align:right;color:darkblue;font-size:100%")),
          
          div(tableOutput("table1"), style = "font-size:80%",collapsible = TRUE)))
   
    )
    )

server.R

In [ ]:
library(shiny)
library(ggplot2)
library(dplyr)    
library(tidyr)

outcome_data=read.csv("data/outcome-of-care-measures-of-Medicare-certfied hospitals.csv",stringsAsFactors = F)

names(outcome_data)=c('Hospital',"Address","City","State","ZIP","heart attack","heart failure","pneumonia")

outcome_data=outcome_data[outcome_data[,6]!='Not Available',]
outcome_data=outcome_data[outcome_data[,7]!='Not Available',]
outcome_data=outcome_data[outcome_data[,8]!='Not Available',]


outcome_data1 <- outcome_data%>% gather(Type, Deaths, -Hospital,-Address,-City,-State,-ZIP)
outcome_data1$Type=as.factor(outcome_data1$Type)
outcome_data1$Deaths=as.numeric(outcome_data1$Deaths)




shinyServer(function(input, output, session) {


  state<-reactive({
    input$state
  })
  

  
  hospital<-reactive({
    input$columns
  })
  

  
  
  
  outvar=reactive({
    mm=outcome_data$Hospital[outcome_data$State==state()]
    unique(mm)
  })
  
  
  observe({
    
    updateSelectInput(session,"columns",
                      choices=outvar())
  })
  
  
  deaths<- reactive({
    
    
    m=filter(outcome_data1, State==state(),Type==outcome(),Hospital==hospital())
    
    as.numeric(select(m,Deaths))
    
    
  })
  
  

  
  outcome<-reactive({
    input$outcome
  })
  

  
  best_in_this_state<-reactive({
    
    m=filter(outcome_data1, State==state(),Type==outcome())
    m=arrange(m,Deaths,Hospital)
    m=select(m,Hospital, City)
    m$Rank=rownames(m)
    m=select(m,Rank,Hospital,City)
    
    if(nrow(m)>9){
      m[1:10,]
    } else {m}
    
  })
  
  
  its_rank<-reactive({
    
    m=filter(outcome_data1, State==state(),Type==outcome())
    m=arrange(m,Deaths,Hospital)
    m=select(m,Hospital)
    m$Rank=rownames(m)
    m=select(m,Rank,Hospital)
    as.numeric(m$Rank[m$Hospital==hospital()])
  
    
  })
  
  
  
  output$table1 <- renderTable(best_in_this_state(),include.rownames=FALSE)
 
  color=c('#75a3a3','#999966','#79a6d2','#c68c53')
  

    
  
  output$myplot<-renderPlot({
    
    if(outcome()=="heart attack"){
      
      hist(as.numeric(outcome_data[, 6]),xlab="Deaths from heart attack",
           main ="Nationwide 30-day death rates from heart attack\n
           and performance of selected hospital",cex.lab=1,cex.axis=1,
           col=sample(color,1,replace=T),border='white',cex.main=1.2)
      abline(v=deaths(),col="red",lwd=2)
      
      text(1.25*mean(as.numeric(outcome_data[, 6]),na.rm=TRUE), 600, hospital(), col = "#660066",
           cex = 1)
      text(mean(as.numeric(outcome_data[, 7]),na.rm=TRUE), 500, paste0("Rank in ",state(),": ", its_rank()), col = "blue",cex=1)
      
    }
    
    else if(outcome()=="heart failure"){
      
      hist(as.numeric(outcome_data[, 7]),xlab="Deaths from heart failure",
           main ="Nationwide 30-day death rates from heart failure\n and performance of selected hospital",cex.lab=1,cex.axis=1,
           col=sample(color,1,replace=T),border='white',cex.main=1.2)
      abline(v=deaths(),col="red",lwd=2)
      text(1.25*mean(as.numeric(outcome_data[, 7]),na.rm=TRUE), 600, hospital(), col = "#660066",cex=1)
      text(1.5*mean(as.numeric(outcome_data[, 7]),na.rm=TRUE), 500, paste0("Rank in ",state(),": ", its_rank()), col = "blue",cex=1)
      
    }
    
    
    else if(outcome()=="pneumonia"){
      
      hist(as.numeric(outcome_data[, 8]),xlab="Deaths from pneumonia",
           main ="Nationwide 30-day death rates from pneumonia\n and performance of selected hospital",cex.lab=1,cex.axis=1,
           col=sample(color,1,replace=T),border='white',cex.main=1.2)
      abline(v=deaths(),col="red",lwd=2)
      text(1.25*mean(as.numeric(outcome_data[, 8]),na.rm=TRUE), 500, hospital(), col = "#660066",cex=1)
      
      text(1.5*mean(as.numeric(outcome_data[, 7]),na.rm=TRUE), 400, paste0("Rank in ",state(),": ", its_rank()), col = "blue",cex=1)
      
    }
  })
})
comments powered by Disqus