---
title: "Tutorial: Overlays for interventions in epidemic modelling"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteEncoding{UTF-8}
  %\VignetteIndexEntry{Tutorial: epidemic modelling}
  %\VignetteEngine{knitr::rmarkdown}
editor_options: 
  markdown: 
    wrap: 72
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

This tutorial will walk you through how to use `overshiny` to add
interactive overlays to epidemic curves generated by an infectious
disease transmission model to explore the effect of different
interventions like vaccines and social distancing. This is the use case
that originally spurred the development of `overshiny` as an offshoot of
an infectious disease modelling Shiny app developed at the London School
of Hygiene and Tropical Medicine during the COVID-19 pandemic.

This tutorial doesn't assume any previous knowledge of `shiny` or
`overshiny`, but is not a comprehensive introduction to `shiny`. We will
be using the package `epidemics` to provide the actual infectious
disease model underlying the simulation.

# Epidemic simulation

OK, let's begin. If you're developing a `shiny` app based around some
relatively complex simulation code, it often helps to start by putting
the simulation code together outside the context of a `shiny` app, and
later building the app to include it. That helps you catch errors with
the simulation code before putting it into an app, which often makes it
harder to catch errors. So let's start with our infectious disease model
in `epidemics` and move on to the `shiny` app later on.

First, make sure you have the `epidemics` package installed, and the
most recent version of `overshiny` (the version on CRAN is not recent
enough for this tutorial!):

```{r, eval = FALSE}
devtools::install_github("epiverse-trace/epidemics")
devtools::install_github("nicholasdavies/overshiny")
```

Now, let's build a simple function that will produce a simulation run
from `epidemics` and return the results.

```{r, eval=FALSE}
library(epidemics)
library(ggplot2)

# Model run function
run_model <- function()
{
    # Build parameters
    I0 <- 0.001
    pop_size <- 1000000
    
    # Build population
    pop <- population(
        name = "Utopia",
        contact_matrix = matrix(1),
        demography_vector = 1000000,
        initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
    )

    # Run model
    results <- model_default(pop)

    return (results)
}

```

Note that `I0` is the initial proportion of infectious individuals, and
`pop_size` is the total population size. Test this function out and see
if you can plot the prevalence of infection (compartment `"infectious"`)
before continuing.

<details>

<summary>Click for one possible answer...</summary>

Here's how you might do it using `ggplot2`:

```{r eval=FALSE}
results <- run_model()
results <- results[results$compartment == "infectious", ]
ggplot(results) +
    geom_line(aes(x = time, y = value)) +
    labs(x = NULL, y = "Infection prevalence")
```

You should see an exponentially growing epidemic (with a little dip at
the start).

</details>

## Connecting to a mock-up of `input`

At the moment, our `run_model()` function produces an epidemic curve
based on some default parameters. We want `run_model()` to respond to
user input, though, so that users of our app can provide parameters like
the basic reproduction number <i>R</i><sub>0</sub>, the infectious
period, the duration of the epidemic, and so on.

Within `shiny`, user input is provided in a list[^1] called `input`. So
let's say that the `input` list contains the following:

[^1]: Technically it's not a list, it's a `shiny::reactiveValues()`
    object, but in many ways it behaves like a normal R list.

```{r eval=FALSE}
input <- list(
    # Start and end dates of the epidemic
    date_range = as.Date(c("2025-01-01", "2025-12-31")),
    # Population size in millions
    pop_size = 59
    # Percentage (not proportion) of the population initially infected
    init_infec = 0.1,
    # Duration of latent period in days
    latent_pd = 2,
    # Duration of infectious period in days
    infec_pd = 7,
    # Basic reproduction number
    R0 = 1.3,
)
```

Note that in the above, we have specified lots of the parameters in
"natural" units -- the population size is in millions, the initial
proportion of infected people is in percent (not a proportion), and we
specify an infectious period in days rather than a recovery rate in
days<sup>-1</sup>. Also, rather than specifying a total duration for the
epidemic in days, we have specified a start date and end date for the
epidemic. This is because we're going to develop our Shiny app with end
users in mind, and they may not be used to the more mathematically
tractable units that infectious disease modellers use.

By looking at the documentation for `epidemics::population()` and
`epidemics::model_default()`, can you rewrite the `run_model()` function
so that it sets all the relevant parameters from the `input` list above?
Rewrite it so that `input` is passed as an argument to `run_model()`.

<details>

<summary>Click for one possible answer...</summary>

Here's how you might do it:

