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 -- 2024 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 <https://www.gnu.org/licenses/>.
> 
> library(SimInf)
> library(Matrix)
> 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] Matrix_1.7-0 SimInf_9.7.0

loaded via a namespace (and not attached):
[1] MASS_7.3-60.2  compiler_4.4.0 grid_4.4.0     digest_0.6.35  lattice_0.22-6
> 
> ## Initialize test data
> S <- as(Matrix(c(-1,  0,  0,
+                   1,  0,  0,
+                   0, -1,  0,
+                   0,  1,  0,
+                   0,  0, -1,
+                   0,  0,  1),
+                nrow   = 6,
+                ncol   = 3,
+                byrow  = TRUE,
+                dimnames = list(LETTERS[1:6], NULL)),
+         "dgCMatrix")
> 
> Nn <- 6L
> 
> G <- as(Matrix(c(1, 0, 0,
+                  0, 1, 0,
+                  0, 0, 1),
+                nrow   = 3,
+                ncol   = 3,
+                byrow  = TRUE,
+                dimnames = list(c("A -> B", "C -> D", "E -> F"), NULL)),
+         "dgCMatrix")
'as(<ddiMatrix>, "dgCMatrix")' is deprecated.
Use 'as(as(., "generalMatrix"), "CsparseMatrix")' instead.
See help("Deprecated") and help("Matrix-deprecated").
> 
> u0 <- structure(c(0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 2, 0, 2, 0, 2,
+                   0, 3, 0, 3, 0, 3, 0, 4, 0, 4, 0, 4, 0, 5, 0, 5, 0, 5, 0),
+                 .Dim = c(6L, 6L))
> storage.mode(u0) <- "integer"
> 
> U <- matrix(nrow = 0, ncol = 0)
> storage.mode(U) <- "integer"
> 
> ## Check valid_SimInf_model_object
> m <- SISe(u0 = c(S = 10, I = 0), tspan = 1:10, phi = 0,
+           upsilon = 0.1, gamma = 0.1, alpha = 1.0, beta_t1 = 0.1,
+           beta_t2 = 0.1, beta_t3 = 0.1, beta_t4 = 0.1, end_t1  = 91,
+           end_t2  = 182, end_t3  = 273, end_t4  = 365, epsilon = 0.1)
> stopifnot(isTRUE(SimInf:::valid_SimInf_model_object(m)))
> 
> ## Check valid_SimInf_model_object with invalid tspan.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@tspan <- integer(0)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Input time-span must be a double vector."))
> m@tspan <- numeric(0)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Input time-span must be an increasing vector."))
> 
> ## Check valid_SimInf_model_object with invalid u0.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> storage.mode(m@u0) <- "double"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Initial state 'u0' must be an integer matrix."))
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@u0[1, 1] <- -1L
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Initial state 'u0' has negative elements."))
> 
> ## Check valid_SimInf_model_object with invalid U.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> storage.mode(m@U) <- "double"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Output state 'U' must be an integer matrix."))
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@U <- matrix(-1L)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Output state 'U' has negative elements."))
> 
> ## Check valid_SimInf_model_object with invalid v0.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@v0 <- matrix(1L)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Initial model state 'v0' must be a double matrix."))
> m@v0 <- matrix(1)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'v0' must have rownames."))
> m@v0 <- matrix(c(1, 1), ncol = 2)
> rownames(m@v0) <- "test"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "The number of nodes in 'u0' and 'v0' must match."))
> 
> ## Check valid_SimInf_model_object with invalid V.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> storage.mode(m@V) <- "integer"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Output model state 'V' must be a double matrix."))
> 
> ## Check valid_SimInf_model_object with invalid S.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@S@x <- m@S@x * 0.5
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'S' matrix must be an integer matrix."))
> 
> ## Check valid_SimInf_model_object with different rownames in S and E.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1,
+          events = data.frame(event = 1, node = 1, n = 1, time = 1, dest = 0,
+                              proportion = 0, select = 1, shift = 0))
> rownames(m@events@E) <- NULL
> stopifnot(identical(
+     SimInf:::valid_SimInf_model_object(m),
+     "'S' and 'E' must have rownames matching the compartments."))
> rownames(m@events@E) <- rownames(m@S)
> rownames(m@events@E)[1] <- "Z"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'S' and 'E' must have identical compartments."))
> 
> ## Check valid_SimInf_model_object with invalid G.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@G <- m@G[1, 1:2, drop = FALSE]
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "Wrong size of dependency graph."))
> 
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> rownames(m@G) <- NULL
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'G' must have rownames that specify transitions."))
> 
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> rownames(m@G)[1] <- ""
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'G' must have rownames that specify transitions."))
> 
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> rownames(m@G)[1] <- "A"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'G' rownames have invalid transitions."))
> 
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> rownames(m@G)[1] <- "Z -> beta*Z*I/(S+I+R) -> I"
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'G' and 'S' must have identical compartments."))
> 
> ## Check valid_SimInf_model_object with invalid ldata.
> m <- SIR(u0 = data.frame(S = 10, I = 0, R = 0),
+          tspan = 1:10, beta = 0.1, gamma = 0.1)
> m@ldata <- matrix(1L)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'ldata' matrix must be a double matrix."))
> m@ldata <- matrix(c(1, 2), ncol = 2)
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "The number of nodes in 'u0' and 'ldata' must match."))
> 
> ## Check valid_SimInf_model_object with invalid gdata.
> m <- SISe(u0 = data.frame(S = 10, I = 0), tspan = 1:10, phi = 0,
+           upsilon = 0.1, gamma = 0.1, alpha = 1.0, beta_t1 = 0.1,
+           beta_t2 = 0.1, beta_t3 = 0.1, beta_t4 = 0.1, end_t1  = 91,
+           end_t2  = 182, end_t3  = 273, end_t4  = 365, epsilon = 0.1)
> m@gdata <- as.integer(m@gdata)
> names(m@gdata) <- c("upsilon", "gamma", "alpha", "beta_t1",
+                     "beta_t2", "beta_t3", "beta_t4", "epsilon")
> stopifnot(identical(SimInf:::valid_SimInf_model_object(m),
+                     "'gdata' must be a double vector."))
> 
> ## Check v0
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = U,
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = c(1, 2),
+                                 u0    = u0,
+                                 v0    = 1))
> check_error(res, "'v0' must be a double matrix.")
> res <- SimInf_model(G     = G,
+                     S     = S,
+                     U     = U,
+                     ldata = matrix(rep(0, Nn), nrow = 1),
+                     tspan = c(1, 2),
+                     u0    = u0,
+                     v0    = matrix(rep(1L, Nn), nrow = 1,
+                                    dimnames = list("phi")))
> 
> ## Check tspan
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = numeric(0),
+                        u0    = u0))
> check_error(res, "Input time-span must be an increasing vector.", FALSE)
> 
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(c(3, 2, 1)),
+                        u0    = u0))
> check_error(res, "Input time-span must be an increasing vector.", FALSE)
> 
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = c(1, NA, 3),
+                        u0    = u0))
> check_error(res, "Input time-span must be an increasing vector.", FALSE)
> 
> ## Check that tspan can be a Date vector
> res <- SimInf_model(G     = G,
+                     S     = S,
+                     U     = U,
+                     ldata = matrix(rep(0, Nn), nrow = 1),
+                     tspan = as.Date(c("2017-01-01",
+                                       "2017-01-02",
+                                       "2017-01-03")),
+                     u0    = u0)
> stopifnot(identical(res@tspan,
+                     structure(c(1, 2, 3),
+                               .Names = c("2017-01-01",
+                                          "2017-01-02",
+                                          "2017-01-03"))))
> 
> ## Check u0
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0 * -1L))
> check_error(res, "Initial state 'u0' has negative elements.", FALSE)
> 
> ## Change storage mode of u0 to double.
> ## Should not raise error
> u0_double <- u0
> storage.mode(u0_double) <- "double"
> SimInf_model(G     = G,
+              S     = S,
+              U     = U,
+              ldata = matrix(rep(0, Nn), nrow = 1),
+              tspan = as.numeric(1:10),
+              u0    = u0_double)
Model: SimInf_model
Number of nodes: 6
Number of transitions: 3
Number of scheduled events: 0

