Running ‘testthat.R’ [26s/31s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(tergmLite)
  Loading required package: ergm
  Loading required package: network
  
  'network' 1.17.1 (2021-06-12), part of the Statnet Project
  * 'news(package="network")' for changes since last version
  * 'citation("network")' for citation information
  * 'https://statnet.org' for help, support, and other information
  
  
  'ergm' 4.1.2 (2021-07-26), part of the Statnet Project
  * 'news(package="ergm")' for changes since last version
  * 'citation("ergm")' for citation information
  * 'https://statnet.org' for help, support, and other information
  
  'ergm' 4 is a major update that introduces some backwards-incompatible
  changes. Please type 'news(package="ergm")' for a list of major
  changes.
  
  Loading required package: tergm
  Loading required package: networkDynamic
  
  'networkDynamic' 0.11.0 (2021-06-12), part of the Statnet Project
  * 'news(package="networkDynamic")' for changes since last version
  * 'citation("networkDynamic")' for citation information
  * 'https://statnet.org' for help, support, and other information
  
  
  'tergm' 4.0.1 (2021-06-24), part of the Statnet Project
  * 'news(package="tergm")' for changes since last version
  * 'citation("tergm")' for citation information
  * 'https://statnet.org' for help, support, and other information
  
  
  Attaching package: 'tergm'
  
  The following object is masked from 'package:ergm':
  
      snctrl
  
  > 
  > test_check("tergmLite")
  
   *** caught segfault ***
  address 0x400000042, cause 'memory not mapped'
  
  Traceback:
   1: tergm_MCMC_slave(state, eta.comb, control, verbose)
   2: tergm_MCMC_sample(nw, model, model.mon, proposal, eta, control = control,     verbose = verbose)
   3: FUN(X[[i]], ...)
   4: lapply(X = X, FUN = FUN, ...)
   5: sapply(integer(n), eval.parent(substitute(function(...) expr)),     simplify = simplify)
   6: replicate(nsim, {    nw <- .set.default.net.obs.period(nw, time.start)    nw %n% "time" <- start <- .get.last.obs.time(nw, time.start)    z <- tergm_MCMC_sample(nw, model, model.mon, proposal, eta,         control = control, verbose = verbose)    stats.gen <- if (control$collect)         mcmc(sweep(z$statsmatrix.gen, 2, summary(formula, basis = nw,             dynamic = TRUE), "+"), start = time.burnin + 1, thin = time.interval)    stats.mon <- if (!is.null(model.mon))         mcmc(sweep(z$statsmatrix.mon, 2, summary(monitor, basis = nw,             dynamic = TRUE), "+"), start = time.burnin + 1, thin = time.interval)    out <- switch(output, networkDynamic = {        changes <- z$changed        changes[, 1] <- changes[, 1] - 1 + time.offset        nwd <- to.networkDynamic.lasttoggle(nw)        nwd <- networkDynamic.apply.changes(nwd, changes)        attributes(nwd) <- c(attributes(nwd), list(stats.gen = stats.gen,             stats = stats.mon, coef = coef, changes = changes))        nwd <- .add.net.obs.period.spell(nwd, start - 1 + time.offset,             time.slices)        nwd    }, changes = {        changes <- z$changed        changes[, 1] <- changes[, 1] - 1 + time.offset        attributes(changes) <- c(attributes(changes), list(stats.gen = stats.gen,             stats = stats.mon, coef = coef, start = nw %n% "time" +                 0, end = nw %n% "time" + time.slices))        changes    }, stats = {        list(stats.gen = stats.gen, stats = stats.mon)    }, final = {        changes <- z$changed        changes[, 1] <- changes[, 1] - 1 + time.offset        newnw <- as.network(z$newnetwork)        newnw <- .add.net.obs.period.spell(newnw, start - 1 +             time.offset, time.slices)        attributes(newnw) <- c(attributes(newnw), list(stats.gen = stats.gen,             stats = stats.mon, coef = coef, start = nw %n% "time" +                 0, end = nw %n% "time" + time.slices, changes = changes))        newnw    }, ergm_state = {        changes <- z$changed        changes[, 1] <- changes[, 1] - 1 + time.offset        newnw <- z$newnetwork        attributes(newnw) <- c(attributes(newnw), list(stats.gen = stats.gen,             stats = stats.mon, coef = coef, start = nw %n% "time" +                 0, end = nw %n% "time" + time.slices, changes = changes))        newnw    })}, simplify = FALSE)
   7: simulate_formula.network(object, nsim = nsim, seed = seed, ...,     basis = attr(object, ".Basis"))
   8: simulate_formula(object, nsim = nsim, seed = seed, ..., basis = attr(object,     ".Basis"))
   9: simulate.formula_lhs_network(object = ~Form(formation) + Persist(dissolution),     coef = nw_coef, constraints = constraints, control = control,     output = "final", dynamic = TRUE)
  10: stats::simulate(object = ~Form(formation) + Persist(dissolution),     coef = nw_coef, constraints = constraints, control = control,     output = "final", dynamic = TRUE)
  11: eval(cl, parent.frame())
  12: eval(cl, parent.frame())
  13: simulate.formula(ff, basis = nws, coef = nw_coef, constraints = constraints,     control = control, output = "final", dynamic = TRUE)
  14: simulate(ff, basis = nws, coef = nw_coef, constraints = constraints,     control = control, output = "final", dynamic = TRUE)
  15: eval(code, test_env)
  16: eval(code, test_env)
  17: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
  18: doTryCatch(return(expr), name, parentenv, handler)
  19: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  20: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  21: doTryCatch(return(expr), name, parentenv, handler)
  22: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  23: tryCatchList(expr, classes, parentenv, handlers)
  24: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  25: test_code(desc, code, env = parent.frame(), reporter = reporter)
  26: test_that("manual and tergmLite dynamic simulations produce identical results for a tergm",     {        require("tergm")        require("EpiModel")        if (packageVersion("EpiModel") >= "2.1.0") {            age_vals <- 1:20            race_vals <- c("A", "B", "C", "D", "E")            sex_vals <- c("M", "F")            set.seed(0)            nw <- network.initialize(1000, dir = FALSE)            nw %v% "age" <- sample(age_vals, 1000, TRUE)            nw %v% "race" <- sample(race_vals, 1000, TRUE)            nw %v% "sex" <- sample(sex_vals, 1000, TRUE)            formation <- ~edges + nodecov(~age) + nodefactor(~race)            dissolution <- ~offset(edges)            target_stats <- c(835.168, 18817.544, 378.888, 296.758,                 320.37, 409.382)            diss_coefs <- dissolution_coefs(dissolution, duration = 1 +                 exp(3))            ff <- ~Form(formation) + Persist(dissolution)            pmat <- matrix(3 + runif(25), 5, 5)            pmat <- pmat + t(pmat)            constraints <- ~bd(maxout = 3) + blocks(~sex, levels2 = diag(TRUE,                 2))            ff_m <- ~edges + mean.age + degree(0:3) + degrange(4) +                 nodematch("sex")            ff_gm <- ~Form(formation) + Persist(dissolution) +                 edges + mean.age + degree(0:3) + degrange(4) +                 nodematch("sex")            control <- control.simulate.formula.tergm(MCMC.burnin.min = 54321,                 MCMC.burnin.max = 123456, MCMC.prop = ~strat(~race,                   pmat = pmat) + discord + sparse)            update_nw <- function(nw, nodes_to_remove, nodes_to_add,                 age_vals, race_vals) {                el <- as.edgelist(nw)                lt <- nw %n% "lasttoggle"                time <- nw %n% "time"                age <- nw %v% "age"                race <- nw %v% "race"                sex <- nw %v% "sex"                new_indices <- seq_len(network.size(nw))                new_indices[nodes_to_remove] <- 0                new_indices <- new_indices - cumsum(new_indices ==                   0)                nw <- network.initialize(network.size(nw) + nodes_to_add -                   length(nodes_to_remove), directed = FALSE)                nw %v% "age" <- c(age[-nodes_to_remove], sample(age_vals,                   nodes_to_add, TRUE))                nw %v% "race" <- c(race[-nodes_to_remove], sample(race_vals,                   nodes_to_add, TRUE))                nw %v% "sex" <- c(sex[-nodes_to_remove], sample(sex_vals,                   nodes_to_add, TRUE))                nw %n% "time" <- time                el <- el[!(el[, 1] %in% nodes_to_remove) & !(el[,                   2] %in% nodes_to_remove), , drop = FALSE]                lt <- lt[!(lt[, 1] %in% nodes_to_remove) & !(lt[,                   2] %in% nodes_to_remove), , drop = FALSE]                el <- matrix(new_indices[c(el)], ncol = 2)                lt <- matrix(c(new_indices[c(lt[, 1:2])], lt[,                   3]), ncol = 3)                nw[el] <- 1L                nw %n% "lasttoggle" <- lt                nw            }            set.seed(0)            nws <- nw            nw_ergm <- ergm(nw ~ edges + nodecov(~age) + nodefactor(~race),                 target.stats = target_stats, constraints = constraints,                 eval.loglik = FALSE, control = list(init.method = "MPLE"))            nw_coef <- c(coef(nw_ergm)[1] - diss_coefs$coef.form.corr,                 coef(nw_ergm)[-1], diss_coefs$coef.adj)            nw_el <- list()            nw_lt <- list()            nw_time <- list()            nw_summstats <- NULL            nws <- simulate(ff, basis = nws, coef = nw_coef,                 constraints = constraints, control = control,                 output = "final", dynamic = TRUE)            nw_summstats <- rbind(nw_summstats, c(summary(ff,                 basis = nws), summary(ff_m, basis = nws)))            nw_el[[length(nw_el) + 1]] <- as.edgelist(nws)            nw_lt[[length(nw_lt) + 1]] <- nws %n% "lasttoggle"            nw_time[[length(nw_time) + 1]] <- nws %n% "time"            for (j in seq_len(10)) {                nws %v% "age" <- nws %v% "age" + 1                nodes_to_remove <- sample(seq_len(network.size(nws)),                   rpois(1, 25), FALSE)                nodes_to_add <- rpois(1, 30)                nw_coef[1] <- nw_coef[1] + log(network.size(nws)) -                   log(network.size(nws) + nodes_to_add - length(nodes_to_remove))                nws <- update_nw(nws, nodes_to_remove, nodes_to_add,                   age_vals, race_vals)                nws <- simulate(ff, basis = nws, coef = nw_coef,                   constraints = constraints, control = control,                   output = "final", dynamic = TRUE)                nw_summstats <- rbind(nw_summstats, c(summary(ff,                   basis = nws), summary(ff_m, basis = nws)))                nw_el[[length(nw_el) + 1]] <- as.edgelist(nws)                nw_lt[[length(nw_lt) + 1]] <- nws %n% "lasttoggle"                nw_time[[length(nw_time) + 1]] <- nws %n% "time"            }            update_dat <- function(dat, nodes_to_remove, nodes_to_add,                 age_vals, race_vals) {                dat$nwparam[[1]]$coef.form[1] <- dat$nwparam[[1]]$coef.form[1] +                   log(length(dat$attr$age)) - log(length(dat$attr$age) +                   nodes_to_add - length(nodes_to_remove))                dat$attr$age <- c(dat$attr$age[-nodes_to_remove],                   sample(age_vals, nodes_to_add, TRUE))                dat$attr$race <- c(dat$attr$race[-nodes_to_remove],                   sample(race_vals, nodes_to_add, TRUE))                dat$attr$sex <- c(dat$attr$sex[-nodes_to_remove],                   sample(sex_vals, nodes_to_add, TRUE))                dat$el[[1]] <- delete_vertices(dat$el[[1]], nodes_to_remove)                dat$p[[1]]$state$nw0 %n% "lasttoggle" <- delete_vertices(dat$p[[1]]$state$nw0 %n%                   "lasttoggle", nodes_to_remove)                dat$el[[1]] <- add_vertices(dat$el[[1]], nodes_to_add)                dat            }            dat_el <- list()            dat_lt <- list()            dat_time <- list()            dat_summstats <- NULL            set.seed(0)            nwL <- as.networkLite(nw)            nwL_ergm <- ergm(nwL ~ edges + nodecov(~age) + nodefactor(~race),                 target.stats = target_stats, constraints = constraints,                 eval.loglik = FALSE, control = list(init.method = "MPLE"))            nwL_coef <- c(coef(nwL_ergm)[1] - diss_coefs$coef.form.corr,                 coef(nwL_ergm)[-1])            dat <- list(nw = list(nw), attr = list(age = nw %v%                 "age", race = nw %v% "race", sex = nw %v% "sex"),                 nwparam = list(list(formation = formation, coef.form = nwL_coef,                   coef.diss = diss_coefs, constraints = constraints)),                 control = list(tergmLite.track.duration = TRUE,                   mcmc.control.tergm = control, nwstats.formula = ~.))            dat <- init_tergmLite(dat)            dat <- updateModelTermInputs(dat)            nwparam <- dat$nwparam[[1]]            rv <- tergmLite::simulate_network(state = dat$p[[1]]$state,                 coef = c(nwparam$coef.form, nwparam$coef.diss$coef.adj),                 control = dat$control$mcmc.control[[1]], save.changes = TRUE)            dat$el[[1]] <- rv$el            dat$p[[1]]$state$nw0 %n% "time" <- rv$state$nw0 %n%                 "time"            dat$p[[1]]$state$nw0 %n% "lasttoggle" <- rv$state$nw0 %n%                 "lasttoggle"            dat_el[[length(dat_el) + 1]] <- rv$el            dat_lt[[length(dat_lt) + 1]] <- rv$state$nw0 %n%                 "lasttoggle"            dat_time[[length(dat_time) + 1]] <- rv$state$nw0 %n%                 "time"            nwL <- networkLite(dat$el[[1]], dat$attr)            nwL %n% "time" <- dat$p[[1]]$state$nw0 %n% "time"            nwL %n% "lasttoggle" <- dat$p[[1]]$state$nw0 %n%                 "lasttoggle"            dat_summstats <- rbind(dat_summstats, c(summary(ff,                 basis = nwL), summary(ff_m, basis = nwL)))            for (j in seq_len(10)) {                dat$attr$age <- dat$attr$age + 1                nodes_to_remove <- sample(seq_len(attr(rv$el,                   "n")), rpois(1, 25), FALSE)                nodes_to_add <- rpois(1, 30)                dat <- update_dat(dat, nodes_to_remove, nodes_to_add,                   age_vals, race_vals)                dat <- updateModelTermInputs(dat)                nwparam <- dat$nwparam[[1]]                rv <- tergmLite::simulate_network(state = dat$p[[1]]$state,                   coef = c(nwparam$coef.form, nwparam$coef.diss$coef.adj),                   control = dat$control$mcmc.control[[1]], save.changes = TRUE)                dat$el[[1]] <- rv$el                dat$p[[1]]$state$nw0 %n% "time" <- rv$state$nw0 %n%                   "time"                dat$p[[1]]$state$nw0 %n% "lasttoggle" <- rv$state$nw0 %n%                   "lasttoggle"                dat_el[[length(dat_el) + 1]] <- rv$el                dat_lt[[length(dat_lt) + 1]] <- rv$state$nw0 %n%                   "lasttoggle"                dat_time[[length(dat_time) + 1]] <- rv$state$nw0 %n%                   "time"                nwL <- networkLite(dat$el[[1]], dat$attr)                nwL %n% "time" <- dat$p[[1]]$state$nw0 %n% "time"                nwL %n% "lasttoggle" <- dat$p[[1]]$state$nw0 %n%                   "lasttoggle"                dat_summstats <- rbind(dat_summstats, c(summary(ff,                   basis = nwL), summary(ff_m, basis = nwL)))            }            expect_equal(lapply(nw_el, unclass), lapply(dat_el,                 unclass), check.attributes = FALSE)            expect_equal(nw_lt, dat_lt, check.attributes = FALSE)            expect_equal(nw_time, dat_time, check.attributes = FALSE)            set.seed(0)            nwL <- as.networkLite(nw)            netest_ergm <- netest(nwL, formation, target.stats = target_stats,                 coef.diss = diss_coefs, constraints = constraints,                 set.control.ergm = list(init.method = "MPLE"))            init_dat <- function(x, param, init, control, s) {                nwL <- x$fit$network                nwL[, ] <- FALSE                control$isTERGM <- TRUE                dat <- list(nw = list(nwL), attr = list(age = nwL %v%                   "age", race = nwL %v% "race", sex = nwL %v%                   "sex", active = rep(TRUE, network.size(nwL))),                   nwparam = list(list(formation = x$formation,                     coef.form = x$coef.form, coef.diss = x$coef.diss,                     constraints = x$constraints)), param = list(groups = 1),                   epi = list(num = network.size(nwL)), control = control,                   edgelist = list(), lasttoggle = list(), time = list())                dat <- init_tergmLite(dat)                dat            }            update_dat <- function(dat, at) {                dat$time[[length(dat$time) + 1]] <- dat$p[[1]]$state$nw0 %n%                   "time"                dat$lasttoggle[[length(dat$lasttoggle) + 1]] <- dat$p[[1]]$state$nw0 %n%                   "lasttoggle"                dat$edgelist[[length(dat$edgelist) + 1]] <- dat$el[[1]]                dat$epi$num <- c(dat$epi$num, length(dat$attr$age))                dat$attr$age <- dat$attr$age + 1                nodes_to_remove <- sample(seq_len(attr(dat$el[[1]],                   "n")), rpois(1, 25), FALSE)                nodes_to_add <- rpois(1, 30)                dat$attr$age <- c(dat$attr$age[-nodes_to_remove],                   sample(age_vals, nodes_to_add, TRUE))                dat$attr$race <- c(dat$attr$race[-nodes_to_remove],                   sample(race_vals, nodes_to_add, TRUE))                dat$attr$sex <- c(dat$attr$sex[-nodes_to_remove],                   sample(sex_vals, nodes_to_add, TRUE))                dat$attr$active <- c(dat$attr$active[-nodes_to_remove],                   rep(TRUE, nodes_to_add))                dat$el[[1]] <- delete_vertices(dat$el[[1]], nodes_to_remove)                dat$p[[1]]$state$nw0 %n% "lasttoggle" <- delete_vertices(dat$p[[1]]$state$nw0 %n%                   "lasttoggle", nodes_to_remove)                dat$el[[1]] <- add_vertices(dat$el[[1]], nodes_to_add)                dat            }            netsim_control <- control.net(nsteps = 12, initialize.FUN = init_dat,                 nwupdate.FUN = update_dat, prevalence.FUN = NULL,                 verbose.FUN = NULL, resimulate.network = TRUE,                 tergmLite = TRUE, skip.check = TRUE, tergmLite.track.duration = TRUE,                 save.nwstats = TRUE, save.other = c("edgelist",                   "lasttoggle", "time"), nwstats.formula = ff_gm,                 mcmc.control.tergm = control)            sim <- netsim(netest_ergm, NULL, NULL, netsim_control)            expect_equal(lapply(nw_el, unclass), lapply(sim$edgelist[[1]],                 unclass), check.attributes = FALSE)            expect_equal(nw_lt, sim$lasttoggle[[1]], check.attributes = FALSE)            expect_equal(nw_time, sim$time[[1]])            expect_identical(nw_summstats, dat_summstats)            expect_identical(nw_summstats, sim$stats$nwstats[[1]][[1]])        }    })
  27: eval(code, test_env)
  28: eval(code, test_env)
  29: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
  30: doTryCatch(return(expr), name, parentenv, handler)
  31: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  32: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  33: doTryCatch(return(expr), name, parentenv, handler)
  34: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  35: tryCatchList(expr, classes, parentenv, handlers)
  36: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  37: test_code(NULL, exprs, env)
  38: source_file(path, child_env(env), wrap = wrap)
  39: FUN(X[[i]], ...)
  40: lapply(test_paths, test_one_file, env = env, wrap = wrap)
  41: force(code)
  42: doWithOneRestart(return(expr), restart)
  43: withOneRestart(expr, restarts[[1L]])
  44: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  45: with_reporter(reporters$multi, lapply(test_paths, test_one_file,     env = env, wrap = wrap))
  46: test_files(test_dir = test_dir, test_package = test_package,     test_paths = test_paths, load_helpers = load_helpers, reporter = reporter,     env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap, load_package = load_package)
  47: test_files(test_dir = path, test_paths = test_paths, test_package = package,     reporter = reporter, load_helpers = load_helpers, env = env,     stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap, load_package = load_package, parallel = parallel)
  48: test_dir("testthat", package = package, reporter = reporter,     ..., load_package = "installed")
  49: test_check("tergmLite")
  An irrecoverable exception occurred. R is aborting now ...