R/run_shiny.R

In ZachLevine-11/McMasterPandemicShiny: Shiny App for McMasterPandemic

##' Simulate ggplot picking colours for a plot.
##'
##' Obtain a list of the colours that ggplot will use for a plot with n variable.
##'
##' @param n the number of variables in the simulated plot. Should match the number of variables in the simulation for this to be useful.
##' @return hues, a list of the colours (specified in hex) that ggplot2 will use.
##' @export
##'
color_list <- function(n) {
  hues = seq(15, 375, length = n + 1)
  colours <- grDevices::hcl(h = hues, l = 65, c = 100)[1:n]
  return(colours)
}

##' Colour checkboxes checkboxes.
##'
##' Generate the necessary HTML/CSS tags to change the colour of a checkbox. Colour curve toggle buttons to match corresponding curves on the graph.
##'
##' @param curves a list of input IDs of the checkboxes to modify the fill of.
##' @param colourList a list of hex obects specifiying the colour to change corresponding checkboxes in curves to.
##' @return a tagsList containing the tags
##' @export
##'
togglePanelColourManager <- function(curves, colourList){
  i <- 1
  listoftags <- list()
  while (i <= length(curves)){
    colour <- colourList[i]
    curve <- curves[i]
    ##Create the text for the HTML tags. The + selects the right divider after the input of the curve.
    theTag <- paste0("#", curve, "+ .state label:after {background-color: ", colour, " !important;}", sep = "")
    listoftags <- c(listoftags, theTag)
    i <- i + 1
  }
  return(listoftags)
}

##' Handle external browser options for the shiny.
##'
##'
##' @import shiny
##' @export
##' @param openinBrowser a logical indicating whether the shiny app should be opened in the browser or not
browserManager <- function(openinBrowser){
  if (openinBrowser){
    ##Use get to circumvent the global binding errors.
    options(shiny.launch.browser = get(".rs.invokeShinyWindowExternal", envir = as.environment("tools:rstudio")))
  }
  else{
    options(shiny.launch.browser = get(".rs.invokeShinyWindowViewer", envir = as.environment("tools:rstudio")))
  }
}

parameter.files <- c("CI_base.csv","CI_updApr1.csv","ICU1.csv", "ICU_diffs.csv", "PHAC.csv")
default.parameter.file <- "ICU1.csv"
default.start.date <- "2020-01-01"
default.dropstates <- c("t","S","E","I","X")
timeunitParams <- c("sigma", "gamma_a", "gamma_m", "gamma_s", "gamma_p", "rho")
beta0 <- 1