Compartments
------------
 - Empty, please run the model first
> 
> ## Change storage mode of u0 to double and change to non-integer values.
> ## Should raise error
> u0_double <- u0
> storage.mode(u0_double) <- "double"
> u0_double <- 1.2 * u0_double
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = U,
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = as.numeric(1:10),
+                                 u0    = u0_double))
> check_error(res, "'u0' must be an integer matrix.")
> 
> ## Change u0 to vector. Should raise an error.
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = U,
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = as.numeric(1:10),
+                                 u0    = as.numeric(u0)))
> check_error(res, "'u0' must be an integer matrix.")
> 
> ## Check S
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S * 1.1,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'S' matrix must be an integer matrix.", FALSE)
> 
> ## Check G
> ## Error: Wrong size of dependency graph
> res <- assertError(new("SimInf_model",
+                        G     = G[-1, ],
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "Wrong size of dependency graph.", FALSE)
> 
> ## Check specication of transition
> rownames(G) <- NULL
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'G' must have rownames that specify transitions.", FALSE)
> 
> rownames(G) <- c("", "  ", "E -> F")
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'G' must have rownames that specify transitions.", FALSE)
> 
> rownames(G) <- c("A -> B", "C -> D", "E ->")
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'G' rownames have invalid transitions.", FALSE)
> 
> rownames(G) <- c("A -> B", "C -> D", "E ->")
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'G' rownames have invalid transitions.", FALSE)
> 
> rownames(G) <- c("A -> B", "C -> D", "E -> G")
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'G' and 'S' must have identical compartments", FALSE)
> rownames(G) <- c("A -> B", "C -> D", "E -> F")
> 
> ## Check gdata
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = matrix(rep(0, Nn), nrow = 1),
+                        gdata = 1L,
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "'gdata' must be a double vector.", FALSE)
> 
> ## Check ldata
> ldata <- matrix(rep(0, Nn), nrow = 1)
> ldata <- ldata[, 1:3, drop = FALSE]
> 
> ## Wrong size of ldata matrix
> res <- assertError(new("SimInf_model",
+                        G     = G,
+                        S     = S,
+                        U     = U,
+                        ldata = ldata,
+                        tspan = as.numeric(1:10),
+                        u0    = u0))
> check_error(res, "The number of nodes in 'u0' and 'ldata' must match.", FALSE)
> 
> ## Check initial state
> u0 <- data.frame(S_1 = c(0, 1, 2, 3, 4, 5),
+                  I_1 = c(0, 0, 0, 0, 0, 0),
+                  S_2 = c(0, 1, 2, 3, 4, 5),
+                  I_2 = c(0, 0, 0, 0, 0, 0),
+                  S_3 = c(0, 1, 2, 3, 4, 5),
+                  I_3 = c(0, 0, 0, 0, 0, 0))
> 
> ## 'u0' is NULL
> res <- assertError(SimInf_model())
> check_error(res, "'u0' must be an integer matrix.")
> 
> ## Check first lines of show method without events
> model <- SISe(u0      = data.frame(S = 99, I = 1),
+               tspan   = seq_len(1000) - 1,
+               events  = NULL,
+               phi     = 1,
+               upsilon = 0.017,
+               gamma   = 0.1,
+               alpha   = 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)
> 
> show_expected <- c("Model: SISe",
+                    "Number of nodes: 1",
+                    "Number of transitions: 2",
+                    "Number of scheduled events: 0",
+                    "")
> 
> stopifnot(identical(show(model), model))
Model: SISe
Number of nodes: 1
Number of transitions: 2
Number of scheduled events: 0

