Network models in EpiModel allow for time-varying transmission probabilities and act rates. For both parameters, time is relative to the time of infection. This allows for modeling of heterogeneity in transmission risk as a function of, for example, the disease stage of the infected partner in a discordant relationship.

# Generic Model

To vary transmission probability over disease stage, pass a vector into the inf.prob parameter within param.net. The vector should contain a transmission probability for each time step of a person’s infection. EpiModel will repeat the final number in the vector for the total length of a person’s infection, even if it lasts longer than that duration implied by the length of the vector (consider the implications of that!).

To model a two-stage infection where the second stage persists at a lower rate for the length of a person’s infection, however long that is, use this. With the time unit in weeks, in this case, probability will be 50% for the first 10 weeks of a person’s infection and 5% thereafter for the total duration of his infection.

probs <- c(0.5, 0.05)
durs <- c(10, 1)
inf.probs <- rep(probs, durs)

Act rates may also vary by infection duration. Consider the situation above where there is a high transmission probability during an acute stage of infection, but there would be more variability in the number of acts during this acute stage. For example, the mean number of acts across infection time is 3, but during the acute stage it is a random draw with the mean of 3:

act.rates <- c(rpois(10, lambda = 3), 3)

This is the time-series of both the infection probabilities and act rates. Again, the final value for each will persist for the duration of the person’s infection until to recovery or exit from the network.

par(mfrow = c(1, 2))
plot(inf.probs, type = "S", lwd = 2, ylim = 0:1)
plot(act.rates, type = "S", lwd = 2)
abline(h = 3, lty = 2)

Here we estimate a basic ERGM and simulate an SIS disease over that network to examine the output. Note that the vectors of inf.probs and act.rates is entered into param.net instead of single values.

nw <- network.initialize(n = 100, directed = FALSE)
formation <- ~edges
target.stats <- 50
coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 20)
est <- netest(nw, formation, target.stats, coef.diss, verbose = FALSE)
param <- param.net(inf.prob = inf.probs, act.rate = act.rates, rec.rate = 0.01)
init <- init.net(i.num = 10)
control <- control.net(type = "SIS", nsteps = 100, nsims = 1)
sim <- netsim(est, param, init, control)

Now the transmission matrix shows variation in the transProb and actRate by infDur, or the duration of infection.

tm <- get_transmat(sim)
head(tm, 10)
   at          sus          inf infDur transProb actRate finalProb
1   2 b80d5deb92c3 b80d296a3a85      1      0.50       1  0.500000
2   3 b80d10255b73 b80d26c789b0     37      0.05       3  0.142625
3   4 b80d69c47bbf b80d10255b73      1      0.50       1  0.500000
4   4 b80d62986ed8 b80d10255b73      1      0.50       1  0.500000
5   4 b80d3561fb04 b80d296a3a85      2      0.50       3  0.875000
6   5 b80d2decca16 b80d3561fb04      1      0.50       1  0.500000
7   5 b80d712a5ce7 b80d36c9ae6b    114      0.05       3  0.142625
8   5 b80d4a0858f2 b80d10255b73      2      0.50       3  0.875000
9   5 b80d33a6defd b80d69c47bbf      1      0.50       1  0.500000
10  6 b80d54274605 b80d69c47bbf      2      0.50       3  0.875000
mean(tm\$infDur <= 10)
[1] 0.5071429

# HIV Model

Hollingsworth (2008) estimated the rates of HIV-1 transmission by month of infection, wherein there are four stages of disease: acute, chronic, preAIDS, and AIDS. The monthly transmission rates in each of these stages is 0.2055, 0.0088, 0.0614, and 0, respectively. The duration of each of these stages in months is estimated as 3, 100, 9, and 10 months, respectively. Therefore, the transmission probability vector would be specified as:

probs <- c(0.2055, 0.0088, 0.0614, 0)
durs <- c(3, 100, 9, 10)
inf.probs <- rep(probs, durs)
inf.probs
  [1] 0.2055 0.2055 0.2055 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[11] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[21] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[31] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[41] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[51] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[61] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[71] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[81] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[91] 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088 0.0088
[101] 0.0088 0.0088 0.0088 0.0614 0.0614 0.0614 0.0614 0.0614 0.0614 0.0614
[111] 0.0614 0.0614 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000
[121] 0.0000 0.0000

That corresponds to the rate of infection in a monthly time step in which the infected partner is at each of those 122 months in his or her infection.

In Hollingsworth, acts were not explicitly modeled, but there were effectively zero acts in the final stage. So an alternative parameterization that models acts (with a hypothetical increased transmission probability during AIDS) would be:

probs <- c(0.2055, 0.0088, 0.0614, 0.1)
acts <- c(1, 1, 1, 0)
durs <- c(3, 100, 9, 10)
inf.probs <- rep(probs, durs)
act.rates <- rep(acts, durs)

Here’s a plot of the time series of the probabilities and rates over the course of HIV infection.

par(mfrow = c(1,1))
plot(inf.probs, type = "S", ylim = c(0, 1), lwd = 2)
lines(act.rates, type = "S", col = 2, lwd = 2)
legend(1, 0.8, legend = c("inf.probs", "act.rates"),
lwd = 3, col = 1:2, bty = "n")

Last updated: 2019-08-13 with EpiModel v1.7.2