R Under development (unstable) (2024-11-21 r87360 ucrt) -- "Unsuffered Consequences" 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. > if (!requireNamespace("deSolve")) + q("no") Loading required namespace: deSolve > > library(fastbeta) > options(warn = 2L, error = if (interactive()) utils::recover) > > utils::data(seir.ts01, package = "fastbeta") > a <- attributes(seir.ts01) > m <- a[["m"]] > n <- a[["n"]] > p <- m + n + 2L > > series <- cbind(seir.ts01[, c("Z", "B")], mu = a[["mu"]](0)) > colnames(series) <- c("Z", "B", "mu") > > start <- 23; end <- 231 > > set.seed(0L) > args <- c(list(series = series), + a[c("sigma", "gamma", "delta", "m", "n", "init")], + list(start = start, end = end)) > init <- seir.ts01[which.min(abs(time(seir.ts01) - start)), seq_len(p)] > args[["init"]] <- init * rlnorm(p, 0, 0.1) > > L0 <- do.call(ptpi, `[[<-`(args, "complete", FALSE)) > L1 <- do.call(ptpi, `[[<-`(args, "complete", TRUE)) > str(L1) List of 4 $ value: Named num [1:4] 50283 2505 2427 948725 ..- attr(*, "names")= chr [1:4] "S" "E" "I" "R" $ diff : num 0.000911 $ iter : int 17 $ x : Time-Series [1:209, 1:4, 1:17] from 23 to 231: 56828 56502 56184 55880 55596 ... ..- attr(*, "dimnames")=List of 3 .. ..$ : NULL .. ..$ : chr [1:4] "S" "E" "I" "R" .. ..$ : NULL > > stopifnot(exprs = { + is.list(L1) + length(L1) == 4L + identical(names(L1), c("value", "diff", "iter", "x")) + is.list(L0) + length(L0) == length(L1) + identical(names(L0), names(L1)) + identical(L0[-4L], L1[-4L]) + is.null(L0[[4L]]) + }) > > value <- L1[["value"]] > stopifnot(exprs = { + is.double(value) + length(value) == p + identical(names(value), rep.int(c("S", "E", "I", "R"), c(1L, m, n, 1L))) + !anyNA(value) + min(value) >= 0 + }) > > diff <- L1[["diff"]] > stopifnot(exprs = { + is.double(diff) + length(diff) == 1L + !is.na(diff) + diff >= 0 + }) > > iter <- L1[["iter"]] > stopifnot(exprs = { + is.integer(iter) + length(iter) == 1L + !is.na(iter) + iter >= 1L + }) > > x <- L1[["x"]] > stopifnot(exprs = { + is.double(x) + stats::is.ts(x) && inherits(x, "mts") # is.mts checks is.matrix + identical(dim(x), c(as.integer(end - start + 1), p, iter)) + identical(dimnames(x), list(NULL, names(value), NULL)) + !anyNA(x) + min(x) >= 0 + }) > > if (grDevices::dev.interactive(TRUE)) + plot(x[, "S", ], plot.type = "single") > > proc.time() user system elapsed 0.42 0.09 0.46