---
title: Scheduled events
author:
  Stefan Widgren
  <a href="https://orcid.org/0000-0001-5745-2284">
    <img src="https://info.orcid.org/wp-content/uploads/2019/11/orcid_16x16.png"
         alt="ORCID logo"
         width="16"
         height="16"
         style="border-style:none;" />
  </a>
output:
  html_vignette:
    toc: true
    toc_depth: 3
vignette: >
  %\VignetteIndexEntry{Scheduled events}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

NB: This vignette is work-in-progress and not yet complete.

## Overview

This vignette describes how births, deaths and movements can be
incorporated into a model as scheduled events at predefined
time-points.  Events can, for example, be used to simulate disese
spread among multiple subpopulations (e.g., farms) when individuals
can move between the subpopulations and thus transfer infection, see
Figure 1.  In SimInf, we use `node` to denote a subpopulation.

$~$

```{r pressure, echo=FALSE, fig.align="left", fig.cap="**Figure 1.** Illustration of movements between nodes. Each time step depicts movements during one time unit, for example, a day. The network has *N=4* nodes where node *1* is infected and nodes *2*--*4* are non-infected. Arrows indicate movements of individuals from a source node to a destination node and labels denote the size of the shipment. Here, infection may spread from node *1* to node *3* at *t=2* and then from node *3* to node *2* at *t=3*.", out.width = '100%'}
knitr::include_graphics("img/temporal-network.svg")
```

## A first example

Let us define the **6** movement events in Figure 1 to include them in
an SIR model. Below is a `data.frame`, that contains the
movements. Interpret it as follows:

1. In time step **1** we move **9** individuals from node **3** to node **2**
2. In time step **1** we move **2** individuals from node **3** to node **4**
3. In time step **2** we move **8** individuals from node **1** to node **3**
4. In time step **2** we move **3** individuals from node **4** to node **3**
5. In time step **3** we move **5** individuals from node **3** to node **2**
6. In time step **3** we move **4** individuals from node **4** to node **2**

```{r, eval = TRUE, echo = TRUE, message = FALSE}
events <- data.frame(
  event      = rep("extTrans", 6),  ## Event "extTrans" is
                                    ##  a movement between nodes
  time       = c(1, 1, 2, 2, 3, 3), ## The time that the event happens
  node       = c(3, 3, 1, 4, 3, 4), ## In which node does the event occur
  dest       = c(4, 2, 3, 3, 2, 2), ## Which node is the destination node
  n          = c(9, 2, 8, 3, 5, 4), ## How many individuals are moved
  proportion = c(0, 0, 0, 0, 0, 0), ## This is not used when n > 0
  select     = c(4, 4, 4, 4, 4, 4), ## Use the 4th column in
                                    ## the model select matrix
  shift      = c(0, 0, 0, 0, 0, 0)) ## Not used in this example
```

and have a look at the `data.frame`

```{r}
events
```

Now, create an SIR model where we turn off the disease dynamics
(beta=0, gamma=0) to focus on the scheduled events. Let us start with
different number of individuals in each node.

```{r}
library(SimInf)

model <- SIR(u0 = data.frame(S = c(10, 15, 20, 25),
                             I = c(5,  0,  0,  0),
                             R = c(0,  0,  0,  0)),
             tspan = 0:3,
             beta = 0,
             gamma = 0,
             events = events)
```

The compartments that an event operates on, is controlled by the
select value specified for each event together with the model select
matrix (E). Each row in E corresponds to one compartment in the model,
and the non-zero entries in a column indicate which compartments to
sample individuals from when processing an event. Which column to use
in E for an event is determined by the event select value. In this
example, we use the 4<sup>th</sup> column which means that all
compartments can be sampled in each movement event (see below).

```{r}
model@events@E
```

In another case you might be interested in only targeting the
susceptibles, which means for this model that we select the first
column. Now, let us run the model and generate data from it. For
reproducibility, we first call the `set.seed()` function and specify
the number of threads to use since there is random sampling involved
when picking inviduals from the compartments.

```{r}
set.seed(1)
set_num_threads(1)
result <- run(model)
```

And plot (Figure 2) the number of individuals in each node.

```{r, fig.width=7, fig.height=4, fig.align="left", fig.cap="**Figure 2.** Number of susceptible, infected and recovered individuals in each node."}
plot(result, range = FALSE)
```

$~$

Or use the `trajectory()` function to more easily inspect the outcome
in each node in detail.

```{r}
trajectory(result)
```

## Varying probability of picking individuals

It is possible to assign different probabillities for the compartments
that an event sample individuals from.  If the weights in the select
matrix $E$ are non-identical, individuals are sampled from a biased
urn.  To illustrate this, let us create movement events between two
nodes for the built-in SIR model, where we start with 300 individuals
($S = 100$, $I = 100$, $R = 100$) in the first node and then move
them, one by one, to the second node.

```{r}
u0 <- data.frame(S = c(100, 0),
                 I = c(100, 0),
                 R = c(100, 0))
```

```{r}
events <- data.frame(
  event = rep("extTrans", 300), ## Event "extTrans" is a movement between nodes
  time = 1:300,                 ## The time that the event happens
  node = 1,                     ## In which node does the event occur
  dest = 2,                     ## Which node is the destination node
  n = 1,                        ## How many individuals are moved
  proportion = 0,               ## This is not used when n > 0
  select = 4,                   ## Use the 4th column in the model select matrix
  shift = 0)                    ## Not used in this example
```

Now, create the model. Then run it, and plot the number of individuals
in the second node.

```{r}
model <- SIR(u0 = u0,
             tspan = 1:300,
             events = events,
             beta = 0,
             gamma = 0)
```

```{r, fig.width=7, fig.height=4, fig.align="left", fig.cap="**Figure 3.** The individuals have an equal probability of being selected regardless of compartment."}
plot(run(model), index = 2)
```

$~$

The probability to sample an individual from each compartment is

$$
p_S = \frac{w_S * S}{w_S * S + w_I * I + w_R * R}
$$

$$
p_I = \frac{w_I * I}{w_S * S + w_I * I + w_R * R}
$$

$$
p_R = \frac{w_R * R}{w_S * S + w_I * I + w_R * R}
$$

Where $w_S$, $w_I$ and $w_R$ are the weights in E.  These
probabilities are applied sequentially, that is the probability of
choosing the next item is proportional to the weights amongst the
remaining items.  Let us now double the weight to sample individuals
from the $I$ compartment and then run the model again.

```{r, fig.width=7, fig.height=4, fig.align="left", fig.cap="**Figure 4.** The individuals in the $I$ compartment are more likely of being selected for a movement event."}
model@events@E[2, 4] <- 2
plot(run(model), index = 2)
```

$~$

And a much larger weight to sample individuals from the $I$
compartment.

```{r, fig.width=7, fig.height=4, fig.align="left", fig.cap="**Figure 5.** The individuals in the $I$ compartment are even more likely of being selected for a movement event compared to the previous example."}
model@events@E[2, 4] <- 10
plot(run(model), index = 2)
```

$~$

Increase the weight for the $R$ compartment and run the model again.

```{r, fig.width=7, fig.height=4, fig.align="left", fig.cap="**Figure 6.** The individuals in the $I$ and $R$ compartments are more likely of being selected for a movement event compared to individuals in the $S$ compartment."}
model@events@E[3, 4] <- 4
plot(run(model), index = 2)
```