Global data
-----------
 Parameter Value   
 upsilon   0.017000
 gamma     0.100000
 alpha     1.000000
 beta_t1   0.190000
 beta_t2   0.085000
 beta_t3   0.075000
 beta_t4   0.185000
 epsilon   0.000011

Local data
----------
 Parameter Value
 end_t1     91  
 end_t2    182  
 end_t3    273  
 end_t4    365  

Continuous state variables
--------------------------
 - Empty, please run the model first

Compartments
------------
 - Empty, please run the model first
> show_observed <- capture.output(show(model))
> 
> stopifnot(identical(show_observed[1:5], show_expected))
> 
> ## Check summary method without events
> summary(run(model))
Model: SISe
Number of nodes: 1

Transitions
-----------
 S -> upsilon*phi*S -> I
 I -> gamma*I -> S

Global data
-----------
 Parameter Value   
 upsilon   0.017000
 gamma     0.100000
 alpha     1.000000
 beta_t1   0.190000
 beta_t2   0.085000
 beta_t3   0.075000
 beta_t4   0.185000
 epsilon   0.000011

Local data
----------
 Parameter Value
 end_t1     91  
 end_t2    182  
 end_t3    273  
 end_t4    365  

Scheduled events
----------------
 - None

Continuous state variables
--------------------------
        Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
 phi 0.00223 0.20781 0.47267 1.49720 1.95607 7.32418

