Merge pull request #20 from thibautjombart/tabsplit

Prettifying progress

app/R/custom_graphics.R

@@ -48,3 +48,14 @@ add_ribbon <- function(x, proj, ci = 0.95) {
                    ribbon_color = ribbon_color,
                    ribbon_quantiles = c(alpha / 2, 1 - (alpha  / 2)))
 }
+
+# color choices
+cmmid_color <- "#0D5257"
+lshtm_grey  <- "#A7A8AA"
+
+cmmid_pal <- function(n){
+
+  #colorRampPalette(colors = c("#FFB81C", "#FE5000"))(n)
+  colorRampPalette(colors = c("#00BF6F","#0D5257"))(n)
+
+}

app/R/plot_beds.R

@@ -26,15 +26,16 @@
 #' beds
 #' plot_beds(beds)
 
-plot_beds <- function(x, ...) {
+plot_beds <- function(x, title = NULL, ...) {
   plot(x,
        quantiles = c(.025, .5),
        ribbon = TRUE, ...) +
     ggplot2::theme_bw() +
+    ggplot2::theme(legend.position = "bottom") +
     large_txt +
     ggplot2::scale_x_date(date_label = "%d %b %y") +
     rotate_x +
-    ggplot2::labs(title = "Predicted bed occupancy",
+    ggplot2::labs(title = title,
                   x = NULL,
                   y = "Daily numbers of beds")
 }

app/R/plot_distribution.R

@@ -0,0 +1,25 @@
+#' Function to plot discretised duration distribution
+#'
+#' This function provides custom plots for the output of `distcrete`.
+#'
+#' @param los a length of stay distribution of class `distcrete`
+#' @param title a string to be added to the resulting ggplot
+#' 
+#' @author Sam Clifford
+#' 
+
+plot_distribution <- function(los, title = NULL) {
+    max_days <- max(1, los$q(.999))
+    days     <- 0:max_days
+    dat      <- data.frame(days = days,
+                           y    = los$d(days))
+
+    ggplot2::ggplot(data=dat,
+                    ggplot2::aes(x=days, y=y)) +
+        ggplot2::geom_col(fill = cmmid_color, width = 0.8) +
+        ggplot2::xlab("Days in hospital") +
+        ggplot2::ylab("Probability") +
+        ggplot2::ggtitle(title) +
+        ggplot2::theme_bw() +
+        large_txt 
+}

app/ack.md

@@ -0,0 +1,26 @@
+## Acknowledgements
+
+The named authors (TJ, ESN, MJ, OLPDW, GMK, RME, AJK, CABP, WJE) had the following sources of funding: 
+
+TJ receives funding from the Global Challenges Research Fund (GCRF) project 'RECAP' managed through RCUK and ESRC (ES/P010873/1), the UK Public Health Rapid Support Team funded by the United Kingdom Department of Health and Social Care and from the National Institute for Health Research (NIHR) - Health Protection Research Unit for Modelling Methodology. ESN receives funding from the Bill and Melinda Gates Foundation (grant number: OPP1183986). MJ receives funding from the Bill and Melinda Gates foundation (grant number: INV-003174) and the NIHR (grant numbers: 16/137/109 and HPRU-2012-10096). SRP receives funding  from the Bill and Melinda Gates Foundation (grant number: OPP1180644). RME receives funding from HDR UK (grant number: MR/S003975/1). SF is supported by a Sir Henry Dale Fellowship jointly funded by the Wellcome Trust and the Royal Society (Grant number 208812/Z/17/Z). AJK receives funding from the Wellcome Trust (grant number: 206250/Z/17/Z). GMK was supported by a fellowship from the UK Medical Research Council (MR/P014658/1).
+
+The UK Public Health Rapid Support Team is funded by UK aid from the Department of Health and Social Care and is jointly run by Public Health England and the London School of Hygiene & Tropical Medicine. The University of Oxford and King's College London are academic partners. The views expressed in this publication are those of the authors and not necessarily those of the National Health Service, the National Institute for Health Research or the Department of Health and Social Care.
+
+### Authors' contributions
+
+In alphabetic order:
+
+* JE, MJ, TJ developed the methodology. 
+* ESN, MJ, TJ contributed code.
+* TJ performed the analyses.
+* ESN, TJ reviewed code.
+* ESN, TJ wrote the first draft of the manuscript.
+* GMK, AJK, CP, ESN, JE, MJ, OLPDW, RE, SF, TJ contributed to the manuscript.
+
+### Shiny app developers
+
+This Shiny app was developed by the following people: Thibaut Jombart, Emily Nightingale, Eleanor Rees, Gwen Knight, Carl AB Pearson, Samuel Clifford. Each contributed to adaptation of the model, writing body text, visualisation, app design and testing.
+
+### COVID-19 Working Group
+
+CMMID COVID-19 Working Group gave input on the method, contributed data and provided elements of discussion. In addition to the named authors and contributors above, the following authors were part of the Centre for Mathematical Modelling of Infectious Disease COVID-19 working group: Billy J Quilty, Christopher I Jarvis, Petra Klepac, Charlie Diamond, Joel Hellewell, Timothy W Russell, Alicia Rosello, Yang Liu, James D Munday, Sam Abbott, Kevin van Zandvoort, Graham Medley, Kiesha Prem, Nicholas Davies, Fiona Sun, Hamish Gibbs, Amy Gimma, Nikos I Bosse, Sebastian Funk. Each contributed in processing, cleaning and interpretation of data, interpreted findings, contributed to the manuscript, and approved the work for publication.

app/app.R

@@ -16,151 +16,152 @@ library(shiny)
 library(incidence)
 library(projections)
 library(distcrete)
-
+library(ggplot2)
 
 ## global variables
-app_title <- "Hospital Bed Occupancy Projections"
-cmmid_color <- "#134e51"
+app_title   <- "Hospital Bed Occupancy Projections"
 
 admitsPanel <- function(
   prefix, tabtitle
 ) {
   fmtr = function(inputId) sprintf("%s%s", prefix, inputId)
-return(tabPanel(tabtitle, sidebarLayout(position = "left",
-  sidebarPanel(
-    dateInput(fmtr("admission_date"), "Date of admission:"),
-    numericInput(fmtr("number_admissions"), "Number of admissions on that date:",
-      min = 1,
-      max = 10000,
-      value = 1
-    ),
-    numericInput(fmtr("assumed_reporting"), "Reporting rate (%):",
-      min = 10,
-      max = 100,
-      value = 100,
-      step = 10
-    ),
-    numericInput(fmtr("doubling_time"), "Assumed doubling time (days):",
-      min = 0.5,
-      max = 10,
-      value = 5
-    ),
-    numericInput(fmtr("uncertainty_doubling_time"), "Uncertainty in doubling time (%):",
-      min = 0,
-      max = 1,
-      value = .2,
-      step = 0.05
-    ),
-    numericInput(fmtr("simulation_duration"), "Forecast interval (days):",
-      min = 1,
-      max = 21,
-      value = 7,
-      step = 1
-    ),
-    numericInput(fmtr("number_simulations"), "Number of simulations:",
-      min = 10,
-      max = 50,
-      value = 10,
-      step = 10
-    )
-  ),
-  mainPanel(
-    plotOutput(fmtr("los_plot")),
-    plotOutput(fmtr("main_plot"))
-  )
-)))
+  return(
+    tabPanel(tabtitle, 
+             sidebarLayout(position = "left",
+                           sidebarPanel(
+                             dateInput(fmtr("admission_date"), 
+                                       "Date of admission:"),
+                             numericInput(fmtr("number_admissions"), 
+                                          "Number of admissions on that date:",
+                                          min = 1,
+                                          max = 10000,
+                                          value = 1
+                             ),
+                             numericInput(fmtr("assumed_reporting"),
+                                          "Reporting rate (%):",
+                                          min = 10,
+                                          max = 100,
+                                          value = 100,
+                                          step = 10
+                             ),
+                             numericInput(fmtr("doubling_time"), 
+                                          "Assumed doubling time (days):",
+                                          min = 0.5,
+                                          max = 10,
+                                          value = 5
+                             ),
+                             numericInput(fmtr("uncertainty_doubling_time"),
+                                          "Uncertainty in doubling time (%):",
+                                          min = 0,
+                                          max = 1,
+                                          value = .2,
+                                          step = 0.05
+                             ),
+                             numericInput(fmtr("simulation_duration"),
+                                          "Forecast interval (days):",
+                                          min = 1,
+                                          max = 21,
+                                          value = 7,
+                                          step = 1
+                             ),
+                             numericInput(fmtr("number_simulations"),
+                                          "Number of simulations:",
+                                          min = 10,
+                                          max = 50,
+                                          value = 10,
+                                          step = 10
+                             )
+                           ),
+                           mainPanel(
+                             plotOutput(fmtr("los_plot")),
+                             br(),
+                             plotOutput(fmtr("main_plot"))
+                           )
+             )))
 }
 
 ## Define UI for application that draws a histogram
 ui <- navbarPage(
-    title = div(
-        a(img(src="cmmid_newlogo.svg", height="45px"),
-          href="https://cmmid.github.io/"),
-        span(app_title, style="line-height:45px")
-    ),
-    windowTitle = app_title,
-    theme = "styling.css",
-    position="fixed-top", collapsible = TRUE,
-    admitsPanel(prefix="gen_", tabtitle="General"),
-    admitsPanel(prefix="icu_", tabtitle="ICU"),
-    tabPanel("Overall", mainPanel(
-      plotOutput("gen_over_plot"),
-      plotOutput("icu_over_plot")
-    )),
-    tabPanel("Information", includeMarkdown("include/info.md"))
+  title = div(
+    a(img(src="cmmid_newlogo.svg", height="45px"),
+      href="https://cmmid.github.io/"),
+    span(app_title, style="line-height:45px")
+  ),
+  windowTitle = app_title,
+  theme = "styling.css",
+  position="fixed-top", collapsible = TRUE,
+  admitsPanel(prefix="gen_", tabtitle="General"),
+  admitsPanel(prefix="icu_", tabtitle="ICU"),
+  tabPanel("Overall", mainPanel(
+    plotOutput("gen_over_plot"),
+    br(),
+    plotOutput("icu_over_plot")
+  )),
+  tabPanel("Information", 
+           fluidPage(style="padding-left: 40px; padding-right: 40px; padding-bottom: 40px;", 
+                     includeMarkdown("include/info.md"))),
+  tabPanel("Acknowledgements", 
+           fluidPage(style="padding-left: 40px; padding-right: 40px; padding-bottom: 40px;", 
+                     includeMarkdown("ack.md")))
+
+
 )
 
 
 ## Define server logic required to draw a histogram
 server <- function(input, output) {
-
+  
   ## graphs for the distributions of length of hospital stay (LoS)
   output$gen_los_plot <- renderPlot({
-    los <- los_normal
-    title <- "Duration of normal hospitalisation"
-    max_days <- max(1, los$q(.999))
-    days <- 0:max_days
-    plot(days,
-         los$d(days),
-         type = "h", col = cmmid_color,
-         lwd = 14, lend = 2,
-         xlab = "Days in hospital",
-         ylab = "Probability",
-         main = title,
-         cex.lab = 1.3,
-         cex.main = 1.5)
+
+    los   <- los_normal
+    title <- "Normal hospital bed utilisation"
+
+    plot_distribution(los = los, title = title)
   }, width = 600)
-
+  
   output$icu_los_plot <- renderPlot({
-    los <- los_critical
+
+    los   <- los_critical
     title <- "Duration of ICU hospitalisation"
-    max_days <- max(1, los$q(.999))
-    days <- 0:max_days
-    plot(days,
-         los$d(days),
-         type = "h", col = cmmid_color,
-         lwd = 14, lend = 2,
-         xlab = "Days in hospital",
-         ylab = "Probability",
-         main = title,
-         cex.lab = 1.3,
-         cex.main = 1.5)
+
+    plot_distribution(los = los, title = title)
   }, width = 600)
 
   ## main plot: predictions of bed occupancy
   output$gen_over_plot <- output$gen_main_plot <- renderPlot({
-
-      los <- los_normal
-      title <- "Duration of normal hospitalisation"
-
+    
+    los <- los_normal
+    title <- "Normal hospital bed utilisation"
+    
     ## run model
-    beds <- run_model(date = input$gen_admission_date,
-                      n_start = as.integer(input$gen_number_admissions),
-                      doubling = input$gen_doubling_time,
+    beds <- run_model(date           = input$gen_admission_date,
+                      n_start        = as.integer(input$gen_number_admissions),
+                      doubling       = input$gen_doubling_time,
                       doubling_error = input$gen_uncertainty_doubling_time,
-                      duration = input$gen_simulation_duration,
-                      reporting = input$gen_assumed_reporting / 100,
-                      r_los = los$r,
-                      n_sim = input$icu_number_simulations)
-    plot_beds(beds, ribbon_color = cmmid_color)
-  })
-
+                      duration       = input$gen_simulation_duration,
+                      reporting      = input$gen_assumed_reporting / 100,
+                      r_los          = los$r,
+                      n_sim          = input$icu_number_simulations)
+    plot_beds(beds, ribbon_color = lshtm_grey, palette = cmmid_pal, title = title)
+  }, width = 600)
+  
   output$icu_over_plot <- output$icu_main_plot <- renderPlot({
 
     los <- los_critical
-    title <- "Duration of critical care hospitalisation"
-
+    title <- "ICU bed utilisation"
+    
     ## run model
-    beds <- run_model(date = input$icu_admission_date,
-                      n_start = as.integer(input$icu_number_admissions),
-                      doubling = input$icu_doubling_time,
+    beds <- run_model(date           = input$icu_admission_date,
+                      n_start        = as.integer(input$icu_number_admissions),
+                      doubling       = input$icu_doubling_time,
                       doubling_error = input$icu_uncertainty_doubling_time,
-                      duration = input$icu_simulation_duration,
-                      reporting = input$icu_assumed_reporting / 100,
-                      r_los = los$r,
-                      n_sim = input$icu_number_simulations)
-    plot_beds(beds, ribbon_color = cmmid_color)
-  })
+                      duration       = input$icu_simulation_duration,
+                      reporting      = input$icu_assumed_reporting / 100,
+                      r_los          = los$r,
+                      n_sim          = input$icu_number_simulations)
+    plot_beds(beds, ribbon_color = lshtm_grey, palette = cmmid_pal, title = title)
+  }, width = 600)
 
 }
 

