-
Notifications
You must be signed in to change notification settings - Fork 1
/
08_StochasticIBM_code2.qmd
132 lines (103 loc) · 3.87 KB
/
08_StochasticIBM_code2.qmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
---
title: "08. Stochastic individual-based models (practical 2)"
---
## Practical 2. Adding more complex dynamics to the model
For practical 2, start with the following code:
```{r, eval = FALSE, message = FALSE}
# Individual-based SARS-CoV-2 transmission model, practical 2
library(ggplot2)
## Model parameters
beta <- 0.5 # Transmission parameter
iota <- 1e-5 # Importation rate
delta <- 1/2.5 # Rate of transitioning out of latent state
gamma <- 1/5 # Rate of transitioning out of infectious state
omega <- 1/180 # Rate of waning immunity
dt <- 1 # Time step of simulation (1 day)
days <- 365*2 # Duration of simulation (2 years)
steps <- days/dt # Total number of time steps
n <- 1000 # Population size
## Some helper functions
# Calculates infectiousness as a function of state and age: zero if state is
# not "I"; nonzero if state is "I", and slightly decreasing with age
infectiousness <- function(state, age) {
ifelse(state == "I", 1.25 - age / 160, 0)
}
# Calculates susceptibility of individuals with antibody level(s) ab
susceptibility <- function(ab) {
pnorm(ab, 5, 1, lower.tail = FALSE)
}
# Generates n random delays from the latent-period distribution
# (approximately 2 days, on average)
latent_delay <- function(n) {
rlnorm(n, meanlog = 0.5, sdlog = 0.6)
}
# Generates n random delays from the infectious-period distribution
# (approximately 5 days, on average)
infectious_delay <- function(n) {
rlnorm(n, meanlog = 1.5, sdlog = 0.5)
}
# Generates n random increments to antibody levels following recovery
ab_increment <- function(n) {
rnorm(n, mean = 12, sd = 2)
}
## Data frame to store simulation results
results <- data.frame(ts = 1:steps, S = 0, E = 0, I = 0, R = 0)
## Initialize simulation
# Set the seed for the pseudorandom number generator, for reproducibility
set.seed(12345)
# Initialize state variables
state <- rep("S", n) # Each individual's state: start with all susceptible
state[1:10] <- "E" # Start 10 individuals in the "exposed" state
## Run simulation
# Initialize progress bar
bar <- txtProgressBar(min = 1, max = steps, style = 3)
# Loop over each time step . . .
for (ts in 1:steps) {
# Calculate the force of infection
lambda <- beta * sum(state == "I") / n + iota
# Loop through each host . . .
for (i in 1:n) {
# Update individual i's non-state variables
# . . .
# Update individual i's state
if (state[i] == "S") {
# Transition S -> E (infection) at rate lambda
if (runif(1) < 1 - exp(-lambda * dt)) {
state[i] <- "E"
}
} else if (state[i] == "E") {
# Transition E -> I (latent to infectious) at rate delta
if (runif(1) < 1 - exp(-delta * dt)) {
state[i] <- "I"
}
} else if (state[i] == "I") {
# Transition I -> R (infectious to recovered) at rate gamma
if (runif(1) < 1 - exp(-gamma * dt)) {
state[i] <- "R"
}
} else if (state[i] == "R") {
# Transition R -> S (waning of immunity) at rate omega
if (runif(1) < 1 - exp(-omega * dt)) {
state[i] <- "S"
}
}
}
# Save population state for this time step
results[ts, "S"] <- sum(state == "S")
results[ts, "E"] <- sum(state == "E")
results[ts, "I"] <- sum(state == "I")
results[ts, "R"] <- sum(state == "R")
# Update progress bar; close progress bar if we are finished
setTxtProgressBar(bar, ts)
if (ts == steps) {
close(bar)
}
}
## Plot simulation results
ggplot(results) +
geom_line(aes(x = ts, y = S, colour = "S")) +
geom_line(aes(x = ts, y = E, colour = "E")) +
geom_line(aes(x = ts, y = I, colour = "I")) +
geom_line(aes(x = ts, y = R, colour = "R"))
```
**Return to the practical [here](08_StochasticIBM_practical.qmd#sec2).**