Compartments
------------
    Min. 1st Qu. Median  Mean 3rd Qu.  Max.
 S  39.0    72.0   93.0  84.3    98.0 100.0
 I   0.0     2.0    7.0  15.7    28.0  61.0
> 
> ## Check first lines of show method with events
> u0 <- data.frame(S_1 = c(0, 1, 2, 3, 4, 5),
+                  I_1 = c(0, 0, 0, 0, 0, 0),
+                  S_2 = c(0, 1, 2, 3, 4, 5),
+                  I_2 = c(0, 0, 0, 0, 0, 0),
+                  S_3 = c(0, 1, 2, 3, 4, 5),
+                  I_3 = c(0, 0, 0, 0, 0, 0))
> 
> events <- data.frame(
+     event      = c(3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3),
+     time       = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
+     node       = c(2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6),
+     dest       = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
+     n          = c(1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5),
+     proportion = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
+     select     = c(4, 5, 6, 4, 5, 6, 4, 5, 6, 4, 5, 6, 4, 5, 6),
+     shift      = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
> 
> model <- SISe3(u0        = u0,
+                tspan     = 0:10,
+                events    = events,
+                phi       = rep(1, 6),
+                upsilon_1 = 1,
+                upsilon_2 = 1,
+                upsilon_3 = 1,
+                gamma_1   = 1,
+                gamma_2   = 1,
+                gamma_3   = 1,
+                alpha     = 1,
+                beta_t1   = 1,
+                beta_t2   = 1,
+                beta_t3   = 1,
+                beta_t4   = 1,
+                end_t1    = 91,
+                end_t2    = 182,
+                end_t3    = 273,
+                end_t4    = 365,
+                epsilon   = 1)
> 
> show_observed <- capture.output(show(model))
> 
> stopifnot(identical(
+     show_observed[1:5],
+     c("Model: SISe3",
+       "Number of nodes: 6",
+       "Number of transitions: 6",
+       "Number of scheduled events: 15",
+       "")))
> 
> stopifnot(identical(
+     show_observed[22:28],
+     c("Local data",
+       "----------",
+       " Parameter Value",
+       " end_t1     91  ",
+       " end_t2    182  ",
+       " end_t3    273  ",
+       " end_t4    365  ")))
> 
> ## Check summary method with events
> summary(run(model))
Model: SISe3
Number of nodes: 6

Transitions
-----------
 S_1 -> upsilon_1*phi*S_1 -> I_1
 I_1 -> gamma_1*I_1 -> S_1
 S_2 -> upsilon_2*phi*S_2 -> I_2
 I_2 -> gamma_2*I_2 -> S_2
 S_3 -> upsilon_3*phi*S_3 -> I_3
 I_3 -> gamma_3*I_3 -> S_3

Global data
-----------
 Parameter Value
 upsilon_1 1    
 upsilon_2 1    
 upsilon_3 1    
 gamma_1   1    
 gamma_2   1    
 gamma_3   1    
 alpha     1    
 beta_t1   1    
 beta_t2   1    
 beta_t3   1    
 beta_t4   1    
 epsilon   1    

Local data
----------
 Parameter Value
 end_t1     91  
 end_t2    182  
 end_t3    273  
 end_t4    365  

Scheduled events
----------------
 Exit: 0
 Enter: 0
 Internal transfer: 0
 External transfer: 15

Network summary
---------------
             Min. 1st Qu. Median  Mean 3rd Qu.  Max.
 Indegree:  0.000   0.000  0.000 0.833   0.000 5.000
 Outdegree: 0.000   1.000  1.000 0.833   1.000 1.000

Continuous state variables
--------------------------
     Min. 1st Qu. Median Mean 3rd Qu. Max.
 phi 1.00    1.00   1.00 1.14    1.00 2.00

Compartments
------------
       Min. 1st Qu. Median   Mean 3rd Qu.   Max.
 S_1  0.000   0.000  0.000  0.955   0.000 11.000
 I_1  0.000   0.000  0.000  1.545   0.000 12.000
 S_2  0.000   0.000  0.000  0.955   0.000 10.000
 I_2  0.000   0.000  0.000  1.545   0.000 12.000
 S_3  0.000   0.000  0.000  1.061   0.000  9.000
 I_3  0.000   0.000  0.000  1.439   0.000 12.000
> 
> ## Check U. Change storage mode of U to double.
> ## Should not raise error
> U <- structure(c(
+     0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 0L, 2L, 0L, 1L, 1L,
+     1L, 1L, 2L, 1L, 3L, 0L, 2L, 1L, 2L, 2L, 0L, 4L, 1L, 3L, 2L, 3L,
+     3L, 2L, 1L, 4L, 6L, 9L, 7L, 8L, 4L, 11L, 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, 7L, 8L, 7L, 8L, 5L, 10L, 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, 8L, 7L, 6L, 9L,
+     8L, 7L, 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,
+     5L, 10L, 4L, 11L, 6L, 9L, 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, 7L, 8L, 5L, 10L, 7L, 8L, 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, 4L, 11L, 5L, 10L, 3L, 12L, 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, 8L, 7L, 5L,
+     10L, 4L, 11L, 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, 6L, 9L, 2L, 13L, 4L, 11L, 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, 5L, 10L, 2L, 13L, 7L, 8L, 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, 9L, 6L, 2L, 13L, 6L, 9L, 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(36L, 11L))
> 
> U_double <- U
> storage.mode(U_double) <- "double"
> 
> SimInf_model(G     = G,
+              S     = S,
+              U     = U_double,
+              ldata = matrix(rep(0, Nn), nrow = 1),
+              tspan = as.numeric(1:10),
+              u0    = u0)
Model: SimInf_model
Number of nodes: 6
Number of transitions: 3
Number of scheduled events: 0

Compartments
------------
     Min. 1st Qu. Median   Mean 3rd Qu.   Max.
 A  0.000   0.000  0.000  1.106   0.000  9.000
 B  0.000   0.000  0.000  1.394   0.000 11.000
 C  0.000   0.000  0.000  0.803   0.000  7.000
 D  0.000   0.000  0.000  1.697   0.000 13.000
 E  0.000   0.000  0.000  0.909   0.000  8.000
 F  0.000   0.000  0.000  1.591   0.000 12.000
> 
> ## Check U. Change storage mode of U to double and change to non-integer values.
> ## Should raise error
> U_double <- U
> storage.mode(U_double) <- "double"
> U_double <- U_double * 1.2
> 
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = U_double,
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = as.numeric(1:10),
+                                 u0    = u0))
> check_error(res, "'U' must be an integer matrix.")
> 
> ## Check U. Should not raise an error if U is an integer vector of length 0
> SimInf_model(G     = G,
+              S     = S,
+              U     = integer(0),
+              ldata = matrix(rep(0, Nn), nrow = 1),
+              tspan = as.numeric(1:10),
+              u0    = u0)
Model: SimInf_model
Number of nodes: 6
Number of transitions: 3
Number of scheduled events: 0

