## This file is part of SimInf, a framework for stochastic ## disease spread simulations. ## ## Copyright (C) 2015 Pavol Bauer ## Copyright (C) 2017 -- 2019 Robin Eriksson ## Copyright (C) 2015 -- 2019 Stefan Engblom ## Copyright (C) 2015 -- 2020 Stefan Widgren ## ## SimInf is free software: you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation, either version 3 of the License, or ## (at your option) any later version. ## ## SimInf is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program. If not, see . library(SimInf) library(tools) source("util/check.R") ## Specify the number of threads to use. set_num_threads(1) ## For debugging sessionInfo() ## Check invalid u0 res <- assertError(SEIR(u0 = "u0")) check_error(res, "Missing columns in u0.") u0 <- data.frame(S = c(0, 1, 2, 3, 4, 5), E = c(0, 0, 0, 0, 0, 0), I = c(0, 0, 0, 0, 0, 0), R = c(0, 0, 0, 0, 0, 0)) ## Check missing columns in u0 res <- assertError(SEIR(u0 = u0[, c("E", "I", "R"), drop = FALSE])) check_error(res, "Missing columns in u0.") res <- assertError(SEIR(u0 = u0[, c("S", "I", "R"), drop = FALSE])) check_error(res, "Missing columns in u0.") res <- assertError(SEIR(u0 = u0[, c("S", "E", "R"), drop = FALSE])) check_error(res, "Missing columns in u0.") res <- assertError(SEIR(u0 = u0[, c("S", "E", "I"), drop = FALSE])) check_error(res, "Missing columns in u0.") ## Check missing beta res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, epsilon = 0.5, gamma = 0.5)) check_error(res, "'beta' must be numeric of length 1 or 'nrow(u0)'.") ## Check missing epsilon res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0.5, gamma = 0.5)) check_error(res, "'epsilon' must be numeric of length 1 or 'nrow(u0)'.") ## Check missing gamma res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0.5, epsilon = 0.5)) check_error(res, "'gamma' must be numeric of length 1 or 'nrow(u0)'.") ## Check non-numeric beta res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = "0.5", epsilon = 0.3, gamma = 0.1)) check_error(res, "'beta' must be numeric of length 1 or 'nrow(u0)'.") ## Check non-numeric epsilon res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0.5, epsilon = "0.3", gamma = 0.1)) check_error(res, "'epsilon' must be numeric of length 1 or 'nrow(u0)'.") ## Check non-numeric gamma res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0.5, epsilon = 0.3, gamma = "0.1")) check_error(res, "'gamma' must be numeric of length 1 or 'nrow(u0)'.") ## Check that length of beta equals 1 res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = c(0.5, 0.5), epsilon = 0.3, gamma = 0.1)) check_error(res, "'beta' must be numeric of length 1 or 'nrow(u0)'.") ## Check that length of epsilon equals 1 res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0.5, epsilon = c(0.3, 0.3), gamma = 0.1)) check_error(res, "'epsilon' must be numeric of length 1 or 'nrow(u0)'.") ## Check that length of gamma equals 1 res <- assertError(SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0.5, epsilon = 0.3, gamma = c(0.1, 0.1))) check_error(res, "'gamma' must be numeric of length 1 or 'nrow(u0)'.") ## Check extraction of data from 'suscpetible', 'infected' and ## 'recovered' compartments model <- SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0, epsilon = 0, gamma = 0) result <- run(model) S_expected <- structure(c(0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L), .Dim = c(6L, 10L)) S_observed <- trajectory(result, compartments = "S", format = "matrix") stopifnot(identical(S_observed, S_expected)) I_expected <- structure(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), .Dim = c(6L, 10L)) I_observed <- trajectory(result, compartments = "I", format = "matrix") stopifnot(identical(I_observed, I_expected)) R_expected <- structure(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), .Dim = c(6L, 10L)) R_observed <- trajectory(result, compartments = "R", format = "matrix") stopifnot(identical(R_observed, R_expected)) R_expected <- data.frame( node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), time = c(0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 9L), R = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)) R_observed <- trajectory(result, compartments = "R") stopifnot(identical(R_observed, R_expected)) ## Extract the number of recovered individuals in the first node after ## each time step in the simulation R_expected <- data.frame( node = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), time = 0:9L, R = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)) R_observed <- trajectory(result, compartments = "R", index = 1) stopifnot(identical(R_observed, R_expected)) R_expected <- structure(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), .Dim = c(1L, 10L)) R_observed <- trajectory(result, compartments = "R", index = 1, format = "matrix") stopifnot(identical(R_observed, R_expected)) ## Extract the number of recovered individuals in the first and third ## node after each time step in the simulation R_expected <- data.frame( node = c(1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L, 1L, 3L), time = c(0L, 0L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 6L, 6L, 7L, 7L, 8L, 8L, 9L, 9L), R = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)) R_observed <- trajectory(result, compartments = "R", index = c(1, 3)) stopifnot(identical(R_observed, R_expected)) R_expected <- structure(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), .Dim = c(2L, 10L)) R_observed <- trajectory(result, compartments = "R", index = c(1, 3), format = "matrix") stopifnot(identical(R_observed, R_expected)) ## A more complex test to extract data from U from a trajectory of 6 ## nodes and 10 time steps (0:9). Generate events that adds one ## individual per node in each compartment each day. To achieve this, ## using the template SEIR model, first add them to the 'S' ## compartment, and then modify the select matrix E and update the ## select index. events <- do.call("rbind", lapply(seq_len(9), function(time) { do.call("rbind", lapply(seq_len(6), function(node) { data.frame(event = 1, time = time, node = node, dest = 0, n = 1, proportion = 0, select = rep(1, 4), shift = 0) })) })) model <- SEIR(u0 = data.frame(S = c(110, 210, 310, 410, 510, 610), E = c(120, 220, 320, 420, 520, 620), I = c(130, 230, 330, 430, 530, 630), R = c(140, 240, 340, 440, 540, 640)), tspan = 0:9, events = events, beta = 0, epsilon = 0, gamma = 0) model@events@E <- as(diag(4), "dgCMatrix") model@events@select <- rep(1:4, length.out = length(model@events@select)) # Check that this fails because rownames (compartments) are missing res <- assertError(run(model)) check_error( res, "'S' and 'E' must have rownames matching the compartments.", FALSE) rownames(model@events@E) <- c("S", "E", "I", "R") result <- run(model) U_expected <- data.frame( node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), time = c(0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 9L), S = c(110L, 210L, 310L, 410L, 510L, 610L, 111L, 211L, 311L, 411L, 511L, 611L, 112L, 212L, 312L, 412L, 512L, 612L, 113L, 213L, 313L, 413L, 513L, 613L, 114L, 214L, 314L, 414L, 514L, 614L, 115L, 215L, 315L, 415L, 515L, 615L, 116L, 216L, 316L, 416L, 516L, 616L, 117L, 217L, 317L, 417L, 517L, 617L, 118L, 218L, 318L, 418L, 518L, 618L, 119L, 219L, 319L, 419L, 519L, 619L), E = c(120L, 220L, 320L, 420L, 520L, 620L, 121L, 221L, 321L, 421L, 521L, 621L, 122L, 222L, 322L, 422L, 522L, 622L, 123L, 223L, 323L, 423L, 523L, 623L, 124L, 224L, 324L, 424L, 524L, 624L, 125L, 225L, 325L, 425L, 525L, 625L, 126L, 226L, 326L, 426L, 526L, 626L, 127L, 227L, 327L, 427L, 527L, 627L, 128L, 228L, 328L, 428L, 528L, 628L, 129L, 229L, 329L, 429L, 529L, 629L), I = c(130L, 230L, 330L, 430L, 530L, 630L, 131L, 231L, 331L, 431L, 531L, 631L, 132L, 232L, 332L, 432L, 532L, 632L, 133L, 233L, 333L, 433L, 533L, 633L, 134L, 234L, 334L, 434L, 534L, 634L, 135L, 235L, 335L, 435L, 535L, 635L, 136L, 236L, 336L, 436L, 536L, 636L, 137L, 237L, 337L, 437L, 537L, 637L, 138L, 238L, 338L, 438L, 538L, 638L, 139L, 239L, 339L, 439L, 539L, 639L), R = c(140L, 240L, 340L, 440L, 540L, 640L, 141L, 241L, 341L, 441L, 541L, 641L, 142L, 242L, 342L, 442L, 542L, 642L, 143L, 243L, 343L, 443L, 543L, 643L, 144L, 244L, 344L, 444L, 544L, 644L, 145L, 245L, 345L, 445L, 545L, 645L, 146L, 246L, 346L, 446L, 546L, 646L, 147L, 247L, 347L, 447L, 547L, 647L, 148L, 248L, 348L, 448L, 548L, 648L, 149L, 249L, 349L, 449L, 549L, 649L)) U_observed <- trajectory(result) stopifnot(identical(U_observed, U_expected)) U_observed <- trajectory(result, compartments = c("S", "E", "I", "R"), index = 1:6) stopifnot(identical(U_observed, U_expected)) U_expected <- data.frame( node = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), time = 0:9, S = 110:119, I = 130:139) U_observed <- trajectory(result, compartments = c("S", "I"), index = 1) stopifnot(identical(U_observed, U_expected)) U_expected <- data.frame( node = c(2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L), time = c(0L, 0L, 1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 6L, 6L, 7L, 7L, 8L, 8L, 9L, 9L), E = c(220L, 420L, 221L, 421L, 222L, 422L, 223L, 423L, 224L, 424L, 225L, 425L, 226L, 426L, 227L, 427L, 228L, 428L, 229L, 429L), R = c(240L, 440L, 241L, 441L, 242L, 442L, 243L, 443L, 244L, 444L, 245L, 445L, 246L, 446L, 247L, 447L, 248L, 448L, 249L, 449L)) U_observed <- trajectory(result, compartments = c("E", "R"), index = c(2, 4)) stopifnot(identical(U_observed, U_expected)) U_expected <- structure( c(220L, 240L, 420L, 440L, 221L, 241L, 421L, 441L, 222L, 242L, 422L, 442L, 223L, 243L, 423L, 443L, 224L, 244L, 424L, 444L, 225L, 245L, 425L, 445L, 226L, 246L, 426L, 446L, 227L, 247L, 427L, 447L, 228L, 248L, 428L, 448L, 229L, 249L, 429L, 449L), .Dim = c(4L, 10L)) U_observed <- trajectory(result, compartments = c("E", "R"), index = c(2, 4), format = "matrix") stopifnot(identical(U_observed, U_expected)) ## Check prevalence ## Define a tolerance tol <- 1e-8 p_expected <- data.frame( time = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9), prevalence = c(0.253333333333333, 0.253324468085106, 0.253315649867374, 0.253306878306878, 0.253298153034301, 0.253289473684211, 0.253280839895013, 0.253272251308901, 0.253263707571802, 0.253255208333333)) p_observed <- prevalence(result, I ~ S + E + I + R) stopifnot(identical(p_observed$time, p_expected$time)) stopifnot(all(abs(p_observed$prevalence - p_expected$prevalence) < tol)) p_observed <- prevalence(result, I ~ .) stopifnot(identical(p_observed$time, p_expected$time)) stopifnot(all(abs(p_observed$prevalence - p_expected$prevalence) < tol)) p_expected <- structure( list(time = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9), prevalence = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), .Names = c("time", "prevalence"), row.names = c(NA, -10L), class = "data.frame") p_observed <- prevalence(result, I ~ S + E + I + R, level = 2) stopifnot(identical(p_observed, p_expected)) p_observed <- prevalence(result, I ~ ., level = 2) stopifnot(identical(p_observed, p_expected)) p_expected <- data.frame( node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), time = c(0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9), prevalence = c(0.26, 0.255555555555556, 0.253846153846154, 0.252941176470588, 0.252380952380952, 0.252, 0.259920634920635, 0.255530973451327, 0.253834355828221, 0.252934272300469, 0.252376425855513, 0.251996805111821, 0.259842519685039, 0.255506607929515, 0.253822629969419, 0.252927400468384, 0.252371916508539, 0.251993620414673, 0.259765625, 0.255482456140351, 0.253810975609756, 0.252920560747664, 0.252367424242424, 0.251990445859873, 0.25968992248062, 0.255458515283843, 0.253799392097264, 0.252913752913753, 0.252362948960302, 0.251987281399046, 0.259615384615385, 0.255434782608696, 0.253787878787879, 0.252906976744186, 0.252358490566038, 0.251984126984127, 0.259541984732824, 0.255411255411255, 0.253776435045317, 0.252900232018561, 0.252354048964218, 0.251980982567353, 0.259469696969697, 0.255387931034483, 0.253765060240964, 0.252893518518519, 0.25234962406015, 0.251977848101266, 0.259398496240602, 0.255364806866953, 0.253753753753754, 0.252886836027714, 0.25234521575985, 0.251974723538705, 0.259328358208955, 0.25534188034188, 0.25374251497006, 0.252880184331797, 0.252340823970037, 0.251971608832808)) p_observed <- prevalence(result, I ~ ., level = 3) stopifnot(identical(p_observed$node, p_expected$node)) stopifnot(identical(p_observed$time, p_expected$time)) stopifnot(all(abs(p_observed$prevalence - p_expected$prevalence) < tol)) p_observed <- prevalence(result, I ~ S + E + I + R, level = 3) stopifnot(identical(p_observed$node, p_expected$node)) stopifnot(identical(p_observed$time, p_expected$time)) stopifnot(all(abs(p_observed$prevalence - p_expected$prevalence) < tol)) p_expected <- data.frame( node = c(2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L, 2L, 3L), time = c(0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9), prevalence = c(0.255555555555556, 0.253846153846154, 0.255530973451327, 0.253834355828221, 0.255506607929515, 0.253822629969419, 0.255482456140351, 0.253810975609756, 0.255458515283843, 0.253799392097264, 0.255434782608696, 0.253787878787879, 0.255411255411255, 0.253776435045317, 0.255387931034483, 0.253765060240964, 0.255364806866953, 0.253753753753754, 0.25534188034188, 0.25374251497006)) p_observed <- prevalence(result, I ~ ., level = 3, i = 2:3) stopifnot(identical(p_observed$node, p_expected$node)) stopifnot(identical(p_observed$time, p_expected$time)) stopifnot(all(abs(p_observed$prevalence - p_expected$prevalence) < tol)) p_observed <- prevalence(result, I ~ S + E + I + R, level = 3, i = 2:3) stopifnot(identical(p_observed$node, p_expected$node)) stopifnot(identical(p_observed$time, p_expected$time)) stopifnot(all(abs(p_observed$prevalence - p_expected$prevalence) < tol)) ## Check 'V' res <- assertError(trajectory(result, "phi")) check_error(res, "Non-existing compartment(s) in model: 'phi'.") ## Check data stopifnot(identical(nrow(events_SEIR()), 466692L)) stopifnot(identical(nrow(u0_SEIR()), 1600L)) ## Try to plot non-extisting compartment. res <- assertError(plot(result, "X")) check_error(res, "Non-existing compartment(s) in model: 'X'.") ## Try to plot with invalid range argument. res <- assertError(plot(result, range = 1.2)) check_error(res, "'range' must be FALSE or a value between 0 and 1.") ## Check SEIR plot method pdf_file <- tempfile(fileext = ".pdf") pdf(pdf_file) plot(result) dev.off() stopifnot(file.exists(pdf_file)) unlink(pdf_file) ## Check SEIR plot method with range = FALSE pdf_file <- tempfile(fileext = ".pdf") pdf(pdf_file) plot(result, "S", lty = 1, range = FALSE) dev.off() stopifnot(file.exists(pdf_file)) unlink(pdf_file) ## Check SEIR boxplot method pdf_file <- tempfile(fileext = ".pdf") pdf(pdf_file) boxplot(result) dev.off() stopifnot(file.exists(pdf_file)) unlink(pdf_file) ## Check SEIR pairs plot method pdf_file <- tempfile(fileext = ".pdf") pdf(pdf_file) pairs(result) dev.off() stopifnot(file.exists(pdf_file)) unlink(pdf_file) ## Check SEIR events plot with no events model <- SEIR(u0 = u0, tspan = seq_len(10) - 1, events = NULL, beta = 0, epsilon = 0, gamma = 0) pdf_file <- tempfile(fileext = ".pdf") pdf(pdf_file) plot(model@events) dev.off() stopifnot(file.exists(pdf_file)) unlink(pdf_file) ## Check SEIR events plot method model <- SEIR(u0 = u0_SEIR(), tspan = seq_len(365 * 4), events = events_SEIR(), beta = 0, epsilon = 0, gamma = 0) pdf_file <- tempfile(fileext = ".pdf") pdf(pdf_file) plot(model@events) dev.off() stopifnot(file.exists(pdf_file)) unlink(pdf_file) ## Check that C SEIR run function fails for a misspecified SEIR model res <- assertError(.Call(SimInf:::SEIR_run, NULL, NULL)) check_error(res, "Invalid model.") res <- assertError(.Call(SimInf:::SEIR_run, "SEIR", NULL)) check_error(res, "Invalid model.") ## Check that an invalid rate error is raised during the simulation. model <- SEIR(u0 = data.frame(S = rep(100, 2), E = 0, I = 10, R = 0), tspan = 1:100, beta = 0.16, epsilon = -0.3, gamma = 0.077) set.seed(1) res <- assertError(run(model, solver = "ssm")) check_error(res, "Invalid rate detected (non-finite or < 0.0).") res <- assertError(run(model, solver = "aem")) check_error(res, "Invalid rate detected (non-finite or < 0.0).")