Skip to content

Commit 6d542e1

Browse files
committed
ngm demo
1 parent bb6858c commit 6d542e1

File tree

1 file changed

+99
-0
lines changed

1 file changed

+99
-0
lines changed

scratch/demo.qmd

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,99 @@
1+
---
2+
title: Next-generation matrix demo
3+
format: html
4+
---
5+
6+
The next generation matrix $K$ has entries $K_{ij}$. Every infection in group $i$ in this generation will give rise to $K_{ij}$ infections in group $j$ in the next generation.
7+
8+
In this example, there are four groups. The core group transmits many infections to themselves and to travelers, who in turn transfer many infections to the core group (but not to themselves). Children and the general public don't transmit very much.
9+
10+
```{r}
11+
# high and low transmission rates
12+
hi <- 3.0
13+
lo <- 0.5
14+
15+
K <- matrix(c(
16+
hi, lo, hi, lo, # core
17+
lo, lo, lo, lo, # kids
18+
hi, lo, lo, lo, # travelers
19+
lo, lo, lo, lo # general
20+
), nrow = 4, ncol = 4)
21+
```
22+
23+
Given a length-4 vector of infections $x$, representing the number of infections in each group in some generation, the next generation will have $Kx$ infections in each group.
24+
25+
By definition, $v$ and $\lambda$ are an eigenvector and eigenvalue of $K$ if $Kv = \lambda v$:
26+
27+
```{r}
28+
# do the eigenvalue analysis
29+
e <- eigen(K)
30+
# which eigenvalue is the dominant one?
31+
i <- which.max(e$values)
32+
dominant_eigenvalue <- e$values[i]
33+
# get the corresponding eigenvector
34+
v <- e$vectors[, i]
35+
36+
# note that this vector is L2-normalized
37+
# (I need all.equal because there is some machine precision limitation)
38+
stopifnot(all.equal(sqrt(sum(v ** 2)), 1.0))
39+
40+
# but we want an L1-normalized vector
41+
dominant_eigenvector <- v / sum(v)
42+
43+
print("Dominant eigenvalue:")
44+
print(dominant_eigenvalue)
45+
print("Dominant eigenvector:")
46+
print(dominant_eigenvector)
47+
```
48+
49+
Let's do an example, to show how these would play out. Start with a single infection, in the core group:
50+
51+
```{r}
52+
x0 <- c(1, 0, 0, 0)
53+
```
54+
55+
Then iteratively generate next generations:
56+
57+
```{r}
58+
n_generations <- 10
59+
60+
x <- x0
61+
results <- list(x0)
62+
for (i in 1:(n_generations - 1)) {
63+
x <- K %*% x
64+
results <- c(results, list(as.vector(x)))
65+
}
66+
```
67+
68+
Toward the end of the simulation, $x$ will be large, but it has the same distribution as the L1-normalized dominant eigenvector:
69+
70+
```{r}
71+
print("Final numbers of infections:")
72+
last_x <- results[[length(results)]]
73+
print(last_x)
74+
75+
print("Same thing, L1-normalized:")
76+
print(last_x / sum(last_x))
77+
```
78+
79+
Note that this is the same as the L1-normalized dominant eigenvector.
80+
81+
We can also check how the number of infections changes from generation to generation:
82+
83+
```{r}
84+
# get the total number of infections per generation
85+
total_infections <- purrr::map_dbl(results, sum)
86+
print("Total infections per generation:")
87+
print(total_infections)
88+
89+
# and the ratio of infections between generations
90+
empirical_r <- purrr::map_dbl(
91+
2:n_generations,
92+
function(i) total_infections[i] / total_infections[i - 1]
93+
)
94+
95+
print("Ratio of infections between generations")
96+
print(empirical_r)
97+
```
98+
99+
Note that this stabilizes to the dominant eigenvalue.

0 commit comments

Comments
 (0)