Compartments
------------
 - Empty, please run the model first
> 
> ## Check U. Should raise error if U is an integer vector of length > 0
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = c(1L),
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = as.numeric(1:10),
+                                 u0    = u0))
> check_error(res, "'U' must be equal to a 0 x 0 matrix.")
> 
> ## Check V. Change storage mode of V to double.
> ## Should not raise error
> V <- structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+                  1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+                  1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+                  1, 1, 1, 1, 1, 1, 1, 1, 1),
+                .Dim = c(6L, 10L))
> 
> V_integer <- V
> storage.mode(V) <- "integer"
> 
> SimInf_model(G     = G,
+              S     = S,
+              U     = U,
+              V     = V_integer,
+              ldata = matrix(rep(0, Nn), nrow = 1),
+              tspan = as.numeric(1:10),
+              u0    = u0)
Model: SimInf_model
Number of nodes: 6
Number of transitions: 3
Number of scheduled events: 0

Compartments
------------
     Min. 1st Qu. Median   Mean 3rd Qu.   Max.
 A  0.000   0.000  0.000  1.106   0.000  9.000
 B  0.000   0.000  0.000  1.394   0.000 11.000
 C  0.000   0.000  0.000  0.803   0.000  7.000
 D  0.000   0.000  0.000  1.697   0.000 13.000
 E  0.000   0.000  0.000  0.909   0.000  8.000
 F  0.000   0.000  0.000  1.591   0.000 12.000