app/include/info.md

@@ -41,7 +41,8 @@ The following values are specified by the user to tailor the model to a particul
 
 ### Pre-set model parameters
 
-Two options for duration of hospitalisation are provided to match the results of [Zhou et al 2020](https://www.thelancet.com/journals/lancet/article/PIIS0140-6736\(20\)30566-3/fulltext):
+Two options for duration of hospitalisation are provided to match the results of <a href="https://www.thelancet.com/journals/lancet/article/PIIS0140-6736(20)30566-3/fulltext">Zhou et al 2020</a>:
+
 
 * Long-stay: discretised Weibull (shape:*?*, scale:*?*) to aim for a median of 11
     days, IQR 7-14
@@ -57,20 +58,7 @@ These distributions may not be appropriate in some settings, and the user should
 
 ## References
 
-### Acknowledgements
+Jombart Thibaut, et al. "The cost of insecurity: from flare-up to control of a major Ebola virus disease hotspot during the outbreak in the Democratic Republic of the Congo, 2019." _Eurosurveillance_, 2020; 25(2):pii=1900735. <a href="https://doi.org/10.2807/1560-7917.ES.2020.25.2.1900735">doi:10.2807/1560-7917.ES.2020.25.2.1900735</a> 
+
+Zhou, Fei, et al. "Clinical Course and Risk Factors for Mortality of Adult Inpatients with COVID-19 in Wuhan, China: a Retrospective Cohort Study." _The Lancet_, 2020. <a href="https://doi.org/10.1016/s0140-6736(20)30566-3">doi:10.1016/s0140-6736(20)30566-3</a>.
 
-The named authors (TJ, ESN, MJ, OLPDW, GMK, EMR, RME, AJK, CABP, WJE) had the following sources of funding: 
-TJ receives funding from the Global Challenges Research Fund (GCRF) project 'RECAP' managed through RCUK and ESRC (ES/P010873/1), the UK Public Health Rapid Support Team funded by the United Kingdom Department of Health and Social Care and from the National Institute for Health Research (NIHR) - Health Protection Research Unit for Modelling Methodology. ESN receives funding from the Bill and Melinda Gates Foundation (grant number: OPP1183986). MJ receives funding from the Bill and Melinda Gates foundation (grant number: INV-003174) and the NIHR (grant numbers: 16/137/109 and HPRU-2012-10096). SRP receives funding  from the Bill and Melinda Gates Foundation (grant number: OPP1180644). RME receives funding from HDR UK (grant number: MR/S003975/1). SF is supported by a Sir Henry Dale Fellowship jointly funded by the Wellcome Trust and the Royal Society (Grant number 208812/Z/17/Z). AJK receives funding from the Wellcome Trust (grant number: 206250/Z/17/Z). GMK was supported by a fellowship from the UK Medical Research Council (MR/P014658/1).
-
-The UK Public Health Rapid Support Team is funded by UK aid from the Department of Health and Social Care and is jointly run by Public Health England and the London School of Hygiene & Tropical Medicine. The University of Oxford and King's College London are academic partners. The views expressed in this publication are those of the authors and not necessarily those of the National Health Service, the National Institute for Health Research or the Department of Health and Social Care.
-
-### Authors' contributions
-In alphabetic order:
-JE, MJ, TJ developed the methodology. 
-ESN, MJ, TJ contributed code.
-TJ performed the analyses.
-ESN, TJ reviewed code.
-ESN, TJ wrote the first draft of the manuscript.
-GMK, AJK, CP, ESN, EMR, JE, MJ, OlP, RE, SF, TJ contributed to the manuscript.
-
-CMMID COVID-19 Working Group gave input on the method, contributed data and provided elements of discussion. The following authors were part of the Centre for Mathematical Modelling of Infectious Disease 2019-nCoV working group: Billy J Quilty, Christopher I Jarvis, Petra Klepac, Charlie Diamond, Joel Hellewell, Timothy W Russell, Alicia Rosello, Yang Liu, James D Munday, Sam Abbott, Kevin van Zandvoort, Graham Medley, Samuel Clifford, Kiesha Prem, Nicholas Davies, Fiona Sun, Hamish Gibbs, Amy Gimma, Nikos I Bosse, Eleanor Rees, Sebastian Funk. Each contributed in processing, cleaning and interpretation of data, interpreted findings, contributed to the manuscript, and approved the work for publication.