##' Run the McMasterPandemic Shiny
##'
##' run_shiny() is an example of a single-file Shiny app in that it defines a UI object and a server method to handle that object. A benefit is that Roxygen import tags only need to be called once to become available to the entire shiny, and it's easy to run the shiny as well. After both the ui object and server function are defined, browserManager is called, which sets the viewing environment that the Shiny runs in. Anywhere with a tag$html call is either a CSS or HTML tag to change certain visual aspects of the shiny.  In addition, many ui elements are rendered in the server function and passed to ui with renderUI. RenderHTML is another wrapper for this as well. This lets us make UI elements which depend on input from the UI itself.
##'
##' @param useBrowser A logical indicating whether to run the Shiny in the default browser or in a seperate window generated by RStudio.
##' @param usingOnline A logical indicating whether the app is being run on shinyapps.io or not.
##' @import shiny
##' @import ggplot2
##' @import McMasterPandemic
##' @importFrom shinythemes shinytheme
##' @importFrom anytime anytime
##' @importFrom stringr str_length
##' @importFrom lubridate ymd
##' @importFrom directlabels direct.label
##' @importFrom scales log10_trans trans_breaks trans_format math_format
##' @importFrom shinyWidgets prettyCheckbox setBackgroundColor
##' @importFrom utils write.csv
##' @importFrom graphics plot
##' @return NULL
##' @export
run_shiny <- function(useBrowser = TRUE, usingOnline = FALSE) {
  ## The ui (user interface) is what the user is shown when running
  ## the shiny.  The ui also gathers input that is the passed to the
  ## server (e.g., filling in boxes or sliders).
  ui <- fluidPage(theme = shinythemes::shinytheme("flatly"),
                  ##Set the title panel to be Heritage Maroon.
                  h1(id = "heading", "McMasterPandemic"),
                  ##Colour the top and bottom of the page appropriately.
                  tags$style(HTML("#heading {background-color: #7A003C; color: white !important;}")),
                  tags$style(HTML("#sourcelink {background-color: #7A003C; color: white !important;}")),
                  #Change the colours of text on the tab selectors to be blue.
                  tags$style(HTML("
                                  .tabbable > .nav > li > a[data-value='plotaes'] {color: blue}
                                  .tabbable > .nav > li > a[data-value='tcr'] {color: blue}
                                  .tabbable > .nav > li > a[data-value='parametersPanel'] {color: blue}
                                  .tabbable > .nav > li > a[data-value='procObsErr'] {color: blue}
                                  ")),
                  ##Bold the explanation title for the error entry tab.
                  tags$style(HTML("#explanationTitle {font-weight: bold;}")),
                  ##Set the colour of the sidebar panel to be Heritage Gold.
                  tags$head(tags$style(HTML('#sidebar {background-color: #FDBF57;}'))),
                  ##Bold the checkbutton panel title.
                  tags$style(HTML("#checkButtonTitle {font-weight: bold;}")),
                  ##Bold the summary table title.
                  tags$style(HTML("#summaryTitle {font-weight: bold;}")),
                  ##Set the background colour to be a lighter and faded Heritage Grey (original one is too dark).
                  shinyWidgets::setBackgroundColor(color = "#e6ebed"),
                  sidebarLayout(
                    sidebarPanel(id = "sidebar", width = 4,
                                 fluidRow(
                                   selectInput("fn",
                                               label = "Sample parameter file:",
                                               choices = parameter.files, selected = default.parameter.file),
                                   downloadButton("downloadData", "Download sample parameter file", class = "dbutton"),

                                   downloadButton("downloadOwnData", "Download current parameters", class = "dbutton"),


                                   fileInput("uploadData", "Upload custom parameter file")
                                 ),
                                 fluidRow(
                                   textOutput("checkButtonTitle"),
                                   uiOutput("plotTogglePanel")
                                 ),
                                 fluidRow(
                                   dateInput(inputId = "sd",
                                             label = "Start Date",
                                             value = default.start.date,
                                             min = "2020-01-01",
                                             max = "2030-11-31"),
                                   uiOutput("endDate")),
                                 fluidRow(
                                   column(4,
                                          textOutput("summaryTitle"),
                                          tableOutput("summary")
                                   )
                                 ),
                                 ## Only show the selector to input parameters if that's selected.
                                 uiOutput("maintabPanel"),
                                 ##Colour the checkboxes to match the curves in the plot.
                                 ##Use the below object to call the HTML tags within the server function.
                                 htmlOutput("colourManager")),
                    mainPanel(
                      fluidRow(
                        uiOutput("plotColumn"),
                        br())
                    )
                  ),
                  uiOutput("sourcelink")
                  )

  #Everything else.
  server <- function(input, output, session){
    ## non-standard eval; circumvent 'no visible binding' check
    x <- Date <- Symbol <- Relative_value <- Rt <- NULL
    ##Render the tab panel server-side to force tab changes the way we'd like, and give us the load-edit functionality we're after.
    output$maintabPanel <- renderUI({
      tabsetPanel(
        ##Use this to force the tab to change.
        id = "tabs",
        ##The parameters panel needs to be the default selected panel. This is so it Shiny can render the panel first. The input slots aren't created until the panel is created.
        ##So keep the default to be the parametersPanel to avoid ugly errors.
        selected = "plotaes",
        tabPanel(
          title = "Time-varying transmission rates",
          value = "tcr",
          textOutput("trmsg"),
          checkboxInput("useVarying", label = "Simulate with time-varying transmission rates", value = FALSE),
          conditionalPanel(condition = "input.useVarying",
            br(),
            br(),
            ##Default time point is two months into the simulation.
            textInput("timeParsDates", label = "Dates of changes, separated by commas", value = paste(lubridate::ymd(input$sd) + months(2), lubridate::ymd(input$sd) + months(4), lubridate::ymd(input$sd) + months(4), sep = ",")),
            textInput("timeParsSymbols", label = "Parameter to change on each date", value = "beta0, beta0, alpha"),
            textInput("timeParsRelativeValues", label = "Relative change on each date", value = "0.5, 0.75, 1.1"),
            plotOutput("paramsPlot")
          )
        ),
        tabPanel(title = "Process and Observation error",
                 value = "procObsErr",
                 checkboxInput("useNoise", label = "Simulate with noise", value = FALSE),
                conditionalPanel(condition = "input.useNoise",
                  sliderInput("ObsError", label = "Shape parameter for observation noise", min = 0, max = 1000, step = 1, value = 100),
                  sliderInput("procError", label = "Shape parameter for process noise", min = 0, max = 1, step = 0.01, value = 0.5),
                  textOutput("explanationTitle"),
                  textOutput("errorExplanations")
                )
          ),
        tabPanel(
          title = "Plot aesthetics",
          value = "plotaes",
          sliderInput("Globalsize", "Text size:",
                      min = 5, max = 45,
                      step = 0.25,
                      value = 20),
          sliderInput("lineThickness", "Line thickness:",
                      min = 0, max = 10,
                      step = 0.25,
                      value = 3),
          radioButtons(inputId = "scale",
                       label = "Scaling options",
                       choices = c("none",
                                   "log y scale",
                                   "sqrt y scale"),
                       selected = "none"),
          checkboxInput(inputId = "automaticSize",
                        label = ("Show sliders for individual text element sizes"),
                        value = 0),
          conditionalPanel(condition = "input.automaticSize",
                           sliderInput("titleSize", "Title size:",
                                       min = 0, max = 25,
                                       value = 20),
                           sliderInput("XtextSize", "X axis title size:",
                                       min = 0, max = 25,
                                       value = 10),
                           sliderInput("YtextSize", "Y axis title size:",
                                       min = 0, max = 25,
                                       value = 10)
          )),
        tabPanel(
          title = "Simulation Parameters",
          value = "parametersPanel",
          checkboxInput(inputId = "showAll",
                        label = ("Show parameter sliders"),
                        value = FALSE),
          conditionalPanel(condition = "input.showAll",
                           ##Using names to avoid factors getting passed as inputs to textInput_param.
                           list(uiOutput("setR0Panel"),
                                ##Since we can set R0, we don't want to have the option to change beta0.
                                lapply(names(read_params("ICU1.csv"))[names(read_params("ICU1.csv")) != "beta0"],
                                       FUN = textInput_param)))
        )
      )})
    ##Force the tab panel to be the parameters panel every time the default parameters drop down is changed.
    observeEvent(input$fn, {
      shiny::updateTabsetPanel(session, "tabs",
                               selected = "parametersPanel"
      )
    })
    get_factor_timePars <- function(){
      if(is.null(input$timeParsRelativeValues)){
        currentPars <- NULL
      }
      else{
        relValues <- as.numeric(unlist(strsplit(input$timeParsRelativeValues, "\\,")))
        dates <- anytime::anydate(unlist(strsplit(input$timeParsDates, "\\,")))
        symbols <- trimws(unlist(strsplit(input$timeParsSymbols, "\\,")))
        currentPars <- data.frame("Date" = dates, "Symbol" = symbols, "Relative_value" = relValues, stringsAsFactors = FALSE)
      }
      return(currentPars)
    }
    dp_1 <- describe_params(read_params("ICU1.csv"))
    output$trmsg <- renderText({"Transmission rates are constant by default, but can be changed. You can change any number of parameters any number of times."})
    ##Collect time changing parameters and detect changed from default value.
    get_timePars <- reactive({
      set.seed(5)
      ##Detect changes from default values for time-changing transmission rates, and apply these changes in the simulation.
      time_pars <- get_factor_timePars()
      return(list("time_pars" = time_pars, "useTimeChanges" = input$useVarying))
    })
    ##Run a pandemic simulation based on the inputs in the shiny.
    get_sim <- reactive({
      params <- makeParams()
      if (input$useNoise){
        params <- update(params, c(proc_disp = as.numeric(input$procError), obs_disp = as.numeric(input$ObsError)))
      }
      else{
      }
      grabbedPars <- get_timePars()
      time_pars <- grabbedPars[["time_pars"]]
      ##Make the params.
      useTimeChanges <- grabbedPars[["useTimeChanges"]]
      if (useTimeChanges){
        sim = run_sim(params, start_date = anytime::anydate(input$sd), end_date = anytime::anydate(input$ed), stoch = c(obs = input$useNoise, proc = input$useNoise), params_timevar = time_pars)
      }
      else{
        sim = run_sim(params, start_date = anytime::anydate(input$sd), end_date = anytime::anydate(input$ed), stoch = c(obs = input$useNoise, proc = input$useNoise))
      }
      ##Add a curve for prevalence
      sim$prevalence <- sim$I + sim$E
      return(sim)
    })
    ##Set the plot width based on the length of the simulation.
    getplotWidth <- function(){
      if (is.null(input$sd) || is.null(input$ed)){
        return(500)
      }
      else{
        begining <- anytime::anydate(input$sd)
        end <- anytime::anydate(input$ed)
        range <- end - begining
        return(as.numeric(range*3.2))
      }
    }
    ##Dynamically adjust plot size based on the length of the simulation.
    observe({
      output$plot <- renderPlot(width = getplotWidth(),{
        sim <- get_sim()
        ##Allow for process and observation error, set to zero by default.
        p <- plot(sim, drop_states = getDropStates())
        if (input$automaticSize == 1){
          p <- p + ggplot2::theme(
            plot.title = element_text(color = "black", size = input$titleSize),
            axis.title.x = element_text(color = "black", size = input$XtextSize),
            axis.title.y = element_text(color = "black", size = input$YtextSize))
        }
        else{
          p <- p + theme_gray(base_size = input$Globalsize)
        }
        p <- p + geom_line(size = input$lineThickness) + theme(legend.position = "none")

        if (input$scale == "log y scale"){
          p <- p + scale_y_log10()
        }
        else if (input$scale == "sqrt y scale"){
          p <- p + scale_y_sqrt()
        }
        else{
        }
        p <- p + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%B") + labs(x = "Date", y = "Daily count", title = "Pandemic Simulation")
        # Colour properly and eliminate other elements.
        p <- p + theme(plot.background = element_rect(fill = "#e6ebed", color = "#e6ebed", size = 0),
                       panel.border = element_blank()
        )
        p
      })
    })
    ##Take input and package it in a params_pansim object that run_sim and the like can read.
    makeParams <- function(){
      params <- c()
      for (param in names(read_params("ICU1.csv"))){
        ##Grab the value of the input slot.
        if (param == "beta0"){
          paramValue <- beta0
        }
        else{
          paramValue <- eval(parse(text = paste0("input$", param)))
        }
        #Reparametrize time params so the user can enter them in as times rather than rates, to be more intuitive.
        ##Load from file if the slot is null at start up, or if we just selected the file.
        if (param %in% timeunitParams){
          if (is.null(paramValue) || is.na(paramValue)){
            paramValue <- loadParams(param)
            params <- c(params, paramValue)
          }
          else{
            ##If the input isn't null, the simualtion gets 1/ that input.
            paramValue <- 1/paramValue
            params <- c(params, paramValue)
          }
        }
        ##Not a time unit param.
        else{
          ##Load from file if the slot is null at start up, or if we just selected the file.
          if (is.null(paramValue) || is.na(paramValue)){
            paramValue <- loadParams(param)
            params <- c(params, paramValue)
          }
          else{
            ##Otherwise, package and make the params the way we'd like them. Changed for conciceness.
            params <- c(params, paramValue)
          }
        }
      }
      paramNames <- names(read_params("ICU1.csv"))
      ##Don't want numbers as strings.
      params <- vapply(params, function(z) eval(parse(text=z)), numeric(1))
      ##Do this after because changing the numbers from strings removes their names
      names(params) <- paramNames
      class(params) <- "params_pansim"
      if (!is.null(input$fixedr)){
        if (input$fixedr != get_R0(params) || input$fixedgbar != get_Gbar(params)){
          ##Only update if R0 is actually changed from what would be estimated from the data.
          params <- fix_pars(params, target = c(R0 = input$fixedr, Gbar = input$fixedgbar))
          ##Upate the value of internal beta0.
          beta0 <- params[["beta0"]]
        }
      }
      return(params)
    }
    ##Take a parameter we'd like and load its value from the file selected. If that value is missing, grab it from the default file, which has values for everything.
    loadParams <- function(param){
      ##Include a switch for beta0, load the value set by R0.
      if (param == "beta0"){
        return(beta0)
      }
      else{
      }
      #Override the file selection with the custom file if there's one uploaded.
      if (is.null(input$uploadData)){
        ##We're using a default file.
        Inputparams <- read_params(input$fn)
        params <- Inputparams
      }
      else{
        ##Grab the filename.
        fileName <-  input$uploadData[["datapath"]]
        params <- read_params(fileName)
      }
      numMissing <- sum(is.na(params))
      ##Also account for the fact that data might just be missing from the file entirely and not recorded as NA values.
      if (numMissing != 0 || length(params) < 26){
        #If the parameters file is missing info, fill in defaults for the missing values.
        DefaultParams <- read_params("ICU1.csv")
        NonMissingparams <- params[!is.na(params)]
        NonMissingparamNames <- names(NonMissingparams)
        DefaultParams[NonMissingparamNames] <- NonMissingparams
        params <- DefaultParams
      }
      else{
      }
      return(params[param])
    }
    output$summary <- renderTable({
      params <- makeParams()
      if (!(is.null(input$procError) || is.null(input$ObsError))){
        params <- update(params, proc_disp = as.numeric(input$procError), obs_disp = as.numeric(input$ObsError))
      }
      else {
      }
      values <- c(r = get_r(params, method = "kernel"), R0 = get_R0(params), Gbar = get_Gbar(params), dbl_time = log(2)/get_r(params, method = "kernel"))
      data.frame("Symbol" = c("r0", "R0", "Gbar", "dbl_time"), "Meaning" = c("initial epidemic growth rate", "basic reproduction number", "mean generation interval", "doubling time"),"Value" = values, "Unit" = c("1/day", "---", "days", "days"))
    })
    ##Plot beta(t)/gamma.
    observe({
      output$Rtplot <- renderPlot(width = getplotWidth(), {
        params <- makeParams()
        params <- update(params, c(proc_disp = as.numeric(input$procError), obs_disp = as.numeric(input$ObsError)))
        grabbedPars <- get_timePars()
        time_pars <- grabbedPars[["time_pars"]]
        ##If R(t) is constant.
        useTimeChanges <- grabbedPars[["useTimeChanges"]]
        if (!useTimeChanges || ! "beta0" %in% time_pars$Symbol){
          ##Weight by the fraction of susceptibles.
          R0Vec <- get_R0(params)*(get_sim()$S/makeParams()[["N"]])**(makeParams()[["zeta"]] + 1)
          plotDf <- data.frame("Rt" = R0Vec, "Date" = get_sim()$date, stringsAsFactors = FALSE)
        }
        else{
          ##For each beta(t) value, create a corresponding params element and estimate R0.
          R0Vec <- sapply(time_pars[time_pars$Symbol == "beta0", "Relative_value"], function(betaValue){
            newParams <- update(params, c(beta0 = betaValue))
            return(get_R0(newParams))
          })
          ##Weight by the fraction of susceptibles.
          ##For each R0, repeat it to match the simulation.
          beta0Dates <- time_pars[time_pars$Symbol == "beta0", "Date"]
          i <- 1
          j <- 0
          newR0Vec <- c()
          while (i <= length(R0Vec)){
            newR0Vec <- c(newR0Vec, rep(R0Vec[i], min(which(get_sim()$date == beta0Dates[i])) - j))
            j <- min(which(get_sim()$date == beta0Dates[i]))
            i <- i + 1
          }
          R0Vec <- newR0Vec * (get_sim()$S/makeParams()[["N"]])**(makeParams()[["zeta"]] + 1)
          plotDf <- data.frame("Rt" = R0Vec, "Date" = get_sim()$date, stringsAsFactors = FALSE)
        }
        plotDf <- plotDf[order(plotDf$Date),]
        p <- ggplot(plotDf, aes(anytime::anydate(Date), y = Rt)) + geom_step(size = 2) +
          theme_gray(base_size = input$Globalsize)
        p <- p + labs(title = "R(t)", x = "Date")
        # Colour properly and eliminate other elements.
        p <- p + theme(plot.background = element_rect(fill = "#e6ebed", color = "#e6ebed", size = 0),
                       panel.border = element_blank()
        )
        p <- p + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%B")
        p
      })})
    output$paramsPlot <- renderPlot({
      parameterChanges <- get_factor_timePars()
      ##Make the plot more descriptive by adding begining and ending points for every symbol.
      for (symbol in unique(parameterChanges$Symbol)){
        missingBegining <- sum(parameterChanges[parameterChanges$Symbol == symbol, "Date"] == input$sd) == 0
        missingEnd <- sum(parameterChanges[parameterChanges$Symbol == symbol, "Date"] ==  input$ed) == 0
        ##If we're missing the begining, populate it with the starting date and a default value of one.
        if (missingBegining){
          parameterChanges <- rbind(data.frame("Date" = anytime::anydate(input$sd), "Symbol" = symbol, "Relative_value" = 1, stringsAsFactors = FALSE), parameterChanges)
        }
        else {
        }
        ##Order by date to avoid confusion.
        parameterChanges <- parameterChanges[order(parameterChanges$Date),]
        ##If we're missing the end, populate the last date with the last relative value we put in.
        if (missingEnd){
          parameterChanges <- rbind(data.frame("Date" = anytime::anydate(input$ed), "Symbol" = symbol, "Relative_value" = parameterChanges[parameterChanges$Symbol == symbol,][nrow(parameterChanges[parameterChanges$Symbol == symbol,]), "Relative_value"], stringsAsFactors = FALSE), parameterChanges)
        }
        else {
        }
        ##Order by date again to avoid confusion.
        parameterChanges <- parameterChanges[order(parameterChanges$Date),]
      }
      p <- ggplot(parameterChanges,aes(anytime::anydate(Date), Relative_value, colour=Symbol)) + geom_step(size = 2) +
        theme_gray(base_size = input$Globalsize)
      p <- p + geom_vline(xintercept=parameterChanges$Date,lty=2) + labs(title = "Changes over time", x = "Date", y = "Relative value")
      p <- direct.label(p, list("last.points"))
      ##Match background colour and eliminate other elements.
      p <- p + theme(plot.background = element_rect(fill = "#FDBF57", color = "#FDBF57", size = 0),
                     panel.border = element_blank(),
                     axis.text.x = element_text(angle = 60, hjust = 1)
      )
      #Add vertical lines at each month and label the tick marks accordingly.
      p <- p + ggplot2::scale_x_date(date_breaks = "1 month", date_labels = "%B")
      p
    })
    textInput_param <- function(param, dp = dp_1){
      #If the default value for each param is less than one, assume that we're dealing with a fraction and set the maximum value of that parameter to be one.
      fractionalParams <- names(read_params("ICU1.csv")[read_params("ICU1.csv") < 1])
      #Set maximum value for each param slider.
      if (param %in% c("N", "E0")){
        maxVal <- 100000000
      }
      else if (param == "zeta"){
        maxVal <- 10
      }
      else if (param %in% fractionalParams){
        maxVal <- 1
      }
      else{
        maxVal <- 8
      }
      if (param %in% timeunitParams){
        sliderLabel <- paste("mean ", substr(dp[dp$symbol == param,"meaning"], start = 3, stop = stringr::str_length(dp[dp$symbol == param,"meaning"])), " (1/",param, ")", sep = "")
      }
      else{
        sliderLabel <- paste(param, ": ", dp[dp$symbol == param,"meaning"], sep = "")
      }
      #Don't show a parameter slider for proc error as it's elsewhere already.
      if (param == "proc_disp"){
        return()
      }
      else{
      }
      if (param %in% timeunitParams){
        theVal <- 1/loadParams(param)
        maxVal <- 30
      }
      else{
        theVal <- loadParams(param)
      }
      if (param == "N"){
        theStep <- 1
      }
      else{
        theStep <- 0.1
      }
      ##Both are instantiated to the value given in the file.
      return(list(fluidRow(column(width = 10, renderText(sliderLabel)),
                           column(width = 3, textInput(inputId = paste(param, "_manual", sep = ""),
                                                       label = "",
                                                       value = theVal))),
                  sliderInput(param, label = "", value = theVal, min = 0, max = maxVal, step = theStep)))
    }
    ##Use a pair of twin event observers to keep the values of the manual entry and sliders in sync.
    ##Using vectorized operations, for each param, check if either the slider or the text input has been changed, and if it has, adjust the other one to match.
    lapply(
      X = names(read_params("ICU1.csv"))[names(read_params("ICU1.csv")) != "beta0"],
      FUN = function(paramName){
        observeEvent(input[[paste0(paramName)]], {
          ##Only change if the two are different
          if (input[[paste0(paramName, "_manual")]] != eval(parse(text = paste0("input$", paramName)))){
            updateTextInput(session, paste0(paramName, "_manual"), value = eval(parse(text = paste0("input$", paramName))))
          }
        })
        observeEvent(input[[paste0(paramName, "_manual")]], {
          if (input[[paste0(paramName, "_manual")]] != eval(parse(text = paste0("input$", paramName)))){
            updateSliderInput(session, paramName, value = eval(parse(text = paste0("input$", paramName, "_manual"))))
          }
        })
      }
    )
    ##Update the slider for R0 when we read in a file and beta0 has been changed.
    observeEvent(input[["uploadData"]], {
      fileName <-  input$uploadData[["datapath"]]
      params <- read_params(fileName)
      updateSliderInput(session, "fixedr", value = get_R0(params))
      updateSliderInput(session, "fixedgbar", value = get_Gbar(params))
    })
    ##Manage the states to drop.
    getDropStates <- function(){
      default.sim <- run_sim(read_params("ICU1.csv"))
      default.sim$prevalence <- default.sim$I + default.sim$E
      ##Add a column for prevalence
      couldDropStates <- setdiff(colnames(default.sim)[2:length(default.sim)], default.dropstates)
      for (state in couldDropStates){
        stateVal <- eval(parse(text = paste0("input$", state)))
        ##Catch loading errors.
        if (is.null(stateVal)){
          return(default.dropstates)
        }
        else {
        }
        ##2 indicates we don't want to show the drop state.
        if (!stateVal){
          default.dropstates <- c(default.dropstates, state)
        }
        else{
        }
      }
      return(default.dropstates)
    }
    ##Create checkbuttons to display plots or not.
    checkButton_curve <- function(curve){
      #Don't show cum rep by default
      if (curve == "cumRep" || curve == "foi" || curve ==  "R" || curve == "incidence" || curve == "prevalence"){
        showByDefault <- FALSE
      }
      else{
        showByDefault <- TRUE
      }
      theLabel <- paste0(curve)
      ##Change curve labels to be more intuitive.
      if (curve == "foi"){
        theLabel <- "force of \n infection"
      }
      if (curve == "cumRep"){
        theLabel <- "cumulative reports"
      }
      if (curve == "hosp"){
        theLabel <- "hospital \n admissions"
      }
      if (curve == "H"){
        theLabel <- "hospitalized"
      }
      if (curve == "R"){
        theLabel <- "recovered"
      }
      if (curve == "D"){
        theLabel <-  "cumulative deaths"
      }
      return(shinyWidgets::prettyCheckbox(curve,
                                          label = theLabel,
                                          value = showByDefault,
                                          shape = "round",
                                          bigger = TRUE))
    }
    create_togglePanel <- function(){
      ##Exclude the date as that's not a curve.
      defsim <- run_sim(read_params("ICU1.csv"))
      ##Add a column for prevalence
      defsim$prevalence <- defsim$I + defsim$E
      curves <- as.vector(colnames(defsim)[2:length(defsim)])
      ##Ignore curves that we're never going to show.
      curves <- setdiff(curves, c("t","S","E","I","X"))
      list(
        column(5,
               lapply(curves[1:5],
                      FUN = checkButton_curve)),
        column(5,
               lapply(curves[6:length(curves)],
                      FUN = checkButton_curve))
      )
    }
    output$plotColumn <- renderUI({
      column(9,
             ##Set a default plot size and make the panel scrollable if a plot overflows.
             style = "max-width:500px, overflow-x: scroll;",
             plotOutput("plot"),
             plotOutput("Rtplot")
      )
    })
    ##Panel to toggle curves showing
    output$plotTogglePanel <- renderUI({
      create_togglePanel()
    })
    output$colourManager <- renderUI({
      ##Grab all the curves.
      defsim <- run_sim(read_params("ICU1.csv"))
      defsim$prevalence <- defsim$I + defsim$E
      curvesList <- as.vector(colnames(defsim)[2:length(defsim)])
      ##Remove the ones we're going to drop.
      curvesList <- setdiff(curvesList, getDropStates())
      ##Grab the corresponding tags
      theTags <- togglePanelColourManager(curves = curvesList, colourList = color_list(length(curvesList)))
      ##Render the tags.
      lapply(theTags, function(tag){
        return(tags$style(tag))
      })
    })
    ##Read in a csv file, copying the logic in read_params using ICU1.csv.
    read_in_csv <- function(){
      ##Read in ICU1.csv, copying the logic in read_params using ICU1.csv.
      basicTemplate <- read.csv(system.file("params",
                                            "ICU1.csv",
                                            package = "McMasterPandemic"),
                                colClasses="character",
                                stringsAsFactors=FALSE,
                                comment.char="#",
                                na.strings="variable")
      ## evaluate to allow expressions like "1/7" -> numeric
      basicTemplate[["Value"]] <- vapply(basicTemplate[["Value"]], function(z) eval(parse(text=z)), numeric(1))
      res <- setNames(basicTemplate[["Value"]],basicTemplate[["Symbol"]])
      class(res) <- "params_pansim"
      if ("Symbol" %in% names(basicTemplate)) {
        attr(res,"description") <- setNames(basicTemplate[["Parameter"]],x[["Symbol"]])
      }
      else{
      }
      return(basicTemplate)
    }

    ##Handle downloads for the sample template csv file.
    ##The file is an empty version of ICU1.csv so it scales as more parameters are added.
    output$downloadData <- downloadHandler(
      filename = function(){return("sampleparams.csv")},
      content = function(file) {
        basicTemplate <- read_in_csv()
        ##Default the values column.
        basicTemplate$Value <- read_params("PHAC.csv")
        write.csv(basicTemplate, file, row.names = FALSE)
      }
    )
    ##Handle downloads for the parameters entered by the user.
    output$downloadOwnData <- downloadHandler(
      filename = function(){return("customparams.csv")},
      content = function(file) {
        basicTemplate <- read_in_csv()
        basicTemplate$Value <- makeParams()
        write.csv(basicTemplate, file, row.names = FALSE)
      }
    )

    output$summaryTitle <- renderText({"Summary characteristics"})
    output$explanationTitle <- renderText({"Explanation"})
    output$errorExplanations <- renderText({"Use these options to simulate noise in the data. The observation error parameter is the dispersion parameter for a negative binomial distribution. A suitable value could be 200.
      The process dispersion parameter adds gamma white noise to the event rates by pulling from a multinomial distribution. A reasonable value for process dispersion is 0.5"})
    output$checkButtonTitle <- renderText({"Curves to display"})
    ##EndDate is the name of the ui object, "ed" is the name of the input slot to store the end date in.
    ##We make this reactive so we can use the input start date as the minimum value for the end date.
    observe({
      output$endDate <- renderUI({
        dateInput(inputId = "ed",
                  label = "End date",
                  value = toString(anytime::anydate(input$sd) + 30*9),
                  min = toString(anytime::anydate(input$sd) + 1),
                  max = toString(anytime::anydate(input$sd) + 5*365))
      })
    })
    output$setR0Panel <- renderUI({
      list(
        sliderInput("fixedr", "R0: basic reproductive number", min = 0, max = 20, step = 0.01, value = get_R0(read_params(default.parameter.file))),
        sliderInput("fixedgbar", "mean generation interval", min = 0, max = 20, step = 0.01, value = get_Gbar(read_params(default.parameter.file))))
    })
    output$sourcelink <- renderUI({tagList(
      "McMaster Pandemic source code available at ",
      a("https://github.com/bbolker/McMasterPandemic", href = "https://github.com/bbolker/McMasterPandemic"),
      "                                Shiny interface to McMaster Pandemic by Zachary Levine."
    )})
  }
  if (usingOnline == FALSE){
    ##Set the viewing options first.
    ##Run the shiny app. the default value of launch.browser looks for the option set by browserManager.
    shiny::runApp(appDir = shinyApp("ui" = ui, "server" = server), launch.browser = getOption("shiny.launch.browser", interactive()))
    browserManager(useBrowser)
  }
  else{
    shinyApp(ui, server)
    }
}