Skip to content

Commit f878900

Browse files
committed
scratch code
1 parent 7977489 commit f878900

File tree

2 files changed

+93
-1
lines changed

2 files changed

+93
-1
lines changed

.lintr

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,5 @@
1-
linters: linters_with_defaults(object_usage_linter = NULL)
1+
linters: linters_with_defaults(
2+
object_usage_linter = NULL,
3+
object_name_lintr = NULL
4+
)
25
encoding: "UTF-8"

scratch/test-ngm.R

Lines changed: 89 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
# script to calculate next generation for some basic models
2+
3+
library(epimdr2)
4+
5+
##### SEIR model ###########
6+
# example from package vignette
7+
istates <- c("E", "I")
8+
flist <- c(dEdt = quote(beta * S * I / N), dIdt = quote(0))
9+
Vm1 <- quote(mu * E + sigma * E)
10+
Vm2 <- quote(mu * I + alpha * I + gamma * I)
11+
Vp1 <- 0
12+
Vp2 <- quote(sigma * E)
13+
V1 <- substitute(a - b, list(a = Vm1, b = Vp1))
14+
V2 <- substitute(a - b, list(a = Vm2, b = Vp2))
15+
vlist <- c(V1, V2)
16+
params <- list(mu = 0, alpha = 0, beta = 5, gamma = .8, sigma = 1.2, N = 1)
17+
df <- list(S = 1, E = 0, I = 0, R = 0)
18+
nextgenR0(
19+
Istates = istates, Flist = flist,
20+
Vlist = vlist, parameters = params, dfe = df
21+
)
22+
params$beta / params$gamma
23+
24+
###### SIR Model with two risk groups (high and low) #########
25+
# example from keeling and rohani
26+
istates <- c("IH", "IL")
27+
flist <- c(
28+
dIHdt = quote(bHH * SH * IH + bHL * SH * IL),
29+
dILdt = quote(bLH * SL * IH + bLL * SL * IL)
30+
)
31+
Vm1 <- quote(gamma * IH)
32+
Vm2 <- quote(gamma * IL)
33+
Vp1 <- 0
34+
Vp2 <- 0
35+
V1 <- substitute(a - b, list(a = Vm1, b = Vp1))
36+
V2 <- substitute(a - b, list(a = Vm2, b = Vp2))
37+
vlist <- c(V1, V2)
38+
params <- list(
39+
bHH = 10, bHL = 0.1,
40+
bLH = 0.1, bLL = 1,
41+
gamma = 1
42+
)
43+
df <- list(
44+
SH = 0.2, SL = 0.8,
45+
IH = 0, IL = 0,
46+
RH = 0, RL = 0
47+
)
48+
nextgenR0(Istates = istates, Flist = flist, Vlist = vlist, parameters = params, dfe = df)
49+
50+
J <- matrix(c(
51+
params$bHH * df$SH - params$gamma, params$bHL * df$SH,
52+
params$bLH * df$SL, params$bLL * df$SL - params$gamma
53+
), nrow = 2)
54+
# when params$gamma = 1, R0=
55+
(params$bHH * df$SH + params$bLH * df$SL) * (1 - (norm(eigen(J)$vectors) - 1)) +
56+
(params$bHL * df$SH + params$bLL * df$SL) * (norm(eigen(J)$vectors) - 1)
57+
(params$bHH * df$SH + params$bLH * df$SL) * .9376 +
58+
(params$bHL * df$SH + params$bLL * df$SL) * .0624
59+
60+
####### SIR Model with 3 classes ######
61+
# K, C, G: kids, core, general
62+
istates <- c("IK", "IC", "IG")
63+
flist <- c(
64+
dIKdt = quote(bKK * SK * IK + bKC * SK * IC + bKG * SK * IG),
65+
dICdt = quote(bCK * SC * IK + bCC * SC * IC + bCG * SC * IG),
66+
dIGdt = quote(bGK * SG * IK + bGC * SG * IC + bGG * SG * IG)
67+
)
68+
Vm1 <- quote(gamma * IK)
69+
Vm2 <- quote(gamma * IC)
70+
Vm3 <- quote(gamma * IG)
71+
Vp1 <- 0
72+
Vp2 <- 0
73+
Vp3 <- 0
74+
V1 <- substitute(a - b, list(a = Vm1, b = Vp1))
75+
V2 <- substitute(a - b, list(a = Vm2, b = Vp2))
76+
V3 <- substitute(a - b, list(a = Vm3, b = Vp3))
77+
vlist <- c(V1, V2, V3)
78+
params <- list(
79+
bKK = 10, bKC = 1, bKG = 1,
80+
bCK = 1, bCC = 10, bCG = 1,
81+
bGK = 1, bGC = 1, bGG = 1,
82+
gamma = 1
83+
)
84+
df <- list(
85+
SK = 0.1, SC = 0.1, SG = 0.8,
86+
IK = 0, IC = 0, IG = 0,
87+
RK = 0, RC = 0, RG = 0
88+
)
89+
nextgenR0(Istates = istates, Flist = flist, Vlist = vlist, parameters = params, dfe = df)

0 commit comments

Comments
 (0)