---
title: Control applied to different populations 
output:
  html_document:
    theme: null
    highlight: null
    fig_retina: null
    fig_caption: true
    mathjax: default 
    keep_md: false
bibliography: dsaide_references.bib
---

```{r, include = FALSE}
#load various variable definitions that are the same for each app
source('startup_script.R')
currentrmdfile = knitr::current_input() 
appsettings = get_settings(currentrmdfile,appdocdir,packagename)
```



## Overview {#shinytab1}  
This app lets you explore interventions applied to different population subgroups with potentially different infectiousness and mortality patterns. The app assumes you have worked through _The Basics_ and _Reproductive Number_ sections, as well as the first two apps in the _Control_ section. This app specifically builds on the _ID Control for multiple outbreaks_ app and follows a model and analysis described in [@handel2020], see the _Further Information_ tab for this and other related references.


### Learning Objectives  
* Understand the concept of interventions applied to specific population groups.  
* Learn the impact of different interventions on outcomes such as  mortality.
* Explore how optimal control measures depend on characteristics and composition of a population.  


## The Model {#shinytab2}

### Model Overview
For this app, we use a version of the basic compartmental SIR-type model. We track the following stages:

* **$S_i$** - uninfected and susceptible individuals 
* **$I_i$** - infected and infectious individuals
* **$R_i$** - recovered individuals
* **$D_i$** - dead individuals

Individuals are divided into 3 populations, namely children, adults and elderly (_i=c,a,e_). Thus, our model with 3 age groups and 4 compartments per age group leads to a 12-compartment model.

For this app, we specify the following processes/flows: 

* _b~ij~_ is the rate of transmission to susceptible individuals (_S~i~_) from infected individuals (_I~j~_). This leads to the susceptible individual leaving the _S~i~_ compartment and entering the _I~i~_ compartment. Transmission among and between groups can occur at different rates, i.e. all the _b~ij~_ can potentially be different.   
* Infected individuals stay infectious for some time, and leave the infected/infectious compartment at rate $g_i$. A fraction $m_i$ of those individuals will die and enter the dead compartment, the remaining fraction $1-m_i$ will enter the recovered compartment. 
* Recovered individuals are initially immune to re-infection, but can lose immunity at rate $w_i$.
* Control measures can be applied to each group at some strength $f_i$ (between 0 and 1) which reduces the rate at which infections in that group occur. Control measures for each group start at time $T^i_{start}$ and end at time $T^i_{end}$.


### Model Implementation
The flow diagram and the set of equations which are used to implement this model are as follows:

```{r modeldiagram,  fig.cap='Flow diagram for this model.',  echo=FALSE}
knitr::include_graphics(here::here('inst/media',appsettings$modelfigname))
```


The model equations are given by

$$
\begin{aligned}
\dot{S}_c &= - (1 - f_1)(b_{cc} I_c + b_{ca} I_a + b_{ce} I_e) S_c + w_c R_c\\
\dot{I}_c &=   (1 - f_1)(b_{cc} I_c + b_{ca} I_a + b_{ce} I_e) S_c - g_c I_c\\
\dot{R}_c &= (1-m_c) g_c I_c - w_c R_c\\
\dot{D}_c &= m_c g_c I_c\\
\dot{S}_a &= - (1 - f_2)(b_{ac} I_c + b_{aa} I_a + b_{ae} I_e) S_a + w_a R_a\\
\dot{I}_a &=   (1 - f_2)(b_{ac} I_c + b_{aa} I_a + b_{ae} I_e) S_a - g_a I_a\\
\dot{R}_a &= (1-m_a) g_a I_a - w_a R_a\\
\dot{D}_a &= m_a g_a I_a\\
\dot{S}_e &= - (1 - f_3)(b_{ec} I_c + b_{ea} I_a + b_{ee} I_e) S_e + w_e R_e\\
\dot{I}_e &=   (1 - f_3)(b_{ec} I_c + b_{ea} I_a + b_{ee} I_e) S_e - g_e I_e\\
\dot{R}_e &= (1-m_e) g_e I_e - w_e R_e\\
\dot{D}_e &= m_e g_e I_e
\end{aligned}
$$