```{r eval=FALSE}
# Model run function
run_model <- function(input)
{
    # Transform parameters
    I0 <- input$init_infec / 100; # Percent to proportion
    duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
    infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
    recov_rate <- 1 / input$infec_pd  # Infectious period to recovery rate
    trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)

    # Build population
    pop <- population(
        name = "Utopia",
        contact_matrix = matrix(1),
        demography_vector = input$pop_size * 1000000, # Population size in millions
        initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
    )

    # Run model
    results <- model_default(pop, transmission_rate = trans_rate,
        infectiousness_rate = infec_rate, recovery_rate = recov_rate,
        time_end = duration)

    return (results)
}
```

</details>

Once you've done this, check that you're happy with the results before
moving on.

# Shiny app skeleton

Now, let's set our simulation code aside and put together a basic
`shiny` app.

All `shiny` apps have two parts. The first part is a `ui` (user
interface), which determines how the app is laid out. This is where you
define all the components of the app, where they are, and what they look
like. The second part is a `server` function, which is where the
processing happens. The server is where you transform all the user
inputs into outputs, and do any calculations that need to respond to
user input.

Let's start with a really basic skeleton for our `shiny` app. This can
go in a new `.R` script file, but don't get rid of your old code from
the last section as we'll put it back in later.

```{r, eval = FALSE}
library(epidemics)
library(shiny)

# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic")
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen")
        ),

        column(4,
            # Intervention settings
            h3("Interventions")
        )
    )
)

# --- App logic ---
server <- function(input, output)
{
}

# --- Run app ---
shinyApp(ui, server)
```

Put all that in a script and run it. You should see a window pop up with
a big title that says "SEIRV model with interventions", and three
smaller titles underneath.

Even though this is a very basic app, there's a lot to unpick here. In
particular, the large part of the script that generates the user
interface has a lot going on. Let's take it step by step.

```{r, eval = FALSE}
# --- User interface ---
ui <- fluidPage(
    ...
)
```

In `shiny`, the user interface is constructed of nested function calls.
This mirrors the nested structure of a web page -- so e.g. here the
`fluidPage` contains several elements, which themselves may contain
several other elements. `fluidPage` is just one option for the top-level
element; others include `fixedPage` or `basicPage`. `fluidPage` is a
flexible layout that can dynamically rearrange the elements if someone
is using your app on a smaller screen, like on a mobile phone, so it's
handy to use.

To make use of this dynamic rearrangement, a `fluidPage` is divided into
rows, which are defined using the `shiny` function `fluidRow`. In turn,
each `fluidRow` is divided into columns (with the `shiny` function
`column`). Each `column` within a `fluidRow` has a width, and the width
of all the columns in a row together should add up to 12. (In a
`fluidRow`, columns can only have whole-number widths.) They chose 12 as
the total width of a row because it divides well into 1, 2, 3, 4, or 6
columns. On a computer screen, normally you will see the `fluidRow` all
in one actual row, but if you are looking at your Shiny app on a smaller
screen, like on a phone, you might see your `fluidRow` broken up across
multiple actual rows.

As an example, if your `shiny` ui contains:

```{r, eval = FALSE}
fluidRow(
    column(4, "part one"),
    column(4, "part two"),
    column(4, "part three")
)
```

then on a larger screen, you would see something like

```{=html}
<pre>part one     part two    part three  </pre>
```

while on a phone, you might see

```{=html}
<pre>part one
part two
part three</pre>
```

Arranging each part vertically on a small screen instead of horizontally
helps ensure that your content don't get too hard to see on a mobile
device because it's all squished into one row, which is especially
helpful if the columns contain plots or other more complex elements.

So, looking again at our whole UI definition:

```{r, eval = FALSE}
# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic")
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen")
        ),

        column(4,
            # Intervention settings
            h3("Interventions")
        )
    )
)
```

This defines a `fluidPage`. There is a `titlePanel` at the top; anything
not explicitly in a `fluidRow` takes up a whole row, so the title panel
appears on its own row. Then there is a `fluidRow`, which by definition
has a total "width" of 12 units. It contains three `column`s each of
size 4 (to add up to 12); the size of the column is the first parameter
to `column` and then all the elements that should appear in the column
are subsequent arguments.

Here, each column contains a header `h3` with some text. In HTML, `h1`
through `h6` define headers for sections, where `h1` is the biggest and
`h6` is the smallest. You don't need to start at `h1` and work your way
down, and often people select header levels (`h1` through `h6`) based on
aesthetics (i.e. which size looks right) rather than a strict logical
ordering. We've gone based on aesthetics here; we could have used `h1`
instead of `h3` but I think it looks too big (try it and see for
yourself!). To be clear, there's no relationship between the header
level and the column size.

## Adding input widgets