> 
> ## Check V. Change storage mode of V to character
> ## Should raise error
> V_character <- V
> storage.mode(V_character) <- "character"
> 
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = U,
+                                 V     = V_character,
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = as.numeric(1:10),
+                                 u0    = u0))
> check_error(res, "'V' must be a double matrix.")
> 
> ## Check V. Should raise error if V is a vector of length > 0
> res <- assertError(SimInf_model(G     = G,
+                                 S     = S,
+                                 U     = U,
+                                 V     = 1,
+                                 ldata = matrix(rep(0, Nn), nrow = 1),
+                                 tspan = as.numeric(1:10),
+                                 u0    = u0))
> check_error(res, "'V' must be equal to a 0 x 0 matrix.")
> 
> ## Check V. Should not raise an error if V is an integer vector of length 0
> SimInf_model(G     = G,
+              S     = S,
+              U     = U,
+              V     = integer(0),
+              ldata = matrix(rep(0, Nn), nrow = 1),
+              tspan = as.numeric(1:10),
+              u0    = u0)
Model: SimInf_model
Number of nodes: 6
Number of transitions: 3
Number of scheduled events: 0

Compartments
------------
     Min. 1st Qu. Median   Mean 3rd Qu.   Max.
 A  0.000   0.000  0.000  1.106   0.000  9.000
 B  0.000   0.000  0.000  1.394   0.000 11.000
 C  0.000   0.000  0.000  0.803   0.000  7.000
 D  0.000   0.000  0.000  1.697   0.000 13.000
 E  0.000   0.000  0.000  0.909   0.000  8.000
 F  0.000   0.000  0.000  1.591   0.000 12.000