with control _f~i~_ being only non-zero between times $T^i_{start}$ and $T^i_{end}$.


Note that we'll be exploring multi-outbreak scenarios with this app, similar to the _ID control for multiple outbreaks_ app. Instead of setting infected to zero once they drop below 1, and introducing new infected at certain times, we simply do not set infected to zero, which means they might approach very low, but never fully zero values. Having fractions of infected individuals is of course not quite realistic, but it works for our purpose here and the overall patterns would be the same if we implemented it more realistically (e.g. a stochastic model with regular new introductions of infected).


### Notation Comment

It might be worth saying something about the transmission terms. I generally use a single subscript to describe transmission from a group, e.g. _b~A~_ for transmission/infectiousness of asymptomatic. If there are multiple groups that can be susceptible and infectious, a common notation is to start with the **receiving** group first, then the **sending/transmitting group**, e.g. if susceptible adults (A) are infected by children (C), most authors write _b~AC~_. I follow this convention. Note however that it is equally ok to use _b~AC~_ to mean that infected adults transmit to susceptible children. I actually like this _sender first_ perspective better, and used it originally, but switched to stick with the convention used in the main introductory textbooks on this topic. 

**In general you need to read papers/model descriptions carefully, and hopefully the authors do a good job explaining exactly what is meant. Such that there is no confusion. Just read carefully every time and don't jump to conclusions based on what you have seen before or what you think it means.**




## What to do {#shinytab3}

In the following, we explore a few simple hypothetical interventions for different scenarios and assess their effects. We are thinking of a pathogen like SARS-CoV-2/COVID-19, but the overall findings are general and can apply to other pathogens as well.

**The tasks below are described in a way that assumes everything is in units of days  (rate parameters, therefore, have units of inverse days).**


