R version 4.4.0 RC (2024-04-16 r86468 ucrt) -- "Puppy Cup" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > ## 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() R version 4.4.0 RC (2024-04-16 r86468 ucrt) Platform: x86_64-w64-mingw32/x64 Running under: Windows Server 2022 x64 (build 20348) Matrix products: default locale: [1] LC_COLLATE=C LC_CTYPE=German_Germany.utf8 [3] LC_MONETARY=C LC_NUMERIC=C [5] LC_TIME=C time zone: Europe/Berlin tzcode source: internal attached base packages: [1] tools stats graphics grDevices utils datasets methods [8] base other attached packages: [1] SimInf_9.7.0 loaded via a namespace (and not attached): [1] MASS_7.3-60.2 compiler_4.4.0 Matrix_1.7-0 grid_4.4.0 digest_0.6.35 [6] lattice_0.22-6 > > ## Check invalid u0 > res <- assertError(SISe(u0 = "u0")) > check_error(res, "Missing columns in u0.") > > u0 <- data.frame(S = c(0, 1, 2, 3, 4, 5), + I = c(0, 0, 0, 0, 0, 0)) > > ## Check missing columns in u0 > res <- assertError(SISe(u0 = u0[, "I", drop = FALSE])) > check_error(res, "Missing columns in u0.") > > res <- assertError(SISe(u0 = u0[, "S", drop = FALSE])) > check_error(res, "Missing columns in u0.") > > ## Check phi > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep("a", nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error( + res, + "Invalid 'phi': must be numeric vector with length 'nrow(u0)'.") > > phi <- matrix(1) > res <- assertError(SimInf:::check_infectious_pressure_arg(1, phi)) > check_error( + res, + "Invalid 'phi': must be numeric vector with length 'nrow(u0)'.") > > phi <- c(2, 2) > res <- assertError(SimInf:::check_infectious_pressure_arg(1, phi)) > check_error( + res, + "Invalid 'phi': must be numeric vector with length 'nrow(u0)'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(-1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error( + res, + "Invalid 'phi': must be numeric vector with non-negative values.") > > res <- SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011) > > stopifnot(identical( + res@v0, + matrix(0, nrow = 1, ncol = 6, dimnames = list("phi", NULL)))) > > ## Check missing upsilon > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'upsilon' must be numeric of length 1.") > > ## Check missing gamma > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'gamma' must be numeric of length 1.") > > ## Check missing alpha > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'alpha' must be numeric of length 1.") > > ## Check missing beta_t1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t1' must be numeric of length 1.") > > ## Check missing beta_t2 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t2' must be numeric of length 1.") > > ## Check missing beta_t3 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t3' must be numeric of length 1.") > > ## Check missing beta_t4 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t4' must be numeric of length 1.") > > ## Check missing end_t1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t1' is missing.") > > ## Check missing end_t2 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t2' is missing.") > > ## Check missing end_t3 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t3' is missing.") > > ## Check missing end_t4 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + epsilon = 0.000011)) > check_error(res, "'end_t4' is missing.") > > ## Check missing epsilon > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365)) > check_error(res, "'epsilon' must be numeric of length 1.") > > ## Check non-numeric upsilon > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = "0.0357", + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'upsilon' must be numeric of length 1.") > > ## Check non-numeric gamma > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = "0.1", + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'gamma' must be numeric of length 1.") > > ## Check non-numeric alpha > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = "1.0", + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'alpha' must be numeric of length 1.") > > ## Check non-numeric beta_t1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = "0.19", + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t1' must be numeric of length 1.") > > ## Check non-numeric beta_t2 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = "0.085", + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t2' must be numeric of length 1.") > > ## Check non-numeric beta_t3 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = "0.075", + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t3' must be numeric of length 1.") > > ## Check non-numeric beta_t4 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = "0.185", + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t4' must be numeric of length 1.") > > ## Check non-integer end_t1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = "91", + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t1' must be integer.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91.5, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t1' must be integer.") > > ## Check non-integer end_t2 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = "182", + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t2' must be integer.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182.5, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t2' must be integer.") > > ## Check non-integer end_t3 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = "273", + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t3' must be integer.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273.5, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t3' must be integer.") > > ## Check non-integer end_t4 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = "365", + epsilon = 0.000011)) > check_error(res, "'end_t4' must be integer.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365.5, + epsilon = 0.000011)) > check_error(res, "'end_t4' must be integer.") > > ## Check non-numeric epsilon > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = "0.000011")) > check_error(res, "'epsilon' must be numeric of length 1.") > > ## Check that length of upsilon equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = c(0.0357, 0.0357), + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'upsilon' must be numeric of length 1.") > > ## Check that length of gamma equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = c(0.1, 0.1), + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'gamma' must be numeric of length 1.") > > ## Check that length of alpha equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = c(1.0, 1.0), + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'alpha' must be numeric of length 1.") > > ## Check that length of beta_t1 equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = c(0.19, 0.19), + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t1' must be numeric of length 1.") > > ## Check that length of beta_t2 equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = c(0.085, 0.085), + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t2' must be numeric of length 1.") > > ## Check that length of beta_t3 equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = c(0.075, 0.075), + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t3' must be numeric of length 1.") > > ## Check that length of beta_t4 equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = c(0.185, 0.185), + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'beta_t4' must be numeric of length 1.") > > ## Check that length of epsilon equals 1 > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = c(0.000011, 0.000011))) > check_error(res, "'epsilon' must be numeric of length 1.") > > ## Check interval endpoints > end_t1 <- 1:3 > res <- assertError(SimInf:::check_end_t_arg(2, end_t1)) > check_error(res, "'end_t1' must be of length 1 or 'nrow(u0)'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = -1, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t1' must be greater than or equal to '0'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 18, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t1' must be less than 'end_t2'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 173, + end_t4 = 365, + epsilon = 0.000011)) > check_error( + res, + "'end_t2' must be less than 'end_t3' or 'end_t3' less than 'end_t1'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 365, + end_t4 = 365, + epsilon = 0.000011)) > check_error(res, "'end_t3' must be less than '364'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = -1, + epsilon = 0.000011)) > check_error(res, "'end_t4' must be greater than or equal to '0'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 366, + epsilon = 0.000011)) > check_error(res, "'end_t4' must be less than or equal to '365'.") > > res <- assertError(SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 4:9, + end_t2 = 5:10, + end_t3 = c(8:12, 16), + end_t4 = c(2, 11:15), + epsilon = 0.000011)) > check_error( + res, + "'end_t4' must be less than 'end_t1' or greater than 'end_t3'.") > > ## Check extraction of data from 'suscpetible', and 'infected' > ## compartments > model <- SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = seq(0, by = 0.1, length.out = nrow(u0)), + upsilon = 0, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0, + beta_t2 = 0, + beta_t3 = 0, + beta_t4 = 0, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 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)) > > ## Check output from trajectory method > model@tspan <- c(1, 2) > result <- run(model) > res <- assertError(trajectory(result, c("S", "phi"), format = "matrix")) > check_error(res, + "Cannot combine data from different slots.") > > stopifnot(identical(class(trajectory(result, c("S", "phi"))$phi), "numeric")) > stopifnot(identical(class(trajectory(result, c("phi"))$phi), "numeric")) > > traj_expected <- data.frame( + node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), + time = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), + S = c(0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L)) > stopifnot(identical(trajectory(result, c("S", "S")), traj_expected)) > > traj_expected <- data.frame( + node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), + time = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), + S = c(0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L), + phi = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5)) > stopifnot(identical( + trajectory(result, c("S", "S", "phi", "phi"))[, -4], + traj_expected[, -4])) > stopifnot(identical( + trajectory(result, c("phi", "phi", "S", "S"))[, -4], + traj_expected[, -4])) > > d <- trajectory(result, c("phi", "phi", "S", "S"))[, 4] - traj_expected$phi > stopifnot(all(abs(d) < 1e-8)) > > ## Check extracting a subset of nodes > traj_expected <- data.frame( + node = c(2L, 5L, 2L, 5L), + time = c(1L, 1L, 2L, 2L), + S = c(1L, 4L, 1L, 4L), + phi = c(0.1, 0.4, 0.1, 0.4)) > stopifnot(identical( + trajectory(result, c("S", "S", "phi", "phi"), index = c(5, 2))[, -4], + traj_expected[, -4])) > stopifnot(identical( + trajectory(result, c("phi", "phi", "S", "S"), index = c(5, 2))[, -4], + traj_expected[, -4])) > stopifnot(identical( + trajectory(result, c("S", "phi"), index = c(5, 2)), + traj_expected)) > > d <- trajectory(result, c("phi", "phi", "S", "S"), index = c(5, 2))[, 4] - + traj_expected$phi > stopifnot(all(abs(d) < 1e-8)) > > ## Check extracting all compartments in U > stopifnot(identical(trajectory(result, c("S", "I"), format = "matrix"), + result@U)) > > ## Check extracting all compartments of U in internal format > stopifnot(identical(trajectory(result, c("S", "I"), format = "matrix"), + result@U)) > > ## Check extracting a subset compartments of V in internal format > traj_observed <- trajectory(result, "phi", index = c(5, 2), format = "matrix") > stopifnot(identical(dim(traj_observed), c(2L, 2L))) > stopifnot(all(abs(traj_observed[1, ] - 0.1) < 1e-8)) > stopifnot(all(abs(traj_observed[2, ] - 0.4) < 1e-8)) > > ## Check extracting all compartments in a subset of U as a data.frame > traj_expected <- data.frame(node = c(2L, 5L, 2L, 5L), + time = c(1L, 1L, 2L, 2L), + S = c(1L, 4L, 1L, 4L), + I = c(0L, 0L, 0L, 0L)) > stopifnot(identical( + trajectory(result, c("S", "I"), index = c(5, 2)), + traj_expected)) > > ## Check extracting all compartments in U as a data.frame > traj_expected <- data.frame( + node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), + time = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), + S = c(0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L), + I = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)) > traj_observed <- trajectory(result, c("S", "I")) > stopifnot(identical(traj_observed, traj_expected)) > > ## Check extracting all compartments in U and V as a data.frame > traj_expected <- data.frame( + node = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L, 4L, 5L, 6L), + time = c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), + S = c(0L, 1L, 2L, 3L, 4L, 5L, 0L, 1L, 2L, 3L, 4L, 5L), + I = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), + phi = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0, 0.1, 0.2, 0.3, 0.4, 0.5)) > traj_observed <- trajectory(result, c("S", "I", "phi")) > stopifnot(identical(traj_observed[, -5], traj_expected[, -5])) > stopifnot(all(abs(traj_observed[, 5] - traj_expected$phi) < 1e-8)) > > ## Use formula notation > traj_observed <- trajectory(result, ~.) > stopifnot(identical(traj_observed[, -5], traj_expected[, -5])) > stopifnot(all(abs(traj_observed[, 5] - traj_expected$phi) < 1e-8)) > > ## Specify invalid formula > res <- assertError(trajectory(result, ~1)) > check_error(res, "Non-existing compartment(s) in model: '1'.") > > ## Check SISe plot method > pdf_file <- tempfile(fileext = ".pdf") > pdf(pdf_file) > plot(result) > dev.off() null device 1 > stopifnot(file.exists(pdf_file)) > unlink(pdf_file) > > ## Check that C SISe run function fails for misspecified SISe model > res <- assertError(.Call(SimInf:::SISe_run, NULL, NULL)) > check_error(res, "Invalid model.") > > res <- assertError(.Call(SimInf:::SISe_run, "SISe", NULL)) > check_error(res, "Invalid model.") > > ## Check error non-finite v > model <- SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = 0.000011) > model@gdata["beta_t1"] <- Inf > model@gdata["beta_t2"] <- Inf > model@gdata["beta_t3"] <- Inf > model@gdata["beta_t4"] <- Inf > res <- assertError(run(model)) > check_error(res, "The continuous state 'v' is not finite.") > > ## Check negative v > model <- SISe(u0 = u0, + tspan = seq_len(10) - 1, + events = NULL, + phi = rep(1, nrow(u0)), + upsilon = 0.0357, + gamma = 0.1, + alpha = 1.0, + beta_t1 = 0.19, + beta_t2 = 0.085, + beta_t3 = 0.075, + beta_t4 = 0.185, + end_t1 = 91, + end_t2 = 182, + end_t3 = 273, + end_t4 = 365, + epsilon = -10.000011) > res <- assertError(run(model)) > check_error(res, "The continuous state 'v' is negative.") > > ## Check data > stopifnot(identical(nrow(events_SISe()), 466692L)) > stopifnot(identical(nrow(u0_SISe()), 1600L)) > > proc.time() user system elapsed 1.42 0.17 1.59