Now we'll edit our Shiny app skeleton to have some more interesting
things going on. Take a look at the code below. We have added new
elements to the three columns we had before. After you've looked at
these, run this entire following script:

```{r, eval = FALSE}
library(epidemics)
library(shiny)

# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic"),
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
            sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen"),
            sliderInput("R0", HTML("Basic reproduction number, <i>R</i><sub>0</sub>"),
                value = 1.3, min = 0, max = 5, step = 0.05),
            sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
            sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
        ),

        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions")
        )
    )
)

# --- App logic ---
server <- function(input, output)
{
}

# --- Run app ---
shinyApp(ui, server)
```

Now we're getting somewhere! We've added some input widgets to the first
two columns. `shiny` gives us `dateRangeInput()` to put in a range of
dates (you can use `dateInput()` for just one date); `numericInput()` to
enter a number using an input box (or `textInput()` for free text
input); and `sliderInput()` to enter a number using a slider--plus many
more options. All of the input "widgets" provided by `shiny` are called
`[something]Input()` and they follow some common conventions: the first
argument is a special ID which we'll use later, the second argument is a
label to show next to the input, and then the other inputs define things
like the starting value or the minimum and maximum. For more
information, consult the `shiny` manual with e.g. `?sliderInput`.

# Combining inputs and outputs

Now what we want to do is combine our previous `run_model()` function
with these `shiny` inputs so that the inputs connect to the model. Also,
we want to plot the results of the model. Let's do that now.

First, in a new file, paste in your `run_model()` function from before
with the calls to `library` that we need. Nothing here is new:

```{r, eval = FALSE}
library(shiny)
library(ggplot2)
library(epidemics)

# Model run function
run_model <- function(input)
{
    # Transform parameters
    I0 <- input$init_infec / 100; # Percent to proportion
    duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
    infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
    recov_rate <- 1 / input$infec_pd  # Infectious period to recovery rate
    trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)

    # Build population
    pop <- population(
        name = "Utopia",
        contact_matrix = matrix(1),
        demography_vector = input$pop_size * 1000000, # Population size in millions
        initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
    )

    # Run model
    results <- model_default(pop, transmission_rate = trans_rate,
        infectiousness_rate = infec_rate, recovery_rate = recov_rate,
        time_end = duration)

    return (results)
}
```

Underneath that, let's put in our user interface from before, with one
addition:

```{r, eval = FALSE}
# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),
    
    # NEW PART IS HERE:
    # Main plot
    plotOutput("display", width = "100%", height = 400),
    # END OF NEW PART

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic"),
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
            sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen"),
            sliderInput("R0", HTML("Basic reproduction number, <i>R</i><sub>0</sub>"),
                value = 1.3, min = 0, max = 5, step = 0.05),
            sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
            sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
        ),

        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions")
        )
    )
)
```

The bit we added was a `plotOutput` call, which puts space in the app
for a plot (either `ggplot2` or base R plot) with the ID `"display"`. To
connect this plot with the inputs, we need to add some code to our
`server` function, so put this code underneath what you have already:

```{r, eval=FALSE}
# --- App logic ---
server <- function(input, output)
{
    output$display <- renderPlot({
        results <- run_model(input)
        results <- results[results$compartment == "infectious", ]
        ggplot(results) +
            geom_line(aes(x = time, y = value)) +
            labs(x = NULL, y = "Infection prevalence") +
            ylim(0, NA)
    })
}

# --- Run app ---
shinyApp(ui, server)
```

If you put all this together, you should have a working model that
connects to the user input, where the epidemic curve changes depending
on how you manipulate the various input controls.

That handful of lines in `server` is doing a lot. First, note that we're
calling the `shiny` function `renderPlot`, and assigning the value to
`output$display`. The reason `output$display` exists is because we put a
`plotOutput` in the `shiny` UI with ID `"display"` -- this makes an
entry in `output` called `display` which is ready to receive a plot from
the server function. If in our UI, we had given our `plotOutput` a
different ID, like:

```{r, eval=FALSE}
    plotOutput("marmite", width = "100%", height = 400),
```

then we would have to assign the results of a call to `renderPlot()` to
`output$marmite`.

Within `renderPlot()`, the first argument is a bit of R code (in curly
braces, `{}`) that should return a ggplot2 plot, or produce a base R
plot. Finally, note that we are now passing the `shiny` input object
`input` to `run_model()`. `run_model()` is expecting `input` to contain
values named `date_range`, `R0`, and so on; because we have made all
those input widgets in out UI above, `input` automatically contains the
values that have been entered.

OK. Before continuing, let's tidy up the output a little. First of all,
the y-axis of the plot extends up into the millions, and numbers like
"1e+06" are a little tough to interpret. Try changing the plotting code
in the `server` function so that the plot y-axis is in thousands, and
this is indicated on the y-axis label.

