## ## Tutorial: Dynamic Network Visualization ## Day 3 | Network Modeling for Epidemics ## ## Installation and setup # try this first install.packages("ndtv") # load the package and check the version library("ndtv") packageVersion("ndtv") # load EpiModel library("EpiModel") # Set seed set.seed(1234) # Model 1: Edges-Only ----------------------------------------------------- # Network model nw <- network_initialize(n = 100) formation <- ~edges target.stats <- 40 coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 20) est <- netest(nw, formation, target.stats, coef.diss) # Epidemic model param <- param.net(inf.prob = 1) init <- init.net(i.num = 1) control <- control.net(type = "SI", nsteps = 25, nsims = 1) sim <- netsim(est, param, init, control) # Extract and and process networks nw <- get_network(sim) nw nw <- color_tea(nw, verbose = FALSE) # Revisting static visualizations tm <- get_transmat(sim) tm par(mfrow = c(1, 3), mar = c(3, 3, 2, 1)) plot(tm, style = "phylo") plot(tm, style = "network", displaylabels = TRUE) plot(tm, style = "transmissionTimeline") par(mfrow = c(1, 1), mar = c(3, 3, 2, 1)) proximity.timeline(nw, vertex.col = "ndtvcol", spline.style = "color.attribute", mode = "sammon", default.dist = 10, chain.direction = "reverse") # Dynamic network movies for first 25 time steps slice.par <- list(start = 1, end = 25, interval = 1, aggregate.dur = 1, rule = "any") render.par <- list(tween.frames = 10, show.time = FALSE) plot.par <- list(mar = c(0, 0, 0, 0)) # Layout options compute.animation(nw, slice.par = slice.par, verbose = TRUE) # Render animation render.d3movie( nw, render.par = render.par, plot.par = plot.par, vertex.cex = 0.9, vertex.col = "ndtvcol", edge.col = "darkgrey", vertex.border = "lightgrey", displaylabels = FALSE, filename = paste0(getwd(), "/movie.html")) # Embed in RMarkdown # render.d3movie( # nw, # render.par = render.par, # plot.par = plot.par, # vertex.cex = 0.9, # vertex.col = "ndtvcol", # edge.col = "darkgrey", # vertex.border = "lightgrey", # displaylabels = FALSE, # output.mode = "htmlWidget") # Model 2: No concurrency ------------------------------------------------- # the expected number of concurrent nodes is a function of a Poisson # distribution with the parameter equal to the mean degree ppois(1, lambda = 0.8, lower.tail = FALSE) * 100 # Network model nw <- network_initialize(n = 100) formation <- ~edges + concurrent target.stats <- c(40, 0) coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 20) est <- netest(nw, formation, target.stats, coef.diss) # Epidemic model set.seed(12345) param <- param.net(inf.prob = 1) init <- init.net(i.num = 1) control <- control.net(type = "SI", nsteps = 25, nsims = 1) sim <- netsim(est, param, init, control) # Static transmission output par(mfrow = c(1, 3), mar = c(3, 3, 2, 1)) tm <- get_transmat(sim) plot(tm, style = "phylo") plot(tm, style = "network", displaylabels = TRUE) plot(tm, style = "transmissionTimeline") # Dynamic network movie nw <- get_network(sim) nw <- color_tea(nw, verbose = FALSE) compute.animation(nw, slice.par = slice.par) render.d3movie( nw, render.par = render.par, plot.par = plot.par, vertex.cex = 0.9, vertex.col = "ndtvcol", edge.col = "darkgrey", vertex.border = "lightgrey", displaylabels = FALSE, filename = paste0(getwd(), "/movie.html")) # render.d3movie( # nw, # render.par = render.par, # plot.par = plot.par, # vertex.cex = 0.9, # vertex.col = "ndtvcol", # edge.col = "darkgrey", # vertex.border = "lightgrey", # displaylabels = FALSE, # output.mode = "htmlWidget") # Model 3: Relational duration -------------------------------------------- ## Model 3a: Very long durations # Network model nw <- network_initialize(n = 100) formation <- ~edges target.stats <- 40 coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 1e5) est <- netest(nw, formation, target.stats, coef.diss) # Epidemic model param <- param.net(inf.prob = 1) init <- init.net(i.num = 1) control <- control.net(type = "SI", nsteps = 25, nsims = 1) sim <- netsim(est, param, init, control) # Dynamic network movie nw <- get_network(sim) nw <- color_tea(nw, verbose = FALSE) compute.animation(nw, slice.par = slice.par) render.d3movie( nw, render.par = render.par, plot.par = plot.par, vertex.cex = 0.9, vertex.col = "ndtvcol", edge.col = "darkgrey", vertex.border = "lightgrey", displaylabels = FALSE, filename = paste0(getwd(), "/movie.html")) # render.d3movie( # nw, # render.par = render.par, # plot.par = plot.par, # vertex.cex = 0.9, # vertex.col = "ndtvcol", # edge.col = "darkgrey", # vertex.border = "lightgrey", # displaylabels = FALSE, # output.mode = "htmlWidget") ## Model 3b: Short duration contacts # Network model nw <- network_initialize(n = 100) formation <- ~edges target.stats <- 40 coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 2) est <- netest(nw, formation, target.stats, coef.diss) # Epidemic model param <- param.net(inf.prob = 1) init <- init.net(i.num = 1) control <- control.net(type = "SI", nsteps = 25, nsims = 1) sim <- netsim(est, param, init, control) # Dynamic network movie nw <- get_network(sim) nw <- color_tea(nw, verbose = FALSE) compute.animation(nw, slice.par = slice.par) render.d3movie( nw, render.par = render.par, plot.par = plot.par, vertex.cex = 0.9, vertex.col = "ndtvcol", edge.col = "darkgrey", vertex.border = "lightgrey", displaylabels = FALSE, filename = paste0(getwd(), "/movie.html")) # render.d3movie( # nw, # render.par = render.par, # plot.par = plot.par, # vertex.cex = 0.9, # vertex.col = "ndtvcol", # edge.col = "darkgrey", # vertex.border = "lightgrey", # displaylabels = FALSE, # output.mode = "htmlWidget") # Model 4: Triangles ------------------------------------------------------ # Network and epidemic models nw <- network_initialize(n = 100) formation <- ~edges + gwesp(0, TRUE) target.stats <- c(40, 25) coef.diss <- dissolution_coefs(dissolution = ~offset(edges), duration = 20) est <- netest(nw, formation, target.stats, coef.diss) sim <- netsim(est, param, init, control) # Dynamic network movie nw <- get_network(sim) nw <- color_tea(nw, verbose = FALSE) compute.animation(nw, slice.par = slice.par) render.d3movie( nw, render.par = render.par, plot.par = plot.par, vertex.cex = 0.9, vertex.col = "ndtvcol", edge.col = "darkgrey", vertex.border = "lightgrey", displaylabels = FALSE, filename = paste0(getwd(), "/movie.html")) # render.d3movie( # nw, # render.par = render.par, # plot.par = plot.par, # vertex.cex = 0.9, # vertex.col = "ndtvcol", # edge.col = "darkgrey", # vertex.border = "lightgrey", # displaylabels = FALSE, # output.mode = "htmlWidget") # Model 5: Extra nodal attributes ----------------------------------------- # Network model nw <- network_initialize(n = 100, directed = FALSE) nw <- set_vertex_attribute(nw, "race", rbinom(100, 1, 0.5)) nw <- set_vertex_attribute(nw, "age", sample(18:50, 100, TRUE)) nw formation <- ~edges + nodematch("race") + nodefactor("race") + absdiff("age") + concurrent target.stats <- c(50, 40, 70, 100, 30) coef.diss <- dissolution_coefs(dissolution = ~offset(edges) + offset(nodematch("race")), duration = c(20, 10)) est <- netest(nw, formation, target.stats, coef.diss) # Epidemic model param <- param.net(inf.prob = 1) init <- init.net(i.num = 10) control <- control.net(type = "SI", nsteps = 25, nsims = 1) sim <- netsim(est, param, init, control) # Network movie nw <- get_network(sim) nw <- color_tea(nw) slice.par <- list(start = 1, end = 25, interval = 1, aggregate.dur = 1, rule = "any") render.par <- list(tween.frames = 10, show.time = FALSE) plot.par <- list(mar = c(0, 0, 0, 0)) compute.animation(nw, slice.par = slice.par, verbose = TRUE) # Extract attributes race <- get_vertex_attribute(nw, "race") race.shape <- ifelse(race == 1, 4, 50) age <- get_vertex_attribute(nw, "age") age.size <- age/25 # Final movie! render.d3movie( nw, render.par = render.par, plot.par = plot.par, vertex.cex = age.size, vertex.sides = race.shape, vertex.col = "ndtvcol", edge.col = "darkgrey", vertex.border = "lightgrey", displaylabels = FALSE, filename = paste0(getwd(), "/movie.html")) # render.d3movie( # nw, # render.par = render.par, # plot.par = plot.par, # vertex.cex = age.size, # vertex.sides = race.shape, # vertex.col = "ndtvcol", # edge.col = "darkgrey", # vertex.border = "lightgrey", # displaylabels = FALSE, # output.mode = "htmlWidget")