```{r, echo=FALSE, eval=TRUE}

#this is the running counter for the records which starts at 1 
rc=1

#empty object, will hold all outcomes
alloutcomes = NULL

########################
# Task 1
########################
tid = 1
tasktext = "We start by assuming a population of 1000 individuals, with 20% children, 25% elderly and the remainder middle-aged adults. Set the values for _S~c~_, _S~a~_ and _S~e~_ to reflect these assumptions. Start with one infected adult, no infected in the other groups. We make the assumption that infection lasts around 10 days in each age group. This means setting the rates g~i~=0.1. 

If one wanted to run a model for research or policy purposes, one would want to choose transmission rates within and between groups to approximate reality. These transmission rates depend on the pathogen. For respiratory infections, the POLYMOD data is often used (see _Further Resources_ for references). We keep it simple here and assume that rates of transmission within groups is larger than between groups, but that otherwise all groups have the same rates. We'll set b~cc~ = b~aa~ = b~ee~ = 0.0003 (within-group transmission) and all other transmission rates to 0.0001.  

To obtain age-related mortality that mimic COVID-19, we assume mortality among infected to be 0.1%, 1% and 10% for children, adults and elderly respectively. Set the parameters $m_i$ accordingly. Turn off waning immunity for now. Run the simulation without any control applied, i.e. f~1~ = f~2~ = f~3~ = 0 (thus the start and end times for the control do not matter). Run the simulation for 600 days. 

You should see an outbreak with remaining susceptibles in the children/adult/elderly categories of around 75/110/87. Note that for the number of dead children, you get a value below 1. This doesn't make much sense, however, we are running it for a popualtion of 1000 (so we can see the plots well), so interpret this as number per thousand, which can be less than 1. Also compare the final number of recovered to dead and make sure it's approximately the ratio you would expect based on the mortalities for the different age groups."

nrec = 3 # number of items to record
out_records = c("Total dead children at end of simulation",
                "Total dead adults at end of simulation",
                "Total dead elderly at end of simulation")
out_types = rep("Numeric",nrec)
out_notes = rep("Round to 2 decimal places",nrec)
outcomes = data.frame( TaskID = rep(tid,nrec),
                       TaskText = rep(tasktext,nrec),
                      RecordID = paste0('T',tid,'R',(1:nrec)),
                      Record = out_records, 
                      Type = out_types, 
                      Note = out_notes)
alloutcomes = rbind(alloutcomes,outcomes)
rc = rc + nrec #increment record counter by number of outcomes to record for this task 

#0.12/4.41/16.29

########################
# Task 2
########################
tid = tid + 1
tasktext = "Now lets implement strong control for each age group by setting f~1~ = f~2~ = f~3~ = 0.9. Assume that each control starts 50 days after outbreak start and lasts for 100 days. Keep all other values as previously. Run the simulation. You should see that the strong control initially pushes infected down, but once control is stopped, the outbreak rebounds and the overall size of the outbreak is similar to that without control and the number dead at the end of the simulation are only slightly lower."
nrec = 3 # number of items to record
out_records = c("Total dead children at end of simulation",
                "Total dead adults at end of simulation",
                "Total dead elderly at end of simulation")
out_types = rep("Numeric",nrec)
out_notes = rep("Round to 2 decimal places",nrec)
outcomes = data.frame( TaskID = rep(tid,nrec),
                       TaskText = rep(tasktext,nrec),
                      RecordID = paste0('T',tid,'R',(1:nrec)),
                      Record = out_records, 
                      Type = out_types, 
                      Note = out_notes)
alloutcomes = rbind(alloutcomes,outcomes)
rc = rc + nrec #increment record counter by number of outcomes to record for this task 
  
#0.11/3.96/14.03


########################
# Task 3
########################
tid = tid + 1
tasktext =  "Recall from the multi-outbreak app, the best one can do in a multiple outbreak scenario is to get as close to population immunity as possible without much overshoot, thus preventing further outbreaks. To achieve this, less strong control can be better. We can revisit that idea here. Reduce control strength to 0.4 for each group, leave everything else the same. Record the total dead in the 3 age groups and compare to the ones you got for stronger control. The absolute numbers are small, but convince yourself that the relative change is quite large."
nrec = 3 # number of items to record
out_records = c("Total dead children at end of simulation",
                "Total dead adults at end of simulation",
                "Total dead elderly at end of simulation")
out_types = rep("Numeric",nrec)
out_notes = rep("Round to 2 decimal places",nrec)
outcomes = data.frame( TaskID = rep(tid,nrec),
                       TaskText = rep(tasktext,nrec),
                      RecordID = paste0('T',tid,'R',(1:nrec)),
                      Record = out_records, 
                      Type = out_types, 
                      Note = out_notes)
alloutcomes = rbind(alloutcomes,outcomes)
rc = rc + nrec #increment record counter by number of outcomes to record for this task 

#0.081/3.26/10.73

########################
# Task 4
########################
tid = tid + 1
tasktext = "Now lets explore the idea that control that has a similar impact on number infected can differ in its impact on the number who are dying. This can happen if mortality differs between groups. We'll first target the elderly with some control measures. Set f~1~=0, f~2~=0.0 and f~3~=1. Assume that control starts 50 days after outbreak start and lasts for 100 days. Keep all other values as previously. Run the simulation."
nrec = 2 # number of items to record
out_records = c("Total number susceptible (add all 3 groups) at end of simulation",
                "Total number dead (add all 3 groups) at end of simulation")
out_types = rep("Rounded_Integer",nrec)
out_notes = rep("Round each value to an integer, then add",nrec)
outcomes = data.frame( TaskID = rep(tid,nrec),
                       TaskText = rep(tasktext,nrec),
                      RecordID = paste0('T',tid,'R',(1:nrec)),
                      Record = out_records, 
                      Type = out_types, 
                      Note = out_notes)
alloutcomes = rbind(alloutcomes,outcomes)
rc = rc + nrec #increment record counter by number of outcomes to record for this task 


########################
# Task 5
########################
tid = tid + 1
tasktext = " Now we'll implement control that targets adults. This can be achieved by setting f~1~=0, f~2~=0.52 and f~3~=0. The control strength is chosen to ensure the overall control impact is comparable. Keep all other values as previously. Run the simulation. As you compare these 3 control scenarios, you should find that the total number of susceptible left at the end of the outbreak is the same, however the number dead changes in a likely expected way: Control applied to groups with higher mortality leads to an increased reduction in deaths."
nrec = 2 # number of items to record
out_records = c("Total number susceptible (add all 3 groups) at end of simulation",
                "Total number dead (add all 3 groups) at end of simulation")
out_types = rep("Rounded_Integer",nrec)
out_notes = rep("Round each value to an integer, then add",nrec)
outcomes = data.frame( TaskID = rep(tid,nrec),
                       TaskText = rep(tasktext,nrec),
                      RecordID = paste0('T',tid,'R',(1:nrec)),
                      Record = out_records, 
                      Type = out_types, 
                      Note = out_notes)
alloutcomes = rbind(alloutcomes,outcomes)
rc = rc + nrec #increment record counter by number of outcomes to record for this task 


########################
# Task 6
########################
tid = tid + 1
tasktext = "Now we apply control that focuses on children. Because the population sizes are different, we also need to apply some control to the adults, which is tweaked to get an overall similar strength of control compared to the previous task. This can be achieved by setting f~1~=1, f~2~=0.113 and f~3~=0. Assume that control starts 50 days after outbreak start and lasts for 100 days. Keep all other values as previously. Run the simulation."
nrec = 2 # number of items to record
out_records = c("Total number susceptible (add all 3 groups) at end of simulation",
                "Total number dead (add all 3 groups) at end of simulation")
out_types = rep("Rounded_Integer",nrec)
out_notes = rep("Round each value to an integer, then add",nrec)
outcomes = data.frame( TaskID = rep(tid,nrec),
                       TaskText = rep(tasktext,nrec),
                      RecordID = paste0('T',tid,'R',(1:nrec)),
                      Record = out_records, 
                      Type = out_types, 
                      Note = out_notes)
alloutcomes = rbind(alloutcomes,outcomes)
rc = rc + nrec #increment record counter by number of outcomes to record for this task 
```


```{r echo=FALSE}
#save the fully filled task table to a tsv file
alloutcomes$QuizID = paste0(packagename,"_",appsettings$appid)
alloutcomes$AppTitle = appsettings$apptitle
alloutcomes$AppID = appsettings$appid
#remove a few variables from the data frame
savedoutcomes <- dplyr::select(alloutcomes,QuizID,AppID,AppTitle,TaskID,TaskText,RecordID,Record,Type,Note)		
write.table(savedoutcomes, paste0(appsettings$appid,"_tasktable.tsv"), append = FALSE, sep = "\t", row.names = F, col.names = TRUE)
```


```{r, echo=FALSE, results='asis'}
# Take all the text stored in the table and print the tasks and items to record
write_tasktext(alloutcomes)
```



## Further Information {#shinytab4}

* This app (and all others) are structured such that the Shiny part (the graphical interface you see and the server-side function that goes with it) calls an underlying R script (or several) which runs the simulation for the model of interest and returns the results.
* For this app, the underlying function(s) running the simulation are called ``r appsettings$simfunction``. You can call them directly, without going through the shiny app. Use the `help()` command for more information on how to use the functions directly. If you go that route, you need to use the results returned from this function and produce useful output (such as a plot) yourself. 
* You can also download all simulator functions and modify them for your own purposes.  Of course, to modify these functions, you'll need to do some coding.
* For examples on using the simulators directly and how to modify them, read the package vignette by typing `vignette('DSAIDE')` into the R console.
* This app closely follows a model and analysis described in [@handel2020]. 
* The POLYMOD mixing data is described in [@mossong2008]. Similar studies have since provided additional data, e.g. [@zhang2020b; @klepac2020].

### References