Second, the x-axis is currently in days from 0 to the duration of the
epidemic, but we are providing our `shiny` app with specific dates. Try
making the x-axis show calendar dates instead of the number of days from
the beginning of the epidemic. (Hint: you can use the `input` list
here.)

<details>

<summary>Click for one possible answer...</summary>

Here's how you might make these changes to the `server` function just by
changing the call to `ggplot`:

```{r eval=FALSE}
ggplot(results) +
    geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
    labs(x = NULL, y = "Infection prevalence (thousands)") +
    ylim(0, NA)
```

</details>

# Adding interventions with `overshiny`

In the last part of this tutorial, let's finally connect our `shiny` app
with `overshiny` so that we can deploy interventions such as social
distancing and vaccination on our infectious disease transmission model.
We're not going to get into the fine details of how specifically to
model these interventions; this is more just to demonstrate how
`overshiny` works in the context of the model we've developed.

Starting from the code we developed in the last section:

<details>

<summary>Click for starter code...</summary>

```{r eval=FALSE}
library(shiny)
library(ggplot2)
library(epidemics)

# Model run function
run_model <- function(input)
{
    # Transform parameters
    I0 <- input$init_infec / 100; # Percent to proportion
    duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
    infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
    recov_rate <- 1 / input$infec_pd  # Infectious period to recovery rate
    trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)

    # Build population
    pop <- population(
        name = "Utopia",
        contact_matrix = matrix(1),
        demography_vector = input$pop_size * 1000000, # Population size in millions
        initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
    )

    # Run model
    results <- model_default(pop, transmission_rate = trans_rate,
        infectiousness_rate = infec_rate, recovery_rate = recov_rate,
        time_end = duration)

    return (results)
}

# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),
    
    # NEW PART IS HERE:
    # Main plot
    plotOutput("display", width = "100%", height = 400),
    # END OF NEW PART

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic"),
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
            sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen"),
            sliderInput("R0", HTML("Basic reproduction number, <i>R</i><sub>0</sub>"),
                value = 1.3, min = 0, max = 5, step = 0.05),
            sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
            sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
        ),

        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions")
        )
    )
)

# --- App logic ---
server <- function(input, output)
{
    output$display <- renderPlot({
        results <- run_model(input)
        results <- results[results$compartment == "infectious", ]
        ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
    })
}

# --- Run app ---
shinyApp(ui, server)
```

</details>

First, we now need to include the `overshiny` package with:

```{r, eval = FALSE}
library(overshiny)
```

Second, we need to change our `plotOutput` plot in our UI to an
`overlayPlotOutput` so that it can respond to overlays:

```{r, eval = FALSE}
    # Main plot
    overlayPlotOutput("display", width = "100%", height = 400),
```

Third, we need to add some `overlayToken()`s that can be dragged onto
the plot. Let's put these into the currently-blank "Interventions"
section of our UI:

```{r, eval = FALSE}
        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions"),
            overlayToken("vx", "Vaccination"),
            overlayToken("tx", "Transmission")
        )
```

Fourth, we need to initialize the overlay logic in our `server` function
by putting a call to `overlayServer` at the top of the `server`
function:

```{r, eval = FALSE}
# --- App logic ---
server <- function(input, output)
{
    # --- OVERLAY SETUP ---

    # Initialise 8 draggable/resizable overlays
    ov <- overlayServer("display", 8)

    # rest of code follows as normal...
```

We need to provide `overlayServer` with the id of our `overlayPlot`
(here, `"display"`) and the maximum number of overlays to support.

And finally, we need to modify our call to `renderPlot()` in the
`server` function to tell `overshiny` more information about our plot.
Where before we had:

```{r, eval = FALSE}
    output$display <- renderPlot({
        results <- run_model(input)
        results <- results[results$compartment == "infectious", ]
        ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
    })

```

Now, we have:

```{r, eval = FALSE}
    output$display <- renderPlot({
        results <- run_model(input)
        results <- results[results$compartment == "infectious", ]
        plot <- ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
        
        overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
    })
```

There are two changes above. First, rather than returning the `ggplot()`
plot, we save the plot in a variable called `plot`. Second, we pass this
through `overlayBounds()`, which takes four key arguments:

-   `ov`, the object returned by `overlayServer()`.
-   `plot`, the plot itself.
-   `xlim`, the x-coordinate limits of the plot.
-   `ylim`, the y-coordinate limits of the plot.

