## ----echo = FALSE, include = FALSE-------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup, echo = FALSE, include = FALSE------------------------------------- library(EpiModel) ## ----eval = FALSE------------------------------------------------------------- # # Get the network for layer 1 # nw <- get_network(dat, network = 1) # # # After modifying a network, set it back # dat <- set_network(dat, network = 1, nw = nw) ## ----eval = FALSE------------------------------------------------------------- # sim <- netsim(est, param, init, control) # # # Extract the network from simulation 1, network layer 1 # nw <- get_network(sim, sim = 1, network = 1) # # # Collapse to a static cross-section at time step 50 (full mode only) # nw_at_50 <- get_network(sim, sim = 1, collapse = TRUE, at = 50) ## ----eval = FALSE------------------------------------------------------------- # transmat <- get_transmat(sim, sim = 1) ## ----eval = FALSE------------------------------------------------------------- # el <- get_edgelist(dat, network = 1) ## ----eval = FALSE------------------------------------------------------------- # # All networks # el_all <- get_edgelists_df(dat, networks = NULL) # # # Specific networks # el_12 <- get_edgelists_df(dat, networks = c(1, 2)) ## ----eval = FALSE------------------------------------------------------------- # disc_el <- get_discordant_edgelist( # dat, # status.attr = "status", # head.status = "i", # tail.status = "s" # ) ## ----eval = FALSE------------------------------------------------------------- # nw <- network_initialize(n = 1000) # nw <- set_vertex_attribute(nw, "race", rep(0:1, each = 500)) # # est_main <- netest(nw, formation = ~edges + nodematch("race"), # target.stats = c(300, 240), # coef.diss = dissolution_coefs(~offset(edges), duration = 100)) # est_casl <- netest(nw, formation = ~edges + nodematch("race"), # target.stats = c(200, 150), # coef.diss = dissolution_coefs(~offset(edges), duration = 10)) # # sim <- netsim(list(est_main, est_casl), param, init, control) ## ----eval = FALSE------------------------------------------------------------- # param <- param.net(inf.prob = multilayer(0.2, 0.1), # act.rate = multilayer(2, 1)) # control <- control.net(type = "SI", nsteps = 100, nsims = 1, # tergmLite = TRUE, resimulate.network = TRUE, # nwstats.formula = multilayer("formation", # ~edges + degree(0:3))) ## ----eval = FALSE------------------------------------------------------------- # inf.prob <- get_param(dat, "inf.prob") # del <- get_discordant_edgelist(dat, status.attr = "status", # head.status = "i", tail.status = "s") # del$transProb <- unlist(inf.prob)[del$network] # one fixed value per layer ## ----eval = FALSE------------------------------------------------------------- # # nw carries a starting value of deg.main (1 if the node has a main partner) # est_casl <- netest(nw, formation = ~edges + nodematch("race") + # nodefactor("deg.main"), # target.stats = c(200, 150, 40), # coef.diss = dissolution_coefs(~offset(edges), duration = 10)) # # update_deg_main <- function(dat, at, network) { # if (network == 1) { # deg <- get_degree(get_edgelist(dat, network = 1)) # dat <- set_attr(dat, "deg.main", pmin(deg, 1)) # } # return(dat) # } # # control <- control.net(type = "SI", nsteps = 100, nsims = 1, # tergmLite = TRUE, resimulate.network = TRUE, # dat.updates = update_deg_main) ## ----eval = FALSE------------------------------------------------------------- # hh <- sample_groups(1000, c("adult" = 0.25, "adult adult" = 0.35, # "adult adult child" = 0.25, # "adult adult child child" = 0.15), # attr.name = "age") # # nw <- network_initialize(n = 1000) # nw <- set_vertex_attribute(nw, "age", hh$age) # nw <- set_vertex_attribute(nw, "hh_id", hh$group) # # est_hh <- netclique(nw, group.attr = "hh_id", arrivals = "join") # est_com <- netest(nw, formation = ~edges + nodematch("age"), # target.stats = c(400, 300), # coef.diss = dissolution_coefs(~offset(edges), duration = 20)) # # param <- param.net(inf.prob = multilayer(0.3, 0.05), act.rate = 1) # sim <- netsim(list(est_hh, est_com), param, init, control) ## ----eval = FALSE------------------------------------------------------------- # est_hh <- netclique(nw, group.attr = "hh_id", arrivals = "join", # arrivals.FUN = function(dat, at, new_ids, network) { # active <- get_attr(dat, "active") # hh <- get_attr(dat, "hh_id") # age <- get_attr(dat, "age") # existing <- active == 1 # existing[new_ids] <- FALSE # pool <- hh[which(existing & age == "child" & !is.na(hh))] # pool[sample.int(length(pool), length(new_ids), replace = TRUE)] # }) ## ----eval = FALSE------------------------------------------------------------- # leave_home <- function(dat, at) { # active <- get_attr(dat, "active") # age <- get_attr(dat, "age") # hh_id <- get_attr(dat, "hh_id") # elig <- which(active == 1 & age >= 18 & age < 30) # movers <- elig[runif(length(elig)) < 0.01] # if (length(movers) > 0) { # new_ids <- max(hh_id, na.rm = TRUE) + seq_along(movers) # dat <- move_to_group(dat, ids = movers, group = new_ids) # } # return(dat) # } ## ----eval = FALSE------------------------------------------------------------- # library(networkDynamicData) # data(concurrencyComparisonNets) # # obs <- netcensus(base) # obs ## ----eval = FALSE------------------------------------------------------------- # param <- param.net(inf.prob = 0.5, act.rate = 1) # init <- init.net(i.num = 10) # control <- control.net(type = "SI", nsteps = 100, nsims = 5, # resimulate.network = FALSE) # sim <- netsim(obs, param, init, control) ## ----eval = FALSE------------------------------------------------------------- # # nw_obs: an observed static network on the same nodes as the estimated layer # sim <- netsim(list(netcensus(nw_obs), est), # param.net(inf.prob = multilayer(0.3, 0.1), act.rate = 1), # init, control) ## ----eval = FALSE------------------------------------------------------------- # control <- control.net( # type = "SI", # nsims = 1, # nsteps = 100, # cumulative.edgelist = TRUE, # Enable in-memory tracking during the run # truncate.el.cuml = 0, # Drop dissolved edges immediately (default) # save.cumulative.edgelist = TRUE, # Attach the result to the returned netsim # verbose = FALSE # ) ## ----eval = FALSE------------------------------------------------------------- # dat <- update_cumulative_edgelist(dat, network = 1, truncate = Inf) ## ----eval = FALSE------------------------------------------------------------- # for (n_network in seq_len(dat$num.nw)) { # dat <- update_cumulative_edgelist(dat, n_network, truncate = 100) # } ## ----eval = FALSE------------------------------------------------------------- # el_cuml <- get_cumulative_edgelist(dat, network = 1) ## ----eval = FALSE------------------------------------------------------------- # el_cumls <- get_cumulative_edgelists_df(dat, networks = NULL) ## ----eval = FALSE------------------------------------------------------------- # el_cuml <- sim$cumulative.edgelist[[1]] ## ----eval = FALSE------------------------------------------------------------- # partner_list <- get_partners( # dat, # index_posit_ids, # networks = NULL, # truncate = Inf, # only.active.nodes = FALSE # ) ## ----eval = FALSE------------------------------------------------------------- # cum_degree <- get_cumulative_degree( # dat, # index_posit_ids = 1:50, # networks = NULL, # truncate = Inf, # only.active.nodes = FALSE # ) ## ----eval = FALSE------------------------------------------------------------- # el_cuml <- get_cumulative_edgelist(dat, network = 1) # # fwd <- get_forward_reachable( # el_cuml, # from_step = 1, # to_step = 52, # nodes = c(10, 25, 42), # NULL for all nodes with edges # dense_optim = "auto" # ) ## ----eval = FALSE------------------------------------------------------------- # bkwd <- get_backward_reachable( # el_cuml, # from_step = 1, # to_step = 52, # nodes = c(10, 25, 42) # ) ## ----eval = FALSE------------------------------------------------------------- # nd <- get_network(sim, sim = 1, network = 1) # full-mode netsim only # el_cuml <- as_cumulative_edgelist(nd) # fwd <- get_forward_reachable(el_cuml, from_step = 1, to_step = 100) ## ----eval = FALSE------------------------------------------------------------- # el_cuml <- dedup_cumulative_edgelist(rbind(el_run1, el_run2))