发帖
雷达卡
欢迎使用Markdown编辑器
经管之家：Do the best economic and management education！
Author: Daniel Tulpen Liu
你好！ 这是你第一次使用 Markdown编辑器 所展示的欢迎页。如果你想学习如何使用Markdown编辑器, 可以仔细阅读这篇文章，了解一下Markdown的基本语法知识。
自己的自学资料分享
坦白的说，最近两年写代码非常累。除此而外，还要微博与互粉的国际朋友互动。微博粉丝也就800多，大多数时候是自己自言自语。
同样的，论坛里，我更喜欢自己自言自语，自己发，我不喜欢访问其他人的网页。当然，我经常访问一些国际上比较好的学术资源网页，下载很多很多PDF 格式的文件，也包括程序代码。
这里就不分享网页了， 论坛里其他人分享网页的很多。如果能上外网，自己用 google 一下关键字，比如 garch model in mean ,就可以查询到访问者想要的学术资料。
今天分享的是自己电脑里学习的别人工具包里的测试代码， test that 文件。
context("Network models with tergmLite")
# tergmLite = TRUE -----
test_that("tergmLite: 1G, Closed", {
# SI
num <- 1000
nw <- network_initialize(n = num)
formation <- ~edges
target.stats <- 400
coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 25)
est <- netest(nw, formation, target.stats, coef.diss)
param <- param.net(inf.prob = 0.1, act.rate = 5)
init <- init.net(i.num = 10)
control <- control.net(type = "SI", nsteps = 20, nsims = 1, ncores = 1,
resimulate.network = FALSE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = 1)
summary(sim, at = 20)
# SIS
param <- param.net(inf.prob = 0.5, act.rate = 1, rec.rate = 0.02)
init <- init.net(i.num = 10)
control <- control.net(type = "SIS", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = FALSE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = 1)
summary(sim, at = 10)
# SIR
param <- param.net(inf.prob = 0.5, act.rate = 1, rec.rate = 0.02)
init <- init.net(i.num = 10, r.num = 5)
control <- control.net(type = "SIR", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = FALSE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = 1)
summary(sim, at = 10)
})
test_that("tergmLite: 2G, Closed", {
# SI
num1 <- num2 <- 500
nw <- network_initialize(n = num1 + num2)
nw <- set_vertex_attribute(nw, "group", rep(1:2, each = num1))
formation <- ~edges + nodematch("group")
target.stats <- c(400, 0)
coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 20)
est <- netest(nw, formation, target.stats, coef.diss)
# Parameters
param <- param.net(inf.prob = 0.4, inf.prob.g2 = 0.2)
init <- init.net(i.num = 20, i.num.g2 = 20)
control <- control.net(type = "SI", nsteps = 20, nsims = 1, ncores = 1,
resimulate.network = FALSE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim)
summary(sim, at = 20)
# SIS
param <- param.net(inf.prob = 0.4, inf.prob.g2 = 0.2,
rec.rate = 0.02, rec.rate.g2 = 0.02)
init <- init.net(i.num = 20, i.num.g2 = 20)
control <- control.net(type = "SIS", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = FALSE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim)
summary(sim, at = 10)
# SIR
param <- param.net(inf.prob = 0.4, inf.prob.g2 = 0.2,
rec.rate = 0.02, rec.rate.g2 = 0.02)
init <- init.net(i.num = 10, i.num.g2 = 10, r.num = 5, r.num.g2 = 5)
control <- control.net(type = "SIR", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = FALSE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, mean.col = c(1, 2, 3, 1, 2, 3))
summary(sim, at = 10)
})
test_that("tergmLite: 1G, Open", {
# SI
num <- 1000
nw <- network_initialize(n = num)
formation <- ~edges
target.stats <- 400
coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 10,
d.rate = 0.005)
est <- netest(nw, formation, target.stats, coef.diss)
# Parameters
param <- param.net(inf.prob = 0.4, act.rate = 1,
a.rate = 0.005, ds.rate = 0.005, di.rate = 0.005)
init <- init.net(i.num = 10)
control <- control.net(type = "SI", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = TRUE, tergmLite = TRUE,
verbose = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = FALSE, sim.lines = TRUE)
plot(sim, y = "si.flow", ylim = c(0, 20))
summary(sim, at = 10)
# SIS
param <- param.net(inf.prob = 0.4, act.rate = 1, rec.rate = 0.02,
a.rate = 0.005, ds.rate = 0.005, di.rate = 0.005)
init <- init.net(i.num = 10)
control <- control.net(type = "SIS", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = TRUE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = FALSE, sim.lines = TRUE)
plot(sim, y = c("si.flow", "is.flow"), legend = TRUE)
summary(sim, at = 10)
# SIR
param <- param.net(inf.prob = 0.4, act.rate = 1, rec.rate = 0.02,
a.rate = 0.005, di.rate = 0.005, ds.rate = 0.005,
dr.rate = 0.005)
init <- init.net(i.num = 10, r.num = 0)
control <- control.net(type = "SIR", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = TRUE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = FALSE, sim.lines = TRUE)
plot(sim, qnts = 1)
plot(sim, y = "num", ylim = c(800, 1200))
})
test_that("tergmLite: 2G, Open", {
# SI
num1 <- num2 <- 500
nw <- network_initialize(n = num1 + num2)
nw <- set_vertex_attribute(nw, "group", rep(1:2, each = num1))
formation <- ~edges + nodematch("group")
target.stats <- c(400, 0)
coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 25,
d.rate = 0.005)
est <- netest(nw, formation, target.stats, coef.diss)
# Parameters
param <- param.net(inf.prob = 0.5, inf.prob.g2 = 0.3,
act.rate = 1, a.rate = 0.005, a.rate.g2 = NA,
di.rate = 0.005, ds.rate = 0.005,
di.rate.g2 = 0.005, ds.rate.g2 = 0.005)
init <- init.net(i.num = 50, i.num.g2 = 50)
control <- control.net(type = "SI", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = TRUE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = FALSE, sim.lines = TRUE)
plot(sim, qnts = 1, ylim = c(0, 500))
# SIS
param <- param.net(inf.prob = 0.5, inf.prob.g2 = 0.3,
act.rate = 1, a.rate = 0.005, a.rate.g2 = NA,
di.rate = 0.005, ds.rate = 0.005,
di.rate.g2 = 0.005, ds.rate.g2 = 0.005,
rec.rate = 0.02, rec.rate.g2 = 0.02)
init <- init.net(i.num = 50, i.num.g2 = 50)
control <- control.net(type = "SIS", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = TRUE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = FALSE, sim.lines = TRUE)
plot(sim, qnts = 1, ylim = c(0, 500))
# SIR
param <- param.net(inf.prob = 0.1, inf.prob.g2 = 0.2,
act.rate = 5, a.rate = 0.005, a.rate.g2 = 0.005,
di.rate = 0.005, ds.rate = 0.005,
di.rate.g2 = 0.005, ds.rate.g2 = 0.005,
dr.rate = 0.005, dr.rate.g2 = 0.005,
rec.rate = 0.005, rec.rate.g2 = 0.005)
init <- init.net(i.num = 10, i.num.g2 = 10, r.num = 5, r.num.g2 = 5)
control <- control.net(type = "SIR", nsteps = 10, nsims = 1, ncores = 1,
resimulate.network = TRUE, tergmLite = TRUE)
sim <- netsim(est, param, init, control)
plot(sim, qnts = FALSE, sim.lines = TRUE)
plot(sim, qnts = 1, ylim = c(0, 500))
})
test_that("Models with duration = 1", {
num <- 1000
nw <- network_initialize(n = num)
formation <- ~edges
target.stats <- 400
coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 1)
est <- netest(nw, formation, target.stats, coef.diss)
param <- param.net(inf.prob = 0.1, act.rate = 5)
init <- init.net(i.num = 10)
control <- control.net(type = "SI", nsteps = 5, nsims = 1, ncores = 1,
tergmLite = FALSE, resimulate.network = TRUE)
sim <- netsim(est, param, init, control)
control <- control.net(type = "SI", nsteps = 5, nsims = 1, ncores = 1,
tergmLite = TRUE, resimulate.network = TRUE)
sim <- netsim(est, param, init, control)
})
程序的其他部分
context("New Network Models")
test_that("New network models vignette example", {
## New Aging Module
aging <- function(dat, at) {
age <- get_attr(dat, "age", override.null.error = TRUE)
if (is.null(age)) {
active <- get_attr(dat, "active")
n <- sum(active == 1)
age <- sample(18:49, n, replace = TRUE)
} else {
age <- get_attr(dat, "age") + 1 / 12
}
dat <- set_attr(dat, "age", age)
return(dat)
}
## Replacement Departure Module
dfunc <- function(dat, at) {
active <- get_attr(dat, "active")
idsElig <- which(active == 1)
nElig <- length(idsElig)
nDepartures <- 0
if (nElig > 0) {
ages <- get_attr(dat, "age")[idsElig]
life.expt <- get_param(dat, "life.expt")
departure.rates <- pmin(1, 1 / (life.expt * 12 - ages * 12))
vecDepartures <- which(rbinom(nElig, 1, departure.rates) == 1)
idsDepartures <- idsElig[vecDepartures]
nDepartures <- length(idsDepartures)
if (nDepartures > 0) {
active[idsDepartures] <- 0
dat <- set_attr(dat, "active", active)
}
}
# Output ----------------------------------
dat <- set_epi(dat, "d.flow", at, nDepartures)
return(dat)
}
## Replacement Arrival Module
afunc <- function(dat, at) {
# Variables ---------------------------------------------------------------
growth.rate <- get_param(dat, "growth.rate")
exptPopSize <- get_epi(dat, "num", 1) * (1 + growth.rate * at)
n <- sum(get_attr(dat, "active") == 1)
active <- get_attr(dat, "active")
numNeeded <- exptPopSize - sum(active == 1)
if (numNeeded > 0) {
nArrivals <- rpois(1, numNeeded)
} else {
nArrivals <- 0
}
# Output ------------------------------------------------------------------
dat <- set_epi(dat, "a.flow", at, nArrivals)
return(dat)
}
## Network Model
nw <- network.initialize(50, directed = FALSE)
est <- netest(nw, formation = ~edges, target.stats = 15,
coef.diss = dissolution_coefs(~offset(edges), 60, 0.000274),
verbose = FALSE)
## EpiModel
param <- param.net(inf.prob = 0.35, growth.rate = 0.00083, life.expt = 70)
init <- init.net(i.num = 10)
control <- control.net(type = NULL, nsims = 1, nsteps = 5,
departures.FUN = dfunc,
arrivals.FUN = afunc, aging.FUN = aging,
infection.FUN = infection.net,
tergmLite = FALSE, resimulate.network = TRUE)
mod1 <- netsim(est, param, init, control)
mod1
expect_is(mod1, "netsim")
expect_output(print(mod1), "resim_nets.FUN")
expect_output(print(mod1), "infection.FUN")
expect_output(print(mod1), "departures.FUN")
expect_output(print(mod1), "arrivals.FUN")
expect_output(print(mod1), "aging.FUN")
## Test module reordering
control <- control.net(type = NULL, nsims = 1, nsteps = 10,
departures.FUN = dfunc,
arrivals.FUN = afunc, aging.FUN = aging,
infection.FUN = infection.net,
module.order = c("resim_nets.FUN", "infection.FUN",
"aging.FUN", "arrivals.FUN",
"departures.FUN", "prevalence.FUN"),
tergmLite = FALSE, resimulate.network = TRUE)
mod2 <- netsim(est, param, init, control)
expect_is(mod2, "netsim")
### tergmLite replication
param <- param.net(inf.prob = 0.35, growth.rate = 0.00083, life.expt = 70)
init <- init.net(i.num = 10)
control <- control.net(type = NULL, nsims = 1, nsteps = 10,
infection.FUN = infection.net,
departures.FUN = dfunc,
arrivals.FUN = afunc, aging.FUN = aging,
tergmLite = TRUE, verbose = FALSE,
resimulate.network = TRUE)
mod3 <- netsim(est, param, init, control)
expect_is(mod3, "netsim")
## Test module reordering
control <- control.net(type = NULL, nsims = 1, nsteps = 10,
departures.FUN = dfunc,
arrivals.FUN = afunc, aging.FUN = aging,
infection.FUN = infection.net,
module.order = c("resim_nets.FUN", "infection.FUN",
"aging.FUN", "arrivals.FUN",
"departures.FUN", "prevalence.FUN"),
tergmLite = TRUE, resimulate.network = TRUE)
mod4 <- netsim(est, param, init, control)
expect_is(mod4, "netsim")
## "updated" infection module
infect <- infection.net
control <- control.net(type = NULL, nsims = 1, nsteps = 10,
departures.FUN = dfunc,
arrivals.FUN = afunc, aging.FUN = aging,
infection.FUN = infect,
module.order = c("resim_nets.FUN", "infection.FUN",
"aging.FUN", "arrivals.FUN",
"departures.FUN", "prevalence.FUN"),
tergmLite = TRUE, resimulate.network = TRUE)
mod5 <- netsim(est, param, init, control)
expect_is(mod5, "netsim")
expect_output(print(mod5), "resim_nets.FUN")
expect_output(print(mod5), "infection.FUN")
expect_output(print(mod5), "departures.FUN")
expect_output(print(mod5), "arrivals.FUN")
expect_output(print(mod5), "aging.FUN")
})
京公网安备 11010802022788号