`xlim` and `ylim` are not required, but because `ggplot` by default
includes a bit of extra space on the axes (i.e. the x-axis doesn't start
precisely at the epidemic start date, but a little before to provide
some visual padding), providing these allows `overshiny` to restrict the
overlays such that they can only move over the time span in which the
epidemic is actually occurring. It's similar for `ylim` (try removing
the `xlim` and `ylim` arguments to `overlayBounds` to see what happens.)

`overlayBounds()` itself returns the `plot` object, so it should be the
last line in your expression that you pass to `renderPlot()`.

You should now be able to drag the intervention tokens onto the plot,
where they will become overlays that you can move around, resize, and
remove by clicking on the "gears" icon on each overlay (then the
"remove" button). They won't do anything yet to the epicurve yet,
though; that's for the next section.

If you've gotten stuck and your code isn't working, here's some code you
could have arrived at:

<details>

<summary>Click for code...</summary>

```{r, eval = FALSE}
library(shiny)
library(ggplot2)
library(epidemics)
library(overshiny)

# Model run function
run_model <- function(input)
{
    # Transform parameters
    I0 <- input$init_infec / 100; # Percent to proportion
    duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
    infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
    recov_rate <- 1 / input$infec_pd  # Infectious period to recovery rate
    trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)

    # Build population
    pop <- population(
        name = "Utopia",
        contact_matrix = matrix(1),
        demography_vector = input$pop_size * 1000000, # Population size in millions
        initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
    )

    # Run model
    results <- model_default(pop, transmission_rate = trans_rate,
        infectiousness_rate = infec_rate, recovery_rate = recov_rate,
        time_end = duration)

    return (results)
}

# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),
    
    # NEW PART IS HERE:
    # Main plot
    overlayPlotOutput("display", width = "100%", height = 400),
    # END OF NEW PART

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic"),
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
            sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen"),
            sliderInput("R0", HTML("Basic reproduction number, <i>R</i><sub>0</sub>"),
                value = 1.3, min = 0, max = 5, step = 0.05),
            sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
            sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
        ),

        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions"),
            overlayToken("vx", "Vaccination"),
            overlayToken("tx", "Transmission")
        )
    )
)

# --- App logic ---
server <- function(input, output)
{
    # --- OVERLAY SETUP ---

    # Initialise 8 draggable/resizable overlays
    ov <- overlayServer("display", 8)
    
    # --- RENDERING OF EPI CURVES ---

    output$display <- renderPlot({
        results <- run_model(input)
        results <- results[results$compartment == "infectious", ]
        plot <- ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
        
        overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
    })
}

# --- Run app ---
shinyApp(ui, server)
```

</details>

That's how `overshiny` works; the rest of this tutorial is just about
connecting `overshiny` with `epidemics` so that the overlays on the plot
actually have an effect on the epidemic model.

## Making the interventions work

The last piece of the puzzle is to make the interventions actually have
an impact on the simulated epidemic. Already, we are using the function
`model_default()` from `epidemics` to run our model, and now we will use
the `intervention` and `vaccination` arguments to `model_default()` to
make our interventions work.

First, let's change `run_model()` so that it can pass on these extra
parameters (`intervention` and `vaccination`) to
`epidemics::model_default()`. To do that, add a `...` to the list of
parameters so that `run_model()` can take other (arbitrarily-named)
parameters and pass them on to `model_default()`, like so (there are
just two changes to make):

```{r, eval = FALSE}
# Model run function
run_model <- function(input, ...)  # <-- FIRST CHANGE HERE
```

... and then ...

```{r, eval = FALSE}
    # Run model
    results <- model_default(pop, transmission_rate = trans_rate,
        infectiousness_rate = infec_rate, recovery_rate = recov_rate,
        time_end = duration, ...) # <-- SECOND CHANGE HERE

    return (results)
```

Now, let's modify the call to `renderPlot` so that it reads in what
overlays have been placed onto the plot, and fills out the
`intervention` and `vaccination` parameters accordingly.

```{r, eval = FALSE}
    output$display <- renderPlot({
        # Create interventions
        tx_int <- list()
        vax <- NULL
        
        # Apply overlays as interventions
        for (i in which(ov$active)) {
            begin <- ov$cx0[i] - as.numeric(input$date_range[1])
            end <- ov$cx1[i] - as.numeric(input$date_range[1])
            if (ov$label[i] == "Vaccination") {
                nu <- 0.01 # proportion of population vaccinated per day
                if (is.null(vax)) {
                    vax <- vaccination(name = as.character(i), nu = matrix(nu),
                        time_begin = matrix(begin), time_end = matrix(end))
                } else {
                    ov$active[i] <- FALSE
                }
            } else if (ov$label[i] == "Transmission") {
                reduc <- 0.5 # reduction in transmission
                tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
                    type = "rate", time_begin = matrix(begin), time_end = matrix(end),
                    reduction = reduc)
            }
        }

        # Put interventions in the right format
        int <- list()
        if (length(tx_int)) {
            int[["transmission_rate"]] <- do.call(c, tx_int)
        }
        
        # Run model
        results <- run_model(input,
            vaccination = vax,
            intervention = if (length(int)) int else NULL)
        
        # Process results (this is the same as before)
        results <- results[results$compartment == "infectious", ]
        plot <- ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
        
        overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
    })
```

<details>

<summary>(Just in case, complete code for the whole script is
here...)</summary>

```{r, eval = FALSE}
library(shiny)
library(ggplot2)
library(epidemics)
library(overshiny)

# Model run function
run_model <- function(input, ...)
{
    # Transform parameters
    I0 <- input$init_infec / 100; # Percent to proportion
    duration <- as.numeric(input$date_range[2] - input$date_range[1]) # Dates to duration
    infec_rate <- 1 / input$latent_pd # Latent period to infectiousness rate
    recov_rate <- 1 / input$infec_pd  # Infectious period to recovery rate
    trans_rate <- input$R0 * recov_rate # R0 to transmission rate (R_0 = beta / gamma)

    # Build population
    pop <- population(
        name = "Utopia",
        contact_matrix = matrix(1),
        demography_vector = input$pop_size * 1000000, # Population size in millions
        initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
    )

    # Run model
    results <- model_default(pop, transmission_rate = trans_rate,
        infectiousness_rate = infec_rate, recovery_rate = recov_rate,
        time_end = duration, ...)

    return (results)
}

# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),
    
    # NEW PART IS HERE:
    # Main plot
    overlayPlotOutput("display", width = "100%", height = 400),
    # END OF NEW PART

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic"),
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
            sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen"),
            sliderInput("R0", HTML("Basic reproduction number, <i>R</i><sub>0</sub>"),
                value = 1.3, min = 0, max = 5, step = 0.05),
            sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
            sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
        ),

        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions"),
            overlayToken("vx", "Vaccination"),
            overlayToken("tx", "Transmission")
        )
    )
)

# --- App logic ---
server <- function(input, output)
{
    # --- OVERLAY SETUP ---

    # Initialise 8 draggable/resizable overlays
    ov <- overlayServer("display", 8)
    
    # --- RENDERING OF EPI CURVES ---

    output$display <- renderPlot({
        # Create interventions
        tx_int <- list()
        vax <- NULL
        
        # Apply overlays as interventions
        for (i in which(ov$active)) {
            begin <- ov$cx0[i] - as.numeric(input$date_range[1])
            end <- ov$cx1[i] - as.numeric(input$date_range[1])
            if (ov$label[i] == "Vaccination") {
                nu <- 0.01 # proportion of population vaccinated per day
                if (is.null(vax)) {
                    vax <- vaccination(name = as.character(i), nu = matrix(nu),
                        time_begin = matrix(begin), time_end = matrix(end))
                } else {
                    ov$active[i] <- FALSE
                }
            } else if (ov$label[i] == "Transmission") {
                reduc <- 0.5 # reduction in transmission
                tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
                    type = "rate", time_begin = matrix(begin), time_end = matrix(end),
                    reduction = reduc)
            }
        }

        # Put interventions in the right format
        int <- list()
        if (length(tx_int)) {
            int[["transmission_rate"]] <- do.call(c, tx_int)
        }
        
        # Run model
        results <- run_model(input,
            vaccination = vax,
            intervention = if (length(int)) int else NULL)
        
        # Process results (this is the same as before)
        results <- results[results$compartment == "infectious", ]
        plot <- ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
        
        overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
    })
}

# --- Run app ---
shinyApp(ui, server)
```

</details>

Compare the new call to `renderPlot()` to what we had before, which was:

```{r, eval = FALSE}
    output$display <- renderPlot({
        results <- run_model(input)
        results <- results[results$compartment == "infectious", ]
        plot <- ggplot(results) +
            geom_line(aes(x = time + input$date_range[1], y = value / 1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)
        
        overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
    })
```

A lot has been added, so let's take it step by step. First:

```{r, eval = FALSE}
        # Create interventions
        tx_int <- list()
        vax <- NULL
```

Here, we create some variables that will hold details of the
interventions to apply; `tx_int` (for interventions on the transmission
rate) and `vax` (for a vaccination campaign).

Then, we process the overlay data from the `ov` object that is provided
by `overlayServer()`:

```{r, eval = FALSE}
        # Apply overlays as interventions
        for (i in which(ov$active)) {
            begin <- ov$cx0[i] - as.numeric(input$date_range[1])
            end <- ov$cx1[i] - as.numeric(input$date_range[1])
            if (ov$label[i] == "Vaccination") {
                nu <- 0.01 # proportion of population vaccinated per day
                if (is.null(vax)) {
                    vax <- vaccination(name = as.character(i), nu = matrix(nu),
                        time_begin = matrix(begin), time_end = matrix(end))
                } else {
                    ov$active[i] <- FALSE
                }
            } else if (ov$label[i] == "Transmission") {
                reduc <- 0.5 # reduction in transmission
                tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
                    type = "rate", time_begin = matrix(begin), time_end = matrix(end),
                    reduction = reduc)
            }
        }
```

`ov$active` is a logical vector, the same length as the maximum number
of overlays (here, 8), which is `TRUE` for overlays that are on the plot
and `FALSE` for overlays that aren't. So `for (i in which(ov$active))`
runs a loop for all indices `i` that correspond to an "active" overlay.

Then we read `begin` and `end` -- the start time and end time for each
intervention -- from `ov$cx0` (the starting x-coordinate of each
overlay) and from `ov$cx1` (the ending x-coordinate of each overlay). We
work out how many days into the epidemic `begin` and `end` are by
subtracting the numeric value of the start date of the epidemic,
`as.numeric(input$date_range[1])`.

Then, each overlay has a `label` which corresponds to the `label` of the
`overlayToken()` which created it. So we check whether the overlay with
index `i` is a `"Vaccination"` or a `"Transmission"` overlay.

For vaccination overlays, we set the vaccination rate `nu` to 0.01,
which (to `epidemics`) means 1% of the population is getting vaccinated
per day. If there isn't already a vaccination intervention (and hence
`vax` is `NULL`) then we create one. If there is, then we can't add a
second vaccination intervention since the `epidemics` package only
allows one vaccination intervention; so we deactivate the (second,
superfluous) vaccine intervention if one already exists.

For transmission overlays, we set the transmission reduction `reduc` to
0.5, which means a reduction in the transmission rate by 50%. We add our
new intervention to the list `tx_int`. `epidemics` *does* allow multiple
transmission-rate interventions, so we don't need to limit the number of
these.

Next in the code, we have this:

```{r, eval = FALSE}
        # Put interventions in the right format
        int <- list()
        if (length(tx_int)) {
            int[["transmission_rate"]] <- do.call(c, tx_int)
        }
        
        # Run model
        results <- run_model(input,
            vaccination = vax,
            intervention = if (length(int)) int else NULL)
```

This just turns our list of transmission interventions `tx_int` into the
right format for `epidemics` to understand. It wants the `intervention`
argument to be a list with elements named `"transmission_rate"`,
`"infectiousness_rate"`, `"recovery_rate"`, or `"contacts"` depending on
what kind of intervention it is. Each of these elements should be one or
several interventions, and the way to combine interventions is with
`c()` (hence the `do.call`).

Then the code above calls our function `run_model` with the
appropriately-formatted intervention data for `vaccination` and
`intervention`.

Put this all together, and you have a working app with intervention
overlays!

# Next steps

We have come to the end of the tutorial. We haven't explored everything
that `shiny` and `overshiny` can do, but we have gone through the
basics.

As a next step, it would be nice to modify our app to do two things:

1.  Compare the mitigated epidemic to the counterfactual--an unmitigated
    epidemic without any interventions. We could do this by plotting
    both epi curves, with the unmitigated epi curve in a lighter colour.
2.  Allow us to customize the vaccination rate or the transmission
    reduction percentage of each intervention, instead of leaving these
    at 0.1% and 50% respectively.

The following script shows you how to accomplish both of these things.
Use the `shiny` and `overshiny` package documentation for insight into
what all the changes from your existing code do and how they work. Good
luck!

<details>

<summary>Click for advanced code...</summary>

```{r, eval = FALSE}
library(epidemics)
library(shiny)
library(overshiny)
library(ggplot2)

# --- User interface ---
ui <- fluidPage(
    titlePanel("SEIRV model with interventions"),

    # Main plot with support for overlays
    overlayPlotOutput("display", width = "100%", height = 400),

    # 3 columns of inputs
    fluidRow(
        column(4,
            # Basic epidemic settings
            h3("Epidemic"),
            dateRangeInput("date_range", "Date range", start = "2025-01-01", end = "2025-12-31"),
            numericInput("pop_size", "Population size (millions)", value = 59, min = 1),
            sliderInput("init_infec", "Initial proportion infectious (%)", value = 0.1, min = 0, max = 1, step = 0.01)
        ),

        column(4,
            # Pathogen settings
            h3("Pathogen"),
            sliderInput("R0", HTML("Basic reproduction number, <i>R</i><sub>0</sub>"),
                value = 1.3, min = 0, max = 5, step = 0.05),
            sliderInput("latent_pd", "Latent period (days)", value = 2, min = 1, max = 7, step = 0.1),
            sliderInput("infec_pd", "Infectious period (days)", value = 7, min = 1, max = 10, step = 0.1)
        ),

        column(4,
            # Overlay controls: tokens that can be dragged onto the plot
            h3("Interventions"),
            overlayToken("vx", "Vaccination"),
            overlayToken("tx", "Transmission")
        )
    )
)

# --- App logic ---
server <- function(input, output)
{
    # --- OVERLAY SETUP ---

    # Dropdown menu for overlays
    menu <- function(ov, i) {
        if (ov$label[i] == "Vaccination") {
            numericInput("display_vac_rate", "Vaccines per day (thousands)",
                value = ov$data$vac_rate[i], min = 0, max = 10000)
        } else if (ov$label[i] == "Transmission") {
            sliderInput("display_int_strength", "Transmission reduction (%)",
                value = ov$data$int_strength[i], min = 0, max = 100)
        }
    }

    # Initialise 8 draggable/resizable overlays
    ov <- overlayServer("display", 8, width = 56, # 56 days = 8 weeks default width
        data = list(vac_rate = 10, int_strength = 20),
        snap = snapGrid(),
        heading = dateHeading("%b %e"),
        select = TRUE,
        menu = menu)

    # --- EPIDEMIC MODEL RUNS BASED ON OVERLAY POSITIONS ---

    # Model run function
    run_model <- function(...)
    {
        # Transform parameters
        I0 <- input$init_infec / 100;
        duration <- as.numeric(input$date_range[2] - input$date_range[1])
        infec_rate <- 1 / input$latent_pd
        recov_rate <- 1 / input$infec_pd
        trans_rate <- input$R0 * recov_rate

        # Build population
        pop <- population(
            name = "Utopia",
            contact_matrix = matrix(1),
            demography_vector = input$pop_size * 1000000,
            initial_conditions = matrix(c(1 - I0, 0, I0, 0, 0), nrow = 1)
        )

        # Run model (with additional parameters from ...)
        results <- model_default(pop, transmission_rate = trans_rate,
            infectiousness_rate = infec_rate, recovery_rate = recov_rate,
            time_end = duration, ...)

        # Transform results -- construct date and only return infection prevalence
        results$date <- results$time + input$date_range[1]
        results <- results[results$compartment == "infectious", ]
        return (results)
    }

    # Unmitigated epidemic
    epi_unmitigated <- reactive({
        run_model()
    })

    # Mitigated epidemic
    epi_mitigated <- reactive({
        # Create interventions
        tx_int <- list()
        vax <- NULL
        for (i in which(ov$active)) {
            begin <- ov$cx0[i] - as.numeric(input$date_range[1])
            end <- ov$cx1[i] - as.numeric(input$date_range[1])
            if (ov$label[i] == "Vaccination") {
                nu <- ov$data$vac_rate[i] * 1000 / (input$pop_size * 1000000)
                if (is.null(vax)) {
                    vax <- vaccination(name = as.character(i), nu = matrix(nu),
                        time_begin = matrix(begin), time_end = matrix(end))
                } else {
                    ov$active[i] <- FALSE
                }
            } else if (ov$label[i] == "Transmission") {
                reduc <- ov$data$int_strength[i] / 100
                tx_int[[length(tx_int) + 1]] <- intervention(name = as.character(i),
                    type = "rate", time_begin = matrix(begin), time_end = matrix(end),
                    reduction = reduc)
            }
        }

        # Get mitigated model results
        int <- list()
        if (length(tx_int)) {
            int[["transmission_rate"]] <- do.call(c, tx_int)
        }
        run_model(vaccination = vax,
            intervention = if (length(int)) int else NULL)
    })

    # --- RENDERING OF EPI CURVES ---

    # Render plot and align overlays to current axis limits
    output$display <- renderPlot({
        plot <- ggplot() +
            geom_line(data = epi_unmitigated(),
                aes(x = date, y = value/1000), alpha = 0.5) +
            geom_line(data = epi_mitigated(),
                aes(x = date, y = value/1000)) +
            labs(x = NULL, y = "Infection prevalence (thousands)") +
            ylim(0, NA)

        overlayBounds(ov, plot, xlim = c(input$date_range), ylim = c(0, NA))
    })
}

# --- Run app ---
shinyApp(ui, server)
```

</details>