> 
> ## Check that plot raises an error if the model hasn't run
> model <- SISe(u0      = data.frame(S = 99, I = 1),
+               tspan   = seq_len(1000) - 1,
+               events  = NULL,
+               phi     = 1,
+               upsilon = 0.017,
+               gamma   = 0.1,
+               alpha   = 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)
> res <- assertError(plot(model))
> check_error(res, "Please run the model first, the trajectory is empty.")
> 
> ## Check that the SimInf_model initialisation fails if the events
> ## argument is not either NULL or a data.frame
> u0 <- data.frame(S_1 = c(0, 1, 2, 3, 4, 5),
+                  I_1 = c(0, 0, 0, 0, 0, 0),
+                  S_2 = c(0, 1, 2, 3, 4, 5),
+                  I_2 = c(0, 0, 0, 0, 0, 0),
+                  S_3 = c(0, 1, 2, 3, 4, 5),
+                  I_3 = c(0, 0, 0, 0, 0, 0))
> 
> res <- assertError(model <- SISe3(u0        = u0,
+                                   tspan     = 0:10,
+                                   events    = "events",
+                                   phi       = rep(1, 6),
+                                   upsilon_1 = 1,
+                                   upsilon_2 = 1,
+                                   upsilon_3 = 1,
+                                   gamma_1   = 1,
+                                   gamma_2   = 1,
+                                   gamma_3   = 1,
+                                   alpha     = 1,
+                                   beta_t1   = 1,
+                                   beta_t2   = 1,
+                                   beta_t3   = 1,
+                                   beta_t4   = 1,
+                                   end_t1    = 91,
+                                   end_t2    = 182,
+                                   end_t3    = 273,
+                                   end_t4    = 365,
+                                   epsilon   = 1))
> check_error(res, "'events' must be NULL or a data.frame.")
> 
> ## Check arguments to 'trajectory' method
> u0 <- data.frame(S = 100:105, I = 1:6, R = rep(0, 6))
> model <- SIR(u0 = u0, tspan = 1:10, beta = 0.16, gamma = 0.077)
> result <- run(model)
> res <- assertError(trajectory(result, compartments = c("A", "S")))
> check_error(res, "Non-existing compartment(s) in model: 'A'.")
> res <- assertError(trajectory(result, index = c("A", "S")))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> res <- assertError(trajectory(result, index = 3.4))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> res <- assertError(trajectory(result, index = 0))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> res <- assertError(trajectory(result, index = 10))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> 
> ## Check arguments to 'prevalence' method
> u0 <- data.frame(S = 100:105, I = 1:6, R = rep(0, 6))
> model <- SIR(u0 = u0, tspan = 1:10, beta = 0.16, gamma = 0.077)
> result <- run(model)
> res <- assertError(prevalence(result, A + S ~ S))
> check_error(res, "Non-existing compartment(s) in model: 'A'.")
> res <- assertError(prevalence(result, S ~ A + S))
> check_error(res, "Non-existing compartment(s) in model: 'A'.")
> res <- assertError(prevalence(result, I ~ S + I + R, i = c("A", "S")))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> res <- assertError(prevalence(result, I ~ S + I + R, i = 3.4))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> res <- assertError(prevalence(result, I ~ S + I + R, i = 0))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> res <- assertError(prevalence(result, I ~ S + I + R, i = 10))
> check_error(
+     res,
+     "The node index must be an integer > 0 and <= number of nodes.")
> 
> ## Check 'gdata'
> model <- SISe(u0 = data.frame(S = 10, I = 0), tspan = 1:10, phi = 0,
+               upsilon = 1, gamma = 2, alpha = 3, beta_t1 = 4,
+               beta_t2 = 5, beta_t3 = 6, beta_t4 = 7, end_t1  = 91,
+               end_t2  = 182, end_t3  = 273, end_t4  = 365, epsilon = 8)
> 
> stopifnot(identical(gdata(model),
+                     c(upsilon = 1, gamma = 2, alpha = 3, beta_t1 = 4,
+                       beta_t2 = 5, beta_t3 = 6, beta_t4 = 7, epsilon = 8)))
> 
> gdata(model, "epsilon") <- 9
> 
> stopifnot(identical(gdata(model),
+                     c(upsilon = 1, gamma = 2, alpha = 3, beta_t1 = 4,
+                       beta_t2 = 5, beta_t3 = 6, beta_t4 = 7, epsilon = 9)))
> 
> res <- assertError(gdata(model) <- 6)
> check_error(res, "Missing 'parameter' argument.")
> 
> res <- assertError(gdata(model, "epsilon") <- "6")
> check_error(res, "'value' argument must be a numeric.")
> 
> res <- assertError(gdata(model, 5) <- 6)
> check_error(res, "'parameter' argument must be a character.")
> 
> res <- assertError("gdata<-" (model, "epsilon"))
> check_error(res, "Missing 'value' argument.")
> 
> ## Check 'ldata'
> model@ldata <- matrix(1, dimnames = list("test", NULL))
> res <- assertError(ldata(model))
> check_error(res, "Missing 'node' argument.")
> 
> res <- assertError(ldata(model, "0"))
> check_error(res, "Invalid 'node' argument.")
> 
> res <- assertError(ldata(model, 0))
> check_error(res, "Invalid 'node' argument.")
> 
> res <- assertError(ldata(model, c(0, 0)))
> check_error(res, "Invalid 'node' argument.")
> 
> ldata(model, 1)
test 
   1 
> 
> proc.time()
   user  system elapsed 
   1.26    0.09    1.34