|
| 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