Nothing
tests/testthat/test-run-general.R
In odin: ODE Generation and Integration
context("run: general")
## TODO: these should be split up eventually
## Tests of the approach against some known models.
test_that_odin("constant model", {
gen <- odin({
deriv(y) <- 0.5
initial(y) <- 1
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 11)
yy <- mod$run(tt)
expect_equal(yy[, 2L], seq(1.0, length.out = length(tt), by = 0.5))
## Can avoid having column names:
expect_null(colnames(mod$run(tt, use_names = FALSE)))
})
test_that_odin("user variables", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- user(100)
r <- user()
})
## Two different errors when r is not provided:
expect_error(gen$new(), "Expected a value for 'r'")
expect_error(gen$new(r = NULL), "Expected a value for 'r'")
mod <- gen$new(r = pi)
dat <- mod$contents()
expect_equal(dat$r, pi)
expect_equal(dat$N0, 1.0)
expect_equal(dat$K, 100.0)
## This should be a noop:
mod$set_user()
dat <- mod$contents()
expect_equal(dat$r, pi)
expect_equal(dat$N0, 1.0)
expect_equal(dat$K, 100.0)
## Now, try setting one of these:
mod$set_user(N0 = 5)
dat <- mod$contents()
expect_equal(dat$r, pi)
expect_equal(dat$N0, 5.0)
expect_equal(dat$K, 100.0)
## Don't reset to default on subsequent set:
mod$set_user()
expect_equal(mod$contents()$N0, 5.0)
})
test_that_odin("user variables on models with none", {
gen <- odin::odin({
a <- 1
deriv(y) <- 0.5 * a
initial(y) <- 1
})
mod <- gen$new()
## NOTE: This is a change of behaviour, but that's probably OK
expect_silent(mod$set_user())
expect_warning(mod$set_user(a = 1), "Unknown user parameters: a")
})
test_that_odin("non-numeric time", {
## Only an issue for delay models or models with time-dependent
## initial conditions.
gen <- odin({
ylag <- delay(y, 10)
initial(y) <- 0.5
deriv(y) <- 0.2 * ylag * 1 / (1 + ylag^10) - 0.1 * y
})
mod <- gen$new()
t <- as.integer(0:10)
expect_equal(mod$initial(t[1]), 0.5)
expect_silent(mod$run(t))
})
test_that_odin("delays and initial conditions", {
gen <- odin({
ylag <- delay(y, 10)
initial(y) <- 0.5
deriv(y) <- 0.2 * ylag * 1 / (1 + ylag^10) - 0.1 * y
})
mod <- gen$new()
t <- as.integer(0:10)
res1 <- mod$run(t)
dat <- mod$contents()
expect_equal(dat$initial_t, 0.0)
expect_equal(dat$initial_y, 0.5)
res2 <- mod$run(t + 1)
expect_equal(res2[, 2], res1[, 2])
expect_equal(mod$contents()$initial_t, 1.0)
## Trickier; pass the initial conditions through and have them set
## into the model so delays work correctly.
res3 <- mod$run(t + 2, 0.5)
expect_equal(res3[, 2], res1[, 2], tolerance = 1e-7)
expect_equal(mod$contents()$initial_t, 2.0)
expect_equal(mod$contents()$initial_y, 0.5)
res4 <- mod$run(t + 3, 0.6)
expect_equal(mod$contents()$initial_t, 3.0)
expect_equal(mod$contents()$initial_y, 0.6)
expect_false(isTRUE(all.equal(res4[, 2], res1[, 2])))
})
test_that_odin("non-numeric user", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- user(100)
r <- user()
})
mod <- gen$new(r = 1L)
expect_is(mod$contents()$r, "numeric")
expect_identical(mod$contents()$r, 1.0)
})
test_that_odin("conditionals", {
gen <- odin({
deriv(x) <- if (x > 2) 0 else 0.5
initial(x) <- 0
})
## Hey ho it works:
mod <- gen$new()
t <- seq(0, 5, length.out = 101)
y <- mod$run(t)
expect_equal(y[, 2], ifelse(t < 4, t * 0.5, 2.0), tolerance = 1e-5)
})
test_that_odin("conditionals, precendence", {
gen <- odin({
deriv(x) <- 0.1 + 2 * if (t > 2) -0.1 else 0.5
initial(x) <- 0
})
mod <- gen$new()
t <- seq(0, 5, length.out = 101)
y <- mod$run(t)
cmp <- ifelse(t < 2, 1.1 * t, 2.4 - 0.1 * t)
expect_equal(y[, 2], cmp, tolerance = 1e-5)
})
test_that_odin("time dependent", {
## A time dependent initial condition:
gen_t <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- sqrt(t) + 1
K <- 100
r <- 0.5
})
## The same model, but taking N0 as a user parameter.
gen_cmp <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user()
K <- 100
r <- 0.5
})
mod_t <- gen_t$new()
expect_equal(mod_t$initial(0), 1)
expect_equal(mod_t$initial(10), sqrt(10) + 1)
t0 <- seq(0, 10, length.out = 101)
t1 <- seq(10, 20, length.out = 101)
expect_equal(mod_t$run(t0), gen_cmp$new(N0 = sqrt(t0[[1]]) + 1)$run(t0))
expect_equal(mod_t$run(t1), gen_cmp$new(N0 = sqrt(t1[[1]]) + 1)$run(t1))
})
test_that_odin("time dependent initial conditions", {
gen <- odin({
y1 <- sin(t)
deriv(y2) <- y1
initial(y2) <- -1
output(y1) <- y1
})
mod <- gen$new()
t <- seq(0, 2 * pi, length.out = 101)
y <- mod$run(t, atol = 1e-8, rtol = 1e-8)
expect_identical(y[, 3L], sin(t))
expect_equal(y[, 2L], cos(t + pi), tolerance = 1e-6)
})
test_that_odin("user c", {
skip_for_target("r")
gen <- odin({
config(include) <- "user_fns.c"
z <- squarepulse(t, 1, 2)
output(z) <- z
deriv(y) <- z
initial(y) <- 0
})
mod <- gen$new()
t <- seq(0, 3, length.out = 301)
y <- mod$run(t)
expect_equal(y[, 3L], as.numeric(t >= 1 & t < 2))
cmp <- -1 + t
cmp[t < 1] <- 0
cmp[t > 2] <- 1
expect_equal(y[, 2L], cmp, tolerance = 1e-5)
})
test_that_odin("user r", {
## mrc-2027 would minimise duplication here
skip_for_target("c")
gen <- odin({
config(include) <- "user_fns.R"
z <- squarepulse(t, 1, 2)
output(z) <- z
deriv(y) <- z
initial(y) <- 0
})
mod <- gen$new()
t <- seq(0, 3, length.out = 301)
y <- mod$run(t)
expect_equal(y[, 3L], as.numeric(t >= 1 & t < 2))
cmp <- -1 + t
cmp[t < 1] <- 0
cmp[t > 2] <- 1
expect_equal(y[, 2L], cmp, tolerance = 1e-5)
})
test_that_odin("user c in subdir", {
skip_for_target("r")
dest <- tempfile()
dir.create(dest)
expr <- c('config(include) <- "myfuns.c"',
"z <- squarepulse(t, 1, 2)",
"output(z) <- z",
"deriv(y) <- z",
"initial(y) <- 0")
test <- file.path(dest, "test.R")
writeLines(expr, test)
expect_error(odin_(test), "Could not find file 'myfuns.c'",
class = "odin_error")
file.copy("user_fns.c", file.path(dest, "myfuns.c"))
gen <- odin_(test)
## copied from above:
mod <- gen$new()
t <- seq(0, 3, length.out = 301)
y <- mod$run(t)
expect_equal(y[, 3L], as.numeric(t >= 1 & t < 2))
cmp <- -1 + t
cmp[t < 1] <- 0
cmp[t > 2] <- 1
expect_equal(y[, 2L], cmp, tolerance = 1e-5)
})
test_that_odin("time dependent initial conditions", {
gen <- odin({
y1 <- cos(t)
y2 <- y1 * (1 + t)
deriv(y3) <- y2
initial(y3) <- y2
output(y1) <- y1
output(y2) <- y2
})
mod <- gen$new()
## Initial conditions get through here:
expect_equivalent(mod$initial(0), 1)
expect_equivalent(mod$initial(1), cos(1) * 2)
t <- seq(0, 4 * pi, length.out = 101)
y <- mod$run(t, atol = 1e-8, rtol = 1e-8)
expect_equal(as.vector(y[1, 2]), 1.0)
## TODO: Compute analytic expectation and compare here.
expect_equal(as.vector(y[length(t), 2]), 1.0, tolerance = 1e-7)
})
test_that_odin("time dependent initial conditions depending on vars", {
gen <- odin({
v1 <- exp(-t)
initial(y1) <- 1
deriv(y1) <- y1 * v1
deriv(y2) <- y2 * 0.5
initial(y2) <- y1 + v1
deriv(y3) <- y3 * 0.1
initial(y3) <- y1 + y2
})
mod <- gen$new()
expect_equal(mod$initial(0), c(1, 2, 3))
expect_equal(mod$initial(1), c(1, 1 + exp(-1), 2 + exp(-1)))
})
## This test case kindly contributed by @blackedder in #14
test_that_odin("unused variable in output", {
gen <- odin({
initial(S) <- N - I0
initial(E1) <- 0
initial(E2) <- 0
initial(I1) <- I0
initial(I2) <- 0
initial(R) <- 0
N <- 1e7
I0 <- 1
lambda <- 0.00001 * (I1 + I2)
gamma1 <- 2.5
gamma2 <- 1.1
deriv(S) <- -lambda * S
deriv(E1) <- lambda * S - gamma1 * E1
deriv(E2) <- gamma1 * (E1 - E2)
deriv(I1) <- gamma1 * E2 - gamma2 * I1
deriv(I2) <- gamma2 * (I1 - I2)
deriv(R) <- gamma2 * I2
output(tot) <- S + E1 + E2 + I1 + I2 + R
})
mod <- gen$new()
expect_is(mod, "odin_model")
t <- seq(0, 10, length.out = 100)
expect_error(mod$run(t), NA)
})
test_that_odin("3d array", {
gen <- odin({
initial(y[, , ]) <- 1
deriv(y[, , ]) <- y[i, j, k] * 0.1
dim(y) <- c(2, 3, 4)
})
mod <- gen$new()
expect_equal(mod$initial(0), rep(1.0, 2 * 3 * 4))
tt <- seq(0, 10, length.out = 11)
yy <- mod$run(tt)
## We now have nicely named output:
expect_match(colnames(yy)[-1], "^y\\[[0-9],[0-9],[0-9]\\]$")
## Transform for even nicer:
zz <- mod$transform_variables(yy)
expect_equal(dim(zz$y), c(c(length(tt), 2, 3, 4)))
## Check the automatic variable naming:
expect_identical(zz$y[, 1, 2, 4], yy[, "y[1,2,4]"])
## Check conversion of single row:
y0 <- mod$transform_variables(yy[1, ])
expect_equal(y0,
c(setNames(list(tt[1]), TIME), list(y = array(1, c(2, 3, 4)))))
})
test_that_odin("4d array", {
## TODO: offset_y is saved here and is not really needed.
gen <- odin({
initial(y[, , , ]) <- 1
deriv(y[, , , ]) <- y[i, j, k, l] * 0.1
dim(y) <- c(2, 3, 4, 5)
})
mod <- gen$new()
expect_equal(mod$initial(0), rep(1.0, 2 * 3 * 4 * 5))
dat <- mod$contents()
expect_equal(dat$initial_y, array(1, c(2, 3, 4, 5)))
})
## I need a system with mixed variables and arrays for testing the
## parse code. This is going to be a really stupid system!
test_that_odin("mixed", {
gen <- odin({
deriv(a) <- r * a
initial(a) <- 1
deriv(b) <- r * b
initial(b) <- 1
deriv(v[]) <- r * v[i]
initial(v[]) <- 1
dim(v) <- 3
r <- 0.1
})
mod <- gen$new()
expect_is(mod, "odin_model")
t <- seq(0, 10, length.out = 100)
y <- mod$run(t)
expect_error(y, NA) # just test that it doesn't fail
yy <- mod$transform_variables(y)
expect_equal(sort(names(yy)), sort(c(TIME, "a", "b", "v")))
## Check contents:
expect_equal(yy[c(TIME, "a", "b")],
as.list(as.data.frame(y[, c(TIME, "a", "b")])))
expect_equal(yy$v, unname(y[, sprintf("v[%d]", 1:3)]))
## Check scalar:
y0 <- mod$transform_variables(y[1, ])
expect_equal(names(y0), names(yy))
expect_equal(y0,
lapply(yy, function(x) if (is.matrix(x)) x[1, ] else x[[1]]))
})
## TODO: We're ambiguous with output dim.
##
## This would probably work but be bad:
##
## > output(y[]) <- y[i] * 2
## > dim(y) <- 10
##
## because we'd pick up dim(output(y)) as 10; most of the time this
## would be correct but sometimes might not be. The check is:
##
## disallow *array* output that is nontrivial that shares a name with
## any other variable.
## Output array
##
## (1) A new array:
test_that_odin("output array", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(r) <- 3
dim(y) <- 3
## testing below here:
output(y2[]) <- y[i] * 2
## NOTE: Not dim(output(y2)) [TODO: should we support this?]
dim(y2) <- 3 # length(y) -- TODO -- should be OK?
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
yy <- mod$run(tt)
expect_equal(colnames(yy), c("t",
sprintf("y[%d]", 1:3),
sprintf("y2[%d]", 1:3)))
## transform function:
zz <- mod$transform_variables(yy)
expect_equal(zz$y2, zz$y * 2)
})
## (2) An existing array
test_that_odin("output array", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(r) <- 3
dim(y) <- 3
## This should probably be OK, but might need some more trickery...
output(r[]) <- r
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
yy <- mod$run(tt)
expect_equal(colnames(yy), c("t",
sprintf("y[%d]", 1:3),
sprintf("r[%d]", 1:3)))
## transform function:
zz <- mod$transform_variables(yy)
expect_equal(zz$r, matrix(0.1, length(tt), 3))
})
test_that_odin("use length on rhs", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(y) <- 3
dim(r) <- length(y)
})
mod <- gen$new()
expect_equal(mod$contents()$r, rep(0.1, 3))
})
test_that_odin("use dim on rhs", {
gen <- odin({
deriv(y[, ]) <- r[i] * y[i, j]
initial(y[, ]) <- 1
r[] <- 0.1
dim(y) <- c(3, 4)
dim(r) <- dim(y, 1)
})
mod <- gen$new()
expect_equal(mod$contents()$r, rep(0.1, 3))
expect_equal(mod$contents()$initial_y, matrix(1, 3, 4))
})
## Ideally we'll end up with all combinations of has array/has scalar
## (there are 15 possible combinations though!)
test_that_odin("transform variables with output", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- y0[i]
r[] <- user()
dim(r) <- user()
dim(y) <- length(r)
y0[] <- user()
dim(y0) <- length(r)
output(a) <- sum(y)
})
y0 <- runif(3)
r <- runif(3)
mod <- gen$new(y0 = y0, r = r)
tt <- seq(0, 5, length.out = 101)
real_y <- t(y0 * exp(outer(r, tt)))
real_a <- rowSums(real_y)
y <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
yy <- mod$transform_variables(y)
expect_equal(yy$y, real_y)
expect_equal(yy$a, real_a)
})
test_that_odin("transform variables without time", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- y0[i]
r[] <- user()
dim(r) <- user()
dim(y) <- length(r)
y0[] <- user()
dim(y0) <- length(r)
output(a) <- sum(y)
})
y0 <- runif(3)
r <- runif(3)
mod <- gen$new(y0 = y0, r = r)
tt <- seq(0, 5, length.out = 101)
yy <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
cmp <- mod$transform_variables(yy)
res <- mod$transform_variables(yy[, -1])
expect_equal(names(res), names(cmp))
expect_equal(res$t, rep(NA_real_, length(tt)))
expect_equal(res[names(res) != "t"], cmp[names(cmp) != "t"])
cmp <- mod$transform_variables(yy[1, ])
res <- mod$transform_variables(yy[1, -1])
expect_equal(names(res), names(cmp))
expect_equal(res$t, NA_real_)
expect_equal(res[names(res) != "t"], cmp[names(cmp) != "t"])
expect_error(mod$transform_variables(yy[, -(1:2)]), # nolint
"Unexpected size input")
expect_error(mod$transform_variables(cbind(yy, yy)),
"Unexpected size input")
})
test_that_odin("pathalogical array index", {
gen <- odin({
deriv(z) <- y1 + y2 + y3 + y4 + y5
initial(z) <- 0
## This one is a bit of a worry, frankly - everything is off by
## one. It looks to me that the issue here is that in the
## *initial assignment* we have assigned the wrong thing. I think
## that Ada has an issue about this actually! Probably this will
## require some care on the rewrite.
y[] <- i
dim(y) <- 5
a <- length(y)
y1 <- y[a + 1 - a] # > y[1] -- first call is '-'
y2 <- y[2 - a + a] # > y[2] -- first call is '+'
y3 <- y[1 + 2] # > y[3]
y4 <- y[a - 1] # > y[4]
y5 <- y[5 + (a - a)] # > y[5]
})
dat <- gen$new()$contents()
expect_equal(dat$y1, 1.0)
expect_equal(dat$y2, 2.0)
expect_equal(dat$y3, 3.0)
expect_equal(dat$y4, 4.0)
expect_equal(dat$y5, 5.0)
})
test_that_odin("two output arrays", {
gen <- odin({
deriv(y[]) <- y[i] * r[i]
initial(y[]) <- i
dim(y) <- 3
dim(r) <- 3
r[] <- user()
output(yr[]) <- y[i] / i
dim(yr) <- 3
output(r[]) <- TRUE
})
r <- runif(3)
mod <- gen$new(r = r)
tt <- seq(0, 10, length.out = 101)
yy <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
zz <- mod$transform_variables(yy)
expect_equal(zz$y, t(1:3 * exp(outer(r, tt))), tolerance = 1e-6)
expect_equal(zz$r, matrix(r, length(tt), 3, TRUE))
expect_equal(zz$yr, t(t(zz$y) / (1:3)))
## An extension of the above that tickles an array size problem
gen2 <- odin({
deriv(y[]) <- y[i] * r[i]
initial(y[]) <- y0[i]
dim(y) <- length(y0)
dim(r) <- length(y0)
y0[] <- user()
r[] <- user()
dim(y0) <- user()
output(yr[]) <- y[i] / y0[i]
dim(yr) <- length(y0)
output(r[]) <- TRUE
})
mod2 <- gen2$new(y0 = as.numeric(1:3), r = r)
res <- mod2$run(tt, atol = 1e-8, rtol = 1e-8)
expect_equal(res, yy)
})
## TODO: This still needs harmonising with get_user_array1 functions
## (non user dimensions) as they use coerceVector still.
test_that_odin("non-numeric input", {
gen <- odin({
deriv(y) <- 1
initial(y) <- 1
scalar <- user()
vector[] <- user()
dim(vector) <- user()
matrix[, ] <- user()
dim(matrix) <- user()
array[, , ] <- user()
dim(array) <- user()
array4[, , , ] <- user()
dim(array4) <- user()
})
scalar <- 1
vector <- as.numeric(1:3)
matrix <- matrix(as.numeric(1:prod(2:3)), 2L, 3L)
array <- array(as.numeric(1:prod(2:4)), c(2L, 3L, 4L))
array4 <- array(as.numeric(1:prod(2:5)), c(2L, 3L, 4L, 5L))
convert <- function(x, to = "integer") {
storage.mode(x) <- to
if (to == "character") {
x[] <- paste(x, "number")
}
x
}
## First, this is all easy and has been well tested already:
mod <- gen$new(scalar = scalar,
vector = vector,
matrix = matrix,
array = array,
array4 = array4)
dat <- mod$contents()
expect_equal(dat$scalar, scalar)
expect_equal(dat$vector, vector)
expect_equal(dat$matrix, matrix)
expect_equal(dat$array, array)
expect_equal(dat$array4, array4)
## Then to integer first:
mod <- gen$new(scalar = convert(scalar),
vector = convert(vector),
matrix = convert(matrix),
array = convert(array),
array4 = convert(array4))
dat <- mod$contents()
expect_equal(dat$scalar, scalar)
expect_equal(dat$vector, vector)
expect_equal(dat$matrix, matrix)
expect_equal(dat$array, array)
expect_equal(dat$array4, array4)
## Then test for errors on each as we convert to character:
expect_error(
gen$new(scalar = convert(scalar, "character"),
vector = vector,
matrix = matrix,
array = array,
array4 = array4),
"Expected a numeric value for 'scalar'")
expect_error(
gen$new(scalar = scalar,
vector = convert(vector, "character"),
matrix = matrix,
array = array,
array4 = array4),
"Expected a numeric value for 'vector'")
expect_error(
gen$new(scalar = scalar,
vector = vector,
matrix = convert(matrix, "character"),
array = array,
array4 = array4),
"Expected a numeric value for 'matrix'")
expect_error(
gen$new(scalar = scalar,
vector = vector,
matrix = matrix,
array = convert(array, "character"),
array4 = array4),
"Expected a numeric value for 'array'")
expect_error(
gen$new(scalar = scalar,
vector = vector,
matrix = matrix,
array = array,
array4 = convert(array4, "character")),
"Expected a numeric value for 'array4'")
})
test_that_odin("only used in output", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(r) <- 3
dim(y) <- 3
## output only:
tot <- sum(y)
output(ytot) <- tot
output(y2[]) <- y[i] * 2
dim(y2) <- length(y)
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
res <- mod$transform_variables(mod$run(tt))
expect_equal(res$ytot, rowSums(res$y))
expect_equal(res$y2, res$y * 2)
})
test_that_odin("overlapping graph", {
gen <- odin({
deriv(y) <- y * p
initial(y) <- 1
r <- -0.5
p <- r * sqrt(t) # used in both deriv and output
p2 <- p * 2 # used in output only
output(p3) <- p + p2
}, verbose = FALSE)
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
f <- function(t, y, p) {
r <- -0.5
p <- r * sqrt(t)
p2 <- p * 2
list(y * p, p + p2)
}
cmp <- deSolve::ode(1, tt, f, NULL)
expect_equivalent(mod$run(tt), cmp)
})
test_that_odin("sum over one dimension", {
## This does rowSums / colSums and will be important for building up
## towards a general sum.
gen <- odin({
deriv(y) <- 0
initial(y) <- 1
m[, ] <- user()
dim(m) <- user()
v1[] <- sum(m[i, ])
dim(v1) <- dim(m, 1)
v2[] <- sum(m[, i])
dim(v2) <- dim(m, 2)
v3[] <- sum(m[i, 2:4])
dim(v3) <- length(v1)
v4[] <- sum(m[2:4, i])
dim(v4) <- length(v2)
tot1 <- sum(m)
tot2 <- sum(m[, ])
})
nr <- 5
nc <- 7
m <- matrix(runif(nr * nc), nr, nc)
dat <- gen$new(m = m)$contents()
expect_equal(dat$m, m)
expect_equal(dat$v1, rowSums(m))
expect_equal(dat$v2, colSums(m))
expect_equal(dat$v3, rowSums(m[, 2:4]))
expect_equal(dat$v4, colSums(m[2:4, ]))
expect_equal(dat$tot1, sum(m))
expect_equal(dat$tot2, sum(m))
})
test_that_odin("sum over two dimensions", {
## This is where things get a bit more horrid:
gen <- odin({
deriv(y) <- 0
initial(y) <- 1
a[, , ] <- user()
dim(a) <- user()
## These collapse one dimension
m12[, ] <- sum(a[i, j, ])
m13[, ] <- sum(a[i, , j])
m23[, ] <- sum(a[, i, j])
dim(m12) <- c(dim(a, 1), dim(a, 2))
dim(m13) <- c(dim(a, 1), dim(a, 3))
dim(m23) <- c(dim(a, 2), dim(a, 3))
## These collapse two dimensions
v1[] <- sum(a[i, , ])
v2[] <- sum(a[, i, ])
v3[] <- sum(a[, , i])
dim(v1) <- dim(a, 1)
dim(v2) <- dim(a, 2)
dim(v3) <- dim(a, 3)
mm12[, ] <- sum(a[i, j, 2:4])
mm13[, ] <- sum(a[i, 2:4, j])
mm23[, ] <- sum(a[2:4, i, j])
## TODO: dim(mm12) <- dim(m12) will not work, but that would be nice
dim(mm12) <- c(dim(a, 1), dim(a, 2))
dim(mm13) <- c(dim(a, 1), dim(a, 3))
dim(mm23) <- c(dim(a, 2), dim(a, 3))
vv1[] <- sum(a[i, 2:4, 2:4])
vv2[] <- sum(a[2:4, i, 2:4])
vv3[] <- sum(a[2:4, 2:4, i])
dim(vv1) <- dim(a, 1)
dim(vv2) <- dim(a, 2)
dim(vv3) <- dim(a, 3)
tot1 <- sum(a)
tot2 <- sum(a[, , ])
})
nr <- 5
nc <- 7
nz <- 9
a <- array(runif(nr * nc * nz), c(nr, nc, nz))
dat <- gen$new(a = a)$contents()
expect_equal(dat$a, a)
expect_equal(dat$m12, apply(a, 1:2, sum))
expect_equal(dat$m13, apply(a, c(1, 3), sum))
expect_equal(dat$m23, apply(a, 2:3, sum))
expect_equal(dat$v1, apply(a, 1, sum))
expect_equal(dat$v2, apply(a, 2, sum))
expect_equal(dat$v3, apply(a, 3, sum))
expect_equal(dat$mm12, apply(a[, , 2:4], 1:2, sum))
expect_equal(dat$mm13, apply(a[, 2:4, ], c(1, 3), sum))
expect_equal(dat$mm23, apply(a[2:4, , ], 2:3, sum))
expect_equal(dat$vv1, apply(a[, 2:4, 2:4], 1, sum))
expect_equal(dat$vv2, apply(a[2:4, , 2:4], 2, sum))
expect_equal(dat$vv3, apply(a[2:4, 2:4, ], 3, sum))
expect_equal(dat$tot1, sum(a))
expect_equal(dat$tot2, sum(a))
})
test_that_odin("sum for a 4d array", {
## I don't want to check absolutely everything here, so hopefully if
## these few go OK then given the more exhaustive tests above we'll
## be OK
gen <- odin({
deriv(y) <- 0
initial(y) <- 1
a[, , , ] <- user()
dim(a) <- user()
m12[, ] <- sum(a[i, j, , ])
m23[, ] <- sum(a[, i, j, ])
m24[, ] <- sum(a[, i, , j])
dim(m12) <- c(dim(a, 1), dim(a, 2))
dim(m23) <- c(dim(a, 2), dim(a, 3))
dim(m24) <- c(dim(a, 2), dim(a, 4))
tot1 <- sum(a)
tot2 <- sum(a[, , , ])
})
dim <- c(3, 5, 7, 9)
a <- array(runif(prod(dim)), dim)
dat <- gen$new(a = a)$contents()
expect_equal(dat$a, a)
expect_equal(dat$m12, apply(a, 1:2, sum))
expect_equal(dat$m23, apply(a, c(2, 3), sum))
expect_equal(dat$m24, apply(a, c(2, 4), sum))
})
test_that_odin("sum initial condition from initial condition", {
gen <- odin({
update(a[, ]) <- 1
update(b) <- 1
initial(a[, ]) <- 1
initial(b) <- n
n <- sum(a[1, ])
dim(a) <- c(10, 10)
})
expect_equal(gen$new()$initial(0), c(10, rep(1, 100)))
})
test_that_odin("another initial condition failure", {
gen <- odin({
deriv(a[]) <- 1
deriv(b) <- 1
initial(a[]) <- 1
initial(b) <- n
n <- sum(a)
dim(a) <- 10
})
expect_equal(gen$new()$initial(0), c(10, rep(1, 10)))
})
test_that_odin("self output for scalar", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
x <- t
output(x) <- TRUE
})
tt <- seq(0, 10, length.out = 11)
expect_equal(gen$new()$run(tt)[, "x"], tt)
})
test_that_odin("non-time sentsitive output", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
x <- 1
output(x) <- TRUE
})
tt <- seq(0, 10, length.out = 11)
expect_equal(gen$new()$run(tt)[, "x"], rep(1, length(tt)))
})
test_that_odin("logical operations", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
## These ones are easy
output(x1) <- t > 1 && t < 3
output(x2) <- t > 1 || t < 3
## These ones may differ; note that parens are suggested by the
## compiler for this line.
output(x3) <- t > 8 || t > 1 && t < 3 # should equal x4
output(x4) <- t > 8 || (t > 1 && t < 3)
output(x5) <- (t > 8 || t > 1) && t < 3
}, compiler_warnings = FALSE)
t <- seq(0, 10, length.out = 101)
y <- gen$new()$run(t)
expect_equal(y[, "x1"], as.numeric(t > 1 & t < 3))
expect_equal(y[, "x2"], as.numeric(t > 1 | t < 3))
expect_equal(y[, "x3"], as.numeric(t > 8 | t > 1 & t < 3))
expect_equal(y[, "x4"], as.numeric(t > 8 | (t > 1 & t < 3)))
expect_equal(y[, "x5"], as.numeric((t > 8 | t > 1) & t < 3))
})
## This is for issue #44, needed to support Neil's model. I don't
## know how useful this is going to be. I'll see if we can get away
## with this for now, and then go through and see if we can detect if
## a number is an integer thing because it's only used within indexes.
test_that_odin("integer vector", {
## We expect 'idx' to come through as an integer
gen <- odin({
x[] <- user()
dim(x) <- user()
idx[] <- user()
dim(idx) <- user()
initial(v[]) <- x[idx[i]] # TODO: fixme
deriv(v[]) <- 0
dim(v) <- length(x)
})
set.seed(1)
idx <- sample(15)
x <- runif(length(idx))
mod <- gen$new(x = x, idx = idx)
dat <- mod$contents()
expect_equal(dat$idx, idx)
expect_equal(dat$initial_v, x[idx])
expect_equal(ir_deserialise(mod$ir())$data$elements$idx$storage_type,
"int")
})
## This is much closer to the test case needed for Neil's model
test_that_odin("integer matrix", {
gen <- odin({
x[] <- user()
dim(x) <- user()
idx[, ] <- user()
dim(idx) <- c(length(x), 3)
v[] <- x[idx[i, 1]] + x[idx[i, 2]] + x[idx[i, 3]]
dim(v) <- length(x)
initial(z) <- 1
deriv(z) <- 0
})
x <- runif(10)
idx <- matrix(sample(length(x), length(x) * 3, replace = TRUE), length(x), 3)
## This is what the code should expand to:
v <- x[idx[, 1]] + x[idx[, 2]] + x[idx[, 3]]
mod <- gen$new(x = x, idx = idx)
expect_equal(mod$contents()$v, v)
expect_equal(ir_deserialise(mod$ir())$data$elements$idx$storage_type,
"int")
})
test_that_odin("c in dim for vector", {
## This is a regression test for issue #61
gen <- odin({
initial(x[]) <- 1
deriv(x[]) <- 0
dim(x) <- c(5)
})
mod <- gen$new()
expect_equal(mod$contents()$initial_x, rep(1.0, 5))
})
test_that_odin("user variable information", {
gen <- odin({
deriv(N) <- r[1] * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- user(100)
r[] <- user()
dim(r) <- 1
})
info <- coef(gen)
expect_is(info, "data.frame")
expect_equal(info$has_default, c(FALSE, TRUE, TRUE))
expect_equal(info$rank, c(1L, 0L, 0L))
expect_identical(coef(gen$new(r = 1)), info)
})
test_that_odin("user variable information - when no user", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- 10
K <- 100
r <- 0.1
})
info <- coef(gen)
cmp <- data.frame(name = character(),
has_default = logical(),
default_value = I(list()),
rank = integer(),
min = numeric(),
max = numeric(),
integer = logical(),
stringsAsFactors = FALSE)
expect_identical(info, cmp)
expect_identical(coef(gen$new()), cmp)
})
test_that_odin("multiline string", {
## Literal multiline string:
gen <- odin(c("deriv(y) <- 0.5", "initial(y) <- 1"))
expect_is(gen$new(), "odin_model")
})
## This is basically all ok but what is still not great is _doing_ the
## validation.
test_that_odin("user integer", {
gen <- odin({
deriv(y) <- 0.5
initial(y) <- y0
y0 <- user(1, integer = TRUE, min = 0)
})
expect_error(gen$new(y0 = 1.5), "Expected 'y0' to be integer-like")
expect_error(gen$new(y0 = -1L), "Expected 'y0' to be at least 0")
expect_error(mod <- gen$new(y0 = 1), NA)
expect_equal(mod$run(0:10)[, "y"], 1.0 + 0.5 * (0:10))
})
test_that_odin("multiple constraints", {
gen <- odin({
deriv(y) <- r
initial(y) <- y0
y0 <- user(1, min = 0)
r <- user(0.5, max = 10)
})
expect_error(gen$new(y0 = -1L), "Expected 'y0' to be at least 0")
expect_error(gen$new(r = 100), "Expected 'r' to be at most 10")
})
test_that_odin("set_user honours constraints", {
gen <- odin({
deriv(y) <- r
initial(y) <- y0
y0 <- user(1, min = 0)
r <- user(0.5, max = 10)
})
mod <- gen$new()
expect_error(mod$set_user(y0 = -1L), "Expected 'y0' to be at least 0")
expect_error(mod$set_user(r = 100), "Expected 'r' to be at most 10")
})
test_that_odin("user sized dependent variables are allowed", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- user()
dim(r) <- user()
dim(y) <- length(r)
})
r <- runif(3)
mod <- gen$new(r = r)
expect_identical(mod$contents()$r, r)
expect_identical(mod$contents()$initial_y, rep(1.0, length(r)))
})
test_that_odin("user parameter validation", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- user()
})
## Honour all the options:
expect_error(
gen$new(user = list(r = 1, a = 1), unused_user_action = "stop"),
"Unknown user parameters: a")
expect_warning(
gen$new(user = list(r = 1, a = 1), unused_user_action = "warning"),
"Unknown user parameters: a")
expect_message(
gen$new(user = list(r = 1, a = 1), unused_user_action = "message"),
"Unknown user parameters: a")
expect_silent(
gen$new(user = list(r = 1, a = 1), unused_user_action = "ignore"))
## Sensible error message for invalid option
expect_error(
gen$new(user = list(r = 1, a = 1), unused_user_action = "other"),
"Unknown user parameters: a (and invalid value for unused_user_action)",
fixed = TRUE)
## Inherit action from option
with_options(
list(odin.unused_user_action = "message"),
expect_message(
gen$new(user = list(r = 1, a = 1)),
"Unknown user parameters: a"))
## Override option
with_options(
list(odin.unused_user_action = "message"),
expect_error(
gen$new(user = list(r = 1, a = 1), unused_user_action = "error"),
"Unknown user parameters: a"))
## System default:
with_options(
list(odin.unused_user_action = NULL),
expect_warning(
gen$new(user = list(r = 1, a = 1)),
"Unknown user parameters: a"))
## set_user:
mod <- gen$new(r = 1)
expect_silent(
mod$set_user(user = list(x = 1), unused_user_action = "ignore"))
expect_error(
mod$set_user(user = list(x = 1), unused_user_action = "error"),
"Unknown user parameters: x")
})
test_that_odin("sum over integer", {
gen <- odin({
x[] <- user()
dim(x) <- user()
idx[] <- user()
dim(idx) <- user()
initial(v[]) <- x[idx[i]]
update(v[]) <- sum(idx)
dim(v) <- length(x)
})
set.seed(1)
idx <- sample(15)
x <- runif(length(idx))
mod <- gen$new(x = x, idx = idx)
dat <- mod$contents()
expect_equal(dat$idx, idx)
expect_equal(dat$initial_v, x[idx])
expect_equal(mod$update(0, mod$initial(0)),
rep(sum(idx), 15))
})
test_that_odin("force integer on use", {
gen <- odin({
vec[] <- i
dim(vec) <- 2
idx <- if (t > 5) 2 else 1
deriv(x) <- vec[as.integer(idx)]
initial(x) <- 0
})
mod <- gen$new()
t <- seq(0, 10, length.out = 101)
y <- mod$run(t, atol = 1e-9, rtol = 1e-9)
expect_equal(y[, 2], ifelse(t <= 5, t, 2 * t - 5))
})
test_that_odin("force integer on a numeric vector truncates", {
gen <- odin({
vec[] <- i
dim(vec) <- 10
idx <- user()
initial(x) <- vec[as.integer(idx)]
deriv(x) <- 0
})
expect_equal(gen$new(idx = 1.5)$initial(0), 1)
expect_equal(gen$new(idx = 3 - 1e-8)$initial(0), 2)
expect_equal(gen$new(idx = 3 + 1e-8)$initial(0), 3)
})
test_that_odin("user c functions can be passed arrays and indexes", {
skip_for_target("r")
gen <- odin({
config(include) <- "user_fns4.c"
n <- 5
x[] <- user()
y[] <- f(i, x)
dim(x) <- n
dim(y) <- n
output(y) <- TRUE
initial(a) <- 0
deriv(a) <- 0
})
x <- runif(5)
mod <- gen$new(user = list(x = x))
y <- mod$run(c(0, 1))
expect_equal(mod$transform_variables(y[2, ])$y, cumsum(x))
})
test_that_odin("self output for scalar: rewrite corner case", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
x <- 2 + 5
output(x) <- TRUE
})
tt <- seq(0, 10, length.out = 11)
expect_equal(gen$new()$run(tt)[, "x"], rep(7, 11))
})
test_that_odin("deprecation warning finds used constructor name", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- 2
config(base) <- "mymodel"
})
expect_warning(gen(), "'gen(...)' is deprecated", fixed = TRUE)
expect_warning(local(gen()), "'gen(...)' is deprecated", fixed = TRUE)
expect_silent(gen$new())
})
test_that_odin("deprecation warning falls back on base name", {
code <- c("deriv(y) <- r",
"initial(y) <- 1",
"r <- 2",
"config(base) <- 'mymodel'")
expect_warning(odin_(code)(), "'mymodel(...)' is deprecated",
fixed = TRUE)
expect_silent(odin_(code)$new())
})
Try the odin package in your browser
Any scripts or data that you put into this service are public.
odin documentation built on Oct. 2, 2023, 5:07 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("run: general")
## TODO: these should be split up eventually
## Tests of the approach against some known models.
test_that_odin("constant model", {
gen <- odin({
deriv(y) <- 0.5
initial(y) <- 1
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 11)
yy <- mod$run(tt)
expect_equal(yy[, 2L], seq(1.0, length.out = length(tt), by = 0.5))
## Can avoid having column names:
expect_null(colnames(mod$run(tt, use_names = FALSE)))
})
test_that_odin("user variables", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- user(100)
r <- user()
})
## Two different errors when r is not provided:
expect_error(gen$new(), "Expected a value for 'r'")
expect_error(gen$new(r = NULL), "Expected a value for 'r'")
mod <- gen$new(r = pi)
dat <- mod$contents()
expect_equal(dat$r, pi)
expect_equal(dat$N0, 1.0)
expect_equal(dat$K, 100.0)
## This should be a noop:
mod$set_user()
dat <- mod$contents()
expect_equal(dat$r, pi)
expect_equal(dat$N0, 1.0)
expect_equal(dat$K, 100.0)
## Now, try setting one of these:
mod$set_user(N0 = 5)
dat <- mod$contents()
expect_equal(dat$r, pi)
expect_equal(dat$N0, 5.0)
expect_equal(dat$K, 100.0)
## Don't reset to default on subsequent set:
mod$set_user()
expect_equal(mod$contents()$N0, 5.0)
})
test_that_odin("user variables on models with none", {
gen <- odin::odin({
a <- 1
deriv(y) <- 0.5 * a
initial(y) <- 1
})
mod <- gen$new()
## NOTE: This is a change of behaviour, but that's probably OK
expect_silent(mod$set_user())
expect_warning(mod$set_user(a = 1), "Unknown user parameters: a")
})
test_that_odin("non-numeric time", {
## Only an issue for delay models or models with time-dependent
## initial conditions.
gen <- odin({
ylag <- delay(y, 10)
initial(y) <- 0.5
deriv(y) <- 0.2 * ylag * 1 / (1 + ylag^10) - 0.1 * y
})
mod <- gen$new()
t <- as.integer(0:10)
expect_equal(mod$initial(t[1]), 0.5)
expect_silent(mod$run(t))
})
test_that_odin("delays and initial conditions", {
gen <- odin({
ylag <- delay(y, 10)
initial(y) <- 0.5
deriv(y) <- 0.2 * ylag * 1 / (1 + ylag^10) - 0.1 * y
})
mod <- gen$new()
t <- as.integer(0:10)
res1 <- mod$run(t)
dat <- mod$contents()
expect_equal(dat$initial_t, 0.0)
expect_equal(dat$initial_y, 0.5)
res2 <- mod$run(t + 1)
expect_equal(res2[, 2], res1[, 2])
expect_equal(mod$contents()$initial_t, 1.0)
## Trickier; pass the initial conditions through and have them set
## into the model so delays work correctly.
res3 <- mod$run(t + 2, 0.5)
expect_equal(res3[, 2], res1[, 2], tolerance = 1e-7)
expect_equal(mod$contents()$initial_t, 2.0)
expect_equal(mod$contents()$initial_y, 0.5)
res4 <- mod$run(t + 3, 0.6)
expect_equal(mod$contents()$initial_t, 3.0)
expect_equal(mod$contents()$initial_y, 0.6)
expect_false(isTRUE(all.equal(res4[, 2], res1[, 2])))
})
test_that_odin("non-numeric user", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- user(100)
r <- user()
})
mod <- gen$new(r = 1L)
expect_is(mod$contents()$r, "numeric")
expect_identical(mod$contents()$r, 1.0)
})
test_that_odin("conditionals", {
gen <- odin({
deriv(x) <- if (x > 2) 0 else 0.5
initial(x) <- 0
})
## Hey ho it works:
mod <- gen$new()
t <- seq(0, 5, length.out = 101)
y <- mod$run(t)
expect_equal(y[, 2], ifelse(t < 4, t * 0.5, 2.0), tolerance = 1e-5)
})
test_that_odin("conditionals, precendence", {
gen <- odin({
deriv(x) <- 0.1 + 2 * if (t > 2) -0.1 else 0.5
initial(x) <- 0
})
mod <- gen$new()
t <- seq(0, 5, length.out = 101)
y <- mod$run(t)
cmp <- ifelse(t < 2, 1.1 * t, 2.4 - 0.1 * t)
expect_equal(y[, 2], cmp, tolerance = 1e-5)
})
test_that_odin("time dependent", {
## A time dependent initial condition:
gen_t <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- sqrt(t) + 1
K <- 100
r <- 0.5
})
## The same model, but taking N0 as a user parameter.
gen_cmp <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user()
K <- 100
r <- 0.5
})
mod_t <- gen_t$new()
expect_equal(mod_t$initial(0), 1)
expect_equal(mod_t$initial(10), sqrt(10) + 1)
t0 <- seq(0, 10, length.out = 101)
t1 <- seq(10, 20, length.out = 101)
expect_equal(mod_t$run(t0), gen_cmp$new(N0 = sqrt(t0[[1]]) + 1)$run(t0))
expect_equal(mod_t$run(t1), gen_cmp$new(N0 = sqrt(t1[[1]]) + 1)$run(t1))
})
test_that_odin("time dependent initial conditions", {
gen <- odin({
y1 <- sin(t)
deriv(y2) <- y1
initial(y2) <- -1
output(y1) <- y1
})
mod <- gen$new()
t <- seq(0, 2 * pi, length.out = 101)
y <- mod$run(t, atol = 1e-8, rtol = 1e-8)
expect_identical(y[, 3L], sin(t))
expect_equal(y[, 2L], cos(t + pi), tolerance = 1e-6)
})
test_that_odin("user c", {
skip_for_target("r")
gen <- odin({
config(include) <- "user_fns.c"
z <- squarepulse(t, 1, 2)
output(z) <- z
deriv(y) <- z
initial(y) <- 0
})
mod <- gen$new()
t <- seq(0, 3, length.out = 301)
y <- mod$run(t)
expect_equal(y[, 3L], as.numeric(t >= 1 & t < 2))
cmp <- -1 + t
cmp[t < 1] <- 0
cmp[t > 2] <- 1
expect_equal(y[, 2L], cmp, tolerance = 1e-5)
})
test_that_odin("user r", {
## mrc-2027 would minimise duplication here
skip_for_target("c")
gen <- odin({
config(include) <- "user_fns.R"
z <- squarepulse(t, 1, 2)
output(z) <- z
deriv(y) <- z
initial(y) <- 0
})
mod <- gen$new()
t <- seq(0, 3, length.out = 301)
y <- mod$run(t)
expect_equal(y[, 3L], as.numeric(t >= 1 & t < 2))
cmp <- -1 + t
cmp[t < 1] <- 0
cmp[t > 2] <- 1
expect_equal(y[, 2L], cmp, tolerance = 1e-5)
})
test_that_odin("user c in subdir", {
skip_for_target("r")
dest <- tempfile()
dir.create(dest)
expr <- c('config(include) <- "myfuns.c"',
"z <- squarepulse(t, 1, 2)",
"output(z) <- z",
"deriv(y) <- z",
"initial(y) <- 0")
test <- file.path(dest, "test.R")
writeLines(expr, test)
expect_error(odin_(test), "Could not find file 'myfuns.c'",
class = "odin_error")
file.copy("user_fns.c", file.path(dest, "myfuns.c"))
gen <- odin_(test)
## copied from above:
mod <- gen$new()
t <- seq(0, 3, length.out = 301)
y <- mod$run(t)
expect_equal(y[, 3L], as.numeric(t >= 1 & t < 2))
cmp <- -1 + t
cmp[t < 1] <- 0
cmp[t > 2] <- 1
expect_equal(y[, 2L], cmp, tolerance = 1e-5)
})
test_that_odin("time dependent initial conditions", {
gen <- odin({
y1 <- cos(t)
y2 <- y1 * (1 + t)
deriv(y3) <- y2
initial(y3) <- y2
output(y1) <- y1
output(y2) <- y2
})
mod <- gen$new()
## Initial conditions get through here:
expect_equivalent(mod$initial(0), 1)
expect_equivalent(mod$initial(1), cos(1) * 2)
t <- seq(0, 4 * pi, length.out = 101)
y <- mod$run(t, atol = 1e-8, rtol = 1e-8)
expect_equal(as.vector(y[1, 2]), 1.0)
## TODO: Compute analytic expectation and compare here.
expect_equal(as.vector(y[length(t), 2]), 1.0, tolerance = 1e-7)
})
test_that_odin("time dependent initial conditions depending on vars", {
gen <- odin({
v1 <- exp(-t)
initial(y1) <- 1
deriv(y1) <- y1 * v1
deriv(y2) <- y2 * 0.5
initial(y2) <- y1 + v1
deriv(y3) <- y3 * 0.1
initial(y3) <- y1 + y2
})
mod <- gen$new()
expect_equal(mod$initial(0), c(1, 2, 3))
expect_equal(mod$initial(1), c(1, 1 + exp(-1), 2 + exp(-1)))
})
## This test case kindly contributed by @blackedder in #14
test_that_odin("unused variable in output", {
gen <- odin({
initial(S) <- N - I0
initial(E1) <- 0
initial(E2) <- 0
initial(I1) <- I0
initial(I2) <- 0
initial(R) <- 0
N <- 1e7
I0 <- 1
lambda <- 0.00001 * (I1 + I2)
gamma1 <- 2.5
gamma2 <- 1.1
deriv(S) <- -lambda * S
deriv(E1) <- lambda * S - gamma1 * E1
deriv(E2) <- gamma1 * (E1 - E2)
deriv(I1) <- gamma1 * E2 - gamma2 * I1
deriv(I2) <- gamma2 * (I1 - I2)
deriv(R) <- gamma2 * I2
output(tot) <- S + E1 + E2 + I1 + I2 + R
})
mod <- gen$new()
expect_is(mod, "odin_model")
t <- seq(0, 10, length.out = 100)
expect_error(mod$run(t), NA)
})
test_that_odin("3d array", {
gen <- odin({
initial(y[, , ]) <- 1
deriv(y[, , ]) <- y[i, j, k] * 0.1
dim(y) <- c(2, 3, 4)
})
mod <- gen$new()
expect_equal(mod$initial(0), rep(1.0, 2 * 3 * 4))
tt <- seq(0, 10, length.out = 11)
yy <- mod$run(tt)
## We now have nicely named output:
expect_match(colnames(yy)[-1], "^y\\[[0-9],[0-9],[0-9]\\]$")
## Transform for even nicer:
zz <- mod$transform_variables(yy)
expect_equal(dim(zz$y), c(c(length(tt), 2, 3, 4)))
## Check the automatic variable naming:
expect_identical(zz$y[, 1, 2, 4], yy[, "y[1,2,4]"])
## Check conversion of single row:
y0 <- mod$transform_variables(yy[1, ])
expect_equal(y0,
c(setNames(list(tt[1]), TIME), list(y = array(1, c(2, 3, 4)))))
})
test_that_odin("4d array", {
## TODO: offset_y is saved here and is not really needed.
gen <- odin({
initial(y[, , , ]) <- 1
deriv(y[, , , ]) <- y[i, j, k, l] * 0.1
dim(y) <- c(2, 3, 4, 5)
})
mod <- gen$new()
expect_equal(mod$initial(0), rep(1.0, 2 * 3 * 4 * 5))
dat <- mod$contents()
expect_equal(dat$initial_y, array(1, c(2, 3, 4, 5)))
})
## I need a system with mixed variables and arrays for testing the
## parse code. This is going to be a really stupid system!
test_that_odin("mixed", {
gen <- odin({
deriv(a) <- r * a
initial(a) <- 1
deriv(b) <- r * b
initial(b) <- 1
deriv(v[]) <- r * v[i]
initial(v[]) <- 1
dim(v) <- 3
r <- 0.1
})
mod <- gen$new()
expect_is(mod, "odin_model")
t <- seq(0, 10, length.out = 100)
y <- mod$run(t)
expect_error(y, NA) # just test that it doesn't fail
yy <- mod$transform_variables(y)
expect_equal(sort(names(yy)), sort(c(TIME, "a", "b", "v")))
## Check contents:
expect_equal(yy[c(TIME, "a", "b")],
as.list(as.data.frame(y[, c(TIME, "a", "b")])))
expect_equal(yy$v, unname(y[, sprintf("v[%d]", 1:3)]))
## Check scalar:
y0 <- mod$transform_variables(y[1, ])
expect_equal(names(y0), names(yy))
expect_equal(y0,
lapply(yy, function(x) if (is.matrix(x)) x[1, ] else x[[1]]))
})
## TODO: We're ambiguous with output dim.
##
## This would probably work but be bad:
##
## > output(y[]) <- y[i] * 2
## > dim(y) <- 10
##
## because we'd pick up dim(output(y)) as 10; most of the time this
## would be correct but sometimes might not be. The check is:
##
## disallow *array* output that is nontrivial that shares a name with
## any other variable.
## Output array
##
## (1) A new array:
test_that_odin("output array", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(r) <- 3
dim(y) <- 3
## testing below here:
output(y2[]) <- y[i] * 2
## NOTE: Not dim(output(y2)) [TODO: should we support this?]
dim(y2) <- 3 # length(y) -- TODO -- should be OK?
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
yy <- mod$run(tt)
expect_equal(colnames(yy), c("t",
sprintf("y[%d]", 1:3),
sprintf("y2[%d]", 1:3)))
## transform function:
zz <- mod$transform_variables(yy)
expect_equal(zz$y2, zz$y * 2)
})
## (2) An existing array
test_that_odin("output array", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(r) <- 3
dim(y) <- 3
## This should probably be OK, but might need some more trickery...
output(r[]) <- r
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
yy <- mod$run(tt)
expect_equal(colnames(yy), c("t",
sprintf("y[%d]", 1:3),
sprintf("r[%d]", 1:3)))
## transform function:
zz <- mod$transform_variables(yy)
expect_equal(zz$r, matrix(0.1, length(tt), 3))
})
test_that_odin("use length on rhs", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(y) <- 3
dim(r) <- length(y)
})
mod <- gen$new()
expect_equal(mod$contents()$r, rep(0.1, 3))
})
test_that_odin("use dim on rhs", {
gen <- odin({
deriv(y[, ]) <- r[i] * y[i, j]
initial(y[, ]) <- 1
r[] <- 0.1
dim(y) <- c(3, 4)
dim(r) <- dim(y, 1)
})
mod <- gen$new()
expect_equal(mod$contents()$r, rep(0.1, 3))
expect_equal(mod$contents()$initial_y, matrix(1, 3, 4))
})
## Ideally we'll end up with all combinations of has array/has scalar
## (there are 15 possible combinations though!)
test_that_odin("transform variables with output", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- y0[i]
r[] <- user()
dim(r) <- user()
dim(y) <- length(r)
y0[] <- user()
dim(y0) <- length(r)
output(a) <- sum(y)
})
y0 <- runif(3)
r <- runif(3)
mod <- gen$new(y0 = y0, r = r)
tt <- seq(0, 5, length.out = 101)
real_y <- t(y0 * exp(outer(r, tt)))
real_a <- rowSums(real_y)
y <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
yy <- mod$transform_variables(y)
expect_equal(yy$y, real_y)
expect_equal(yy$a, real_a)
})
test_that_odin("transform variables without time", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- y0[i]
r[] <- user()
dim(r) <- user()
dim(y) <- length(r)
y0[] <- user()
dim(y0) <- length(r)
output(a) <- sum(y)
})
y0 <- runif(3)
r <- runif(3)
mod <- gen$new(y0 = y0, r = r)
tt <- seq(0, 5, length.out = 101)
yy <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
cmp <- mod$transform_variables(yy)
res <- mod$transform_variables(yy[, -1])
expect_equal(names(res), names(cmp))
expect_equal(res$t, rep(NA_real_, length(tt)))
expect_equal(res[names(res) != "t"], cmp[names(cmp) != "t"])
cmp <- mod$transform_variables(yy[1, ])
res <- mod$transform_variables(yy[1, -1])
expect_equal(names(res), names(cmp))
expect_equal(res$t, NA_real_)
expect_equal(res[names(res) != "t"], cmp[names(cmp) != "t"])
expect_error(mod$transform_variables(yy[, -(1:2)]), # nolint
"Unexpected size input")
expect_error(mod$transform_variables(cbind(yy, yy)),
"Unexpected size input")
})
test_that_odin("pathalogical array index", {
gen <- odin({
deriv(z) <- y1 + y2 + y3 + y4 + y5
initial(z) <- 0
## This one is a bit of a worry, frankly - everything is off by
## one. It looks to me that the issue here is that in the
## *initial assignment* we have assigned the wrong thing. I think
## that Ada has an issue about this actually! Probably this will
## require some care on the rewrite.
y[] <- i
dim(y) <- 5
a <- length(y)
y1 <- y[a + 1 - a] # > y[1] -- first call is '-'
y2 <- y[2 - a + a] # > y[2] -- first call is '+'
y3 <- y[1 + 2] # > y[3]
y4 <- y[a - 1] # > y[4]
y5 <- y[5 + (a - a)] # > y[5]
})
dat <- gen$new()$contents()
expect_equal(dat$y1, 1.0)
expect_equal(dat$y2, 2.0)
expect_equal(dat$y3, 3.0)
expect_equal(dat$y4, 4.0)
expect_equal(dat$y5, 5.0)
})
test_that_odin("two output arrays", {
gen <- odin({
deriv(y[]) <- y[i] * r[i]
initial(y[]) <- i
dim(y) <- 3
dim(r) <- 3
r[] <- user()
output(yr[]) <- y[i] / i
dim(yr) <- 3
output(r[]) <- TRUE
})
r <- runif(3)
mod <- gen$new(r = r)
tt <- seq(0, 10, length.out = 101)
yy <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
zz <- mod$transform_variables(yy)
expect_equal(zz$y, t(1:3 * exp(outer(r, tt))), tolerance = 1e-6)
expect_equal(zz$r, matrix(r, length(tt), 3, TRUE))
expect_equal(zz$yr, t(t(zz$y) / (1:3)))
## An extension of the above that tickles an array size problem
gen2 <- odin({
deriv(y[]) <- y[i] * r[i]
initial(y[]) <- y0[i]
dim(y) <- length(y0)
dim(r) <- length(y0)
y0[] <- user()
r[] <- user()
dim(y0) <- user()
output(yr[]) <- y[i] / y0[i]
dim(yr) <- length(y0)
output(r[]) <- TRUE
})
mod2 <- gen2$new(y0 = as.numeric(1:3), r = r)
res <- mod2$run(tt, atol = 1e-8, rtol = 1e-8)
expect_equal(res, yy)
})
## TODO: This still needs harmonising with get_user_array1 functions
## (non user dimensions) as they use coerceVector still.
test_that_odin("non-numeric input", {
gen <- odin({
deriv(y) <- 1
initial(y) <- 1
scalar <- user()
vector[] <- user()
dim(vector) <- user()
matrix[, ] <- user()
dim(matrix) <- user()
array[, , ] <- user()
dim(array) <- user()
array4[, , , ] <- user()
dim(array4) <- user()
})
scalar <- 1
vector <- as.numeric(1:3)
matrix <- matrix(as.numeric(1:prod(2:3)), 2L, 3L)
array <- array(as.numeric(1:prod(2:4)), c(2L, 3L, 4L))
array4 <- array(as.numeric(1:prod(2:5)), c(2L, 3L, 4L, 5L))
convert <- function(x, to = "integer") {
storage.mode(x) <- to
if (to == "character") {
x[] <- paste(x, "number")
}
x
}
## First, this is all easy and has been well tested already:
mod <- gen$new(scalar = scalar,
vector = vector,
matrix = matrix,
array = array,
array4 = array4)
dat <- mod$contents()
expect_equal(dat$scalar, scalar)
expect_equal(dat$vector, vector)
expect_equal(dat$matrix, matrix)
expect_equal(dat$array, array)
expect_equal(dat$array4, array4)
## Then to integer first:
mod <- gen$new(scalar = convert(scalar),
vector = convert(vector),
matrix = convert(matrix),
array = convert(array),
array4 = convert(array4))
dat <- mod$contents()
expect_equal(dat$scalar, scalar)
expect_equal(dat$vector, vector)
expect_equal(dat$matrix, matrix)
expect_equal(dat$array, array)
expect_equal(dat$array4, array4)
## Then test for errors on each as we convert to character:
expect_error(
gen$new(scalar = convert(scalar, "character"),
vector = vector,
matrix = matrix,
array = array,
array4 = array4),
"Expected a numeric value for 'scalar'")
expect_error(
gen$new(scalar = scalar,
vector = convert(vector, "character"),
matrix = matrix,
array = array,
array4 = array4),
"Expected a numeric value for 'vector'")
expect_error(
gen$new(scalar = scalar,
vector = vector,
matrix = convert(matrix, "character"),
array = array,
array4 = array4),
"Expected a numeric value for 'matrix'")
expect_error(
gen$new(scalar = scalar,
vector = vector,
matrix = matrix,
array = convert(array, "character"),
array4 = array4),
"Expected a numeric value for 'array'")
expect_error(
gen$new(scalar = scalar,
vector = vector,
matrix = matrix,
array = array,
array4 = convert(array4, "character")),
"Expected a numeric value for 'array4'")
})
test_that_odin("only used in output", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- 0.1
dim(r) <- 3
dim(y) <- 3
## output only:
tot <- sum(y)
output(ytot) <- tot
output(y2[]) <- y[i] * 2
dim(y2) <- length(y)
})
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
res <- mod$transform_variables(mod$run(tt))
expect_equal(res$ytot, rowSums(res$y))
expect_equal(res$y2, res$y * 2)
})
test_that_odin("overlapping graph", {
gen <- odin({
deriv(y) <- y * p
initial(y) <- 1
r <- -0.5
p <- r * sqrt(t) # used in both deriv and output
p2 <- p * 2 # used in output only
output(p3) <- p + p2
}, verbose = FALSE)
mod <- gen$new()
tt <- seq(0, 10, length.out = 101)
f <- function(t, y, p) {
r <- -0.5
p <- r * sqrt(t)
p2 <- p * 2
list(y * p, p + p2)
}
cmp <- deSolve::ode(1, tt, f, NULL)
expect_equivalent(mod$run(tt), cmp)
})
test_that_odin("sum over one dimension", {
## This does rowSums / colSums and will be important for building up
## towards a general sum.
gen <- odin({
deriv(y) <- 0
initial(y) <- 1
m[, ] <- user()
dim(m) <- user()
v1[] <- sum(m[i, ])
dim(v1) <- dim(m, 1)
v2[] <- sum(m[, i])
dim(v2) <- dim(m, 2)
v3[] <- sum(m[i, 2:4])
dim(v3) <- length(v1)
v4[] <- sum(m[2:4, i])
dim(v4) <- length(v2)
tot1 <- sum(m)
tot2 <- sum(m[, ])
})
nr <- 5
nc <- 7
m <- matrix(runif(nr * nc), nr, nc)
dat <- gen$new(m = m)$contents()
expect_equal(dat$m, m)
expect_equal(dat$v1, rowSums(m))
expect_equal(dat$v2, colSums(m))
expect_equal(dat$v3, rowSums(m[, 2:4]))
expect_equal(dat$v4, colSums(m[2:4, ]))
expect_equal(dat$tot1, sum(m))
expect_equal(dat$tot2, sum(m))
})
test_that_odin("sum over two dimensions", {
## This is where things get a bit more horrid:
gen <- odin({
deriv(y) <- 0
initial(y) <- 1
a[, , ] <- user()
dim(a) <- user()
## These collapse one dimension
m12[, ] <- sum(a[i, j, ])
m13[, ] <- sum(a[i, , j])
m23[, ] <- sum(a[, i, j])
dim(m12) <- c(dim(a, 1), dim(a, 2))
dim(m13) <- c(dim(a, 1), dim(a, 3))
dim(m23) <- c(dim(a, 2), dim(a, 3))
## These collapse two dimensions
v1[] <- sum(a[i, , ])
v2[] <- sum(a[, i, ])
v3[] <- sum(a[, , i])
dim(v1) <- dim(a, 1)
dim(v2) <- dim(a, 2)
dim(v3) <- dim(a, 3)
mm12[, ] <- sum(a[i, j, 2:4])
mm13[, ] <- sum(a[i, 2:4, j])
mm23[, ] <- sum(a[2:4, i, j])
## TODO: dim(mm12) <- dim(m12) will not work, but that would be nice
dim(mm12) <- c(dim(a, 1), dim(a, 2))
dim(mm13) <- c(dim(a, 1), dim(a, 3))
dim(mm23) <- c(dim(a, 2), dim(a, 3))
vv1[] <- sum(a[i, 2:4, 2:4])
vv2[] <- sum(a[2:4, i, 2:4])
vv3[] <- sum(a[2:4, 2:4, i])
dim(vv1) <- dim(a, 1)
dim(vv2) <- dim(a, 2)
dim(vv3) <- dim(a, 3)
tot1 <- sum(a)
tot2 <- sum(a[, , ])
})
nr <- 5
nc <- 7
nz <- 9
a <- array(runif(nr * nc * nz), c(nr, nc, nz))
dat <- gen$new(a = a)$contents()
expect_equal(dat$a, a)
expect_equal(dat$m12, apply(a, 1:2, sum))
expect_equal(dat$m13, apply(a, c(1, 3), sum))
expect_equal(dat$m23, apply(a, 2:3, sum))
expect_equal(dat$v1, apply(a, 1, sum))
expect_equal(dat$v2, apply(a, 2, sum))
expect_equal(dat$v3, apply(a, 3, sum))
expect_equal(dat$mm12, apply(a[, , 2:4], 1:2, sum))
expect_equal(dat$mm13, apply(a[, 2:4, ], c(1, 3), sum))
expect_equal(dat$mm23, apply(a[2:4, , ], 2:3, sum))
expect_equal(dat$vv1, apply(a[, 2:4, 2:4], 1, sum))
expect_equal(dat$vv2, apply(a[2:4, , 2:4], 2, sum))
expect_equal(dat$vv3, apply(a[2:4, 2:4, ], 3, sum))
expect_equal(dat$tot1, sum(a))
expect_equal(dat$tot2, sum(a))
})
test_that_odin("sum for a 4d array", {
## I don't want to check absolutely everything here, so hopefully if
## these few go OK then given the more exhaustive tests above we'll
## be OK
gen <- odin({
deriv(y) <- 0
initial(y) <- 1
a[, , , ] <- user()
dim(a) <- user()
m12[, ] <- sum(a[i, j, , ])
m23[, ] <- sum(a[, i, j, ])
m24[, ] <- sum(a[, i, , j])
dim(m12) <- c(dim(a, 1), dim(a, 2))
dim(m23) <- c(dim(a, 2), dim(a, 3))
dim(m24) <- c(dim(a, 2), dim(a, 4))
tot1 <- sum(a)
tot2 <- sum(a[, , , ])
})
dim <- c(3, 5, 7, 9)
a <- array(runif(prod(dim)), dim)
dat <- gen$new(a = a)$contents()
expect_equal(dat$a, a)
expect_equal(dat$m12, apply(a, 1:2, sum))
expect_equal(dat$m23, apply(a, c(2, 3), sum))
expect_equal(dat$m24, apply(a, c(2, 4), sum))
})
test_that_odin("sum initial condition from initial condition", {
gen <- odin({
update(a[, ]) <- 1
update(b) <- 1
initial(a[, ]) <- 1
initial(b) <- n
n <- sum(a[1, ])
dim(a) <- c(10, 10)
})
expect_equal(gen$new()$initial(0), c(10, rep(1, 100)))
})
test_that_odin("another initial condition failure", {
gen <- odin({
deriv(a[]) <- 1
deriv(b) <- 1
initial(a[]) <- 1
initial(b) <- n
n <- sum(a)
dim(a) <- 10
})
expect_equal(gen$new()$initial(0), c(10, rep(1, 10)))
})
test_that_odin("self output for scalar", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
x <- t
output(x) <- TRUE
})
tt <- seq(0, 10, length.out = 11)
expect_equal(gen$new()$run(tt)[, "x"], tt)
})
test_that_odin("non-time sentsitive output", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
x <- 1
output(x) <- TRUE
})
tt <- seq(0, 10, length.out = 11)
expect_equal(gen$new()$run(tt)[, "x"], rep(1, length(tt)))
})
test_that_odin("logical operations", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
## These ones are easy
output(x1) <- t > 1 && t < 3
output(x2) <- t > 1 || t < 3
## These ones may differ; note that parens are suggested by the
## compiler for this line.
output(x3) <- t > 8 || t > 1 && t < 3 # should equal x4
output(x4) <- t > 8 || (t > 1 && t < 3)
output(x5) <- (t > 8 || t > 1) && t < 3
}, compiler_warnings = FALSE)
t <- seq(0, 10, length.out = 101)
y <- gen$new()$run(t)
expect_equal(y[, "x1"], as.numeric(t > 1 & t < 3))
expect_equal(y[, "x2"], as.numeric(t > 1 | t < 3))
expect_equal(y[, "x3"], as.numeric(t > 8 | t > 1 & t < 3))
expect_equal(y[, "x4"], as.numeric(t > 8 | (t > 1 & t < 3)))
expect_equal(y[, "x5"], as.numeric((t > 8 | t > 1) & t < 3))
})
## This is for issue #44, needed to support Neil's model. I don't
## know how useful this is going to be. I'll see if we can get away
## with this for now, and then go through and see if we can detect if
## a number is an integer thing because it's only used within indexes.
test_that_odin("integer vector", {
## We expect 'idx' to come through as an integer
gen <- odin({
x[] <- user()
dim(x) <- user()
idx[] <- user()
dim(idx) <- user()
initial(v[]) <- x[idx[i]] # TODO: fixme
deriv(v[]) <- 0
dim(v) <- length(x)
})
set.seed(1)
idx <- sample(15)
x <- runif(length(idx))
mod <- gen$new(x = x, idx = idx)
dat <- mod$contents()
expect_equal(dat$idx, idx)
expect_equal(dat$initial_v, x[idx])
expect_equal(ir_deserialise(mod$ir())$data$elements$idx$storage_type,
"int")
})
## This is much closer to the test case needed for Neil's model
test_that_odin("integer matrix", {
gen <- odin({
x[] <- user()
dim(x) <- user()
idx[, ] <- user()
dim(idx) <- c(length(x), 3)
v[] <- x[idx[i, 1]] + x[idx[i, 2]] + x[idx[i, 3]]
dim(v) <- length(x)
initial(z) <- 1
deriv(z) <- 0
})
x <- runif(10)
idx <- matrix(sample(length(x), length(x) * 3, replace = TRUE), length(x), 3)
## This is what the code should expand to:
v <- x[idx[, 1]] + x[idx[, 2]] + x[idx[, 3]]
mod <- gen$new(x = x, idx = idx)
expect_equal(mod$contents()$v, v)
expect_equal(ir_deserialise(mod$ir())$data$elements$idx$storage_type,
"int")
})
test_that_odin("c in dim for vector", {
## This is a regression test for issue #61
gen <- odin({
initial(x[]) <- 1
deriv(x[]) <- 0
dim(x) <- c(5)
})
mod <- gen$new()
expect_equal(mod$contents()$initial_x, rep(1.0, 5))
})
test_that_odin("user variable information", {
gen <- odin({
deriv(N) <- r[1] * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- user(100)
r[] <- user()
dim(r) <- 1
})
info <- coef(gen)
expect_is(info, "data.frame")
expect_equal(info$has_default, c(FALSE, TRUE, TRUE))
expect_equal(info$rank, c(1L, 0L, 0L))
expect_identical(coef(gen$new(r = 1)), info)
})
test_that_odin("user variable information - when no user", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- 10
K <- 100
r <- 0.1
})
info <- coef(gen)
cmp <- data.frame(name = character(),
has_default = logical(),
default_value = I(list()),
rank = integer(),
min = numeric(),
max = numeric(),
integer = logical(),
stringsAsFactors = FALSE)
expect_identical(info, cmp)
expect_identical(coef(gen$new()), cmp)
})
test_that_odin("multiline string", {
## Literal multiline string:
gen <- odin(c("deriv(y) <- 0.5", "initial(y) <- 1"))
expect_is(gen$new(), "odin_model")
})
## This is basically all ok but what is still not great is _doing_ the
## validation.
test_that_odin("user integer", {
gen <- odin({
deriv(y) <- 0.5
initial(y) <- y0
y0 <- user(1, integer = TRUE, min = 0)
})
expect_error(gen$new(y0 = 1.5), "Expected 'y0' to be integer-like")
expect_error(gen$new(y0 = -1L), "Expected 'y0' to be at least 0")
expect_error(mod <- gen$new(y0 = 1), NA)
expect_equal(mod$run(0:10)[, "y"], 1.0 + 0.5 * (0:10))
})
test_that_odin("multiple constraints", {
gen <- odin({
deriv(y) <- r
initial(y) <- y0
y0 <- user(1, min = 0)
r <- user(0.5, max = 10)
})
expect_error(gen$new(y0 = -1L), "Expected 'y0' to be at least 0")
expect_error(gen$new(r = 100), "Expected 'r' to be at most 10")
})
test_that_odin("set_user honours constraints", {
gen <- odin({
deriv(y) <- r
initial(y) <- y0
y0 <- user(1, min = 0)
r <- user(0.5, max = 10)
})
mod <- gen$new()
expect_error(mod$set_user(y0 = -1L), "Expected 'y0' to be at least 0")
expect_error(mod$set_user(r = 100), "Expected 'r' to be at most 10")
})
test_that_odin("user sized dependent variables are allowed", {
gen <- odin({
deriv(y[]) <- r[i] * y[i]
initial(y[]) <- 1
r[] <- user()
dim(r) <- user()
dim(y) <- length(r)
})
r <- runif(3)
mod <- gen$new(r = r)
expect_identical(mod$contents()$r, r)
expect_identical(mod$contents()$initial_y, rep(1.0, length(r)))
})
test_that_odin("user parameter validation", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- user()
})
## Honour all the options:
expect_error(
gen$new(user = list(r = 1, a = 1), unused_user_action = "stop"),
"Unknown user parameters: a")
expect_warning(
gen$new(user = list(r = 1, a = 1), unused_user_action = "warning"),
"Unknown user parameters: a")
expect_message(
gen$new(user = list(r = 1, a = 1), unused_user_action = "message"),
"Unknown user parameters: a")
expect_silent(
gen$new(user = list(r = 1, a = 1), unused_user_action = "ignore"))
## Sensible error message for invalid option
expect_error(
gen$new(user = list(r = 1, a = 1), unused_user_action = "other"),
"Unknown user parameters: a (and invalid value for unused_user_action)",
fixed = TRUE)
## Inherit action from option
with_options(
list(odin.unused_user_action = "message"),
expect_message(
gen$new(user = list(r = 1, a = 1)),
"Unknown user parameters: a"))
## Override option
with_options(
list(odin.unused_user_action = "message"),
expect_error(
gen$new(user = list(r = 1, a = 1), unused_user_action = "error"),
"Unknown user parameters: a"))
## System default:
with_options(
list(odin.unused_user_action = NULL),
expect_warning(
gen$new(user = list(r = 1, a = 1)),
"Unknown user parameters: a"))
## set_user:
mod <- gen$new(r = 1)
expect_silent(
mod$set_user(user = list(x = 1), unused_user_action = "ignore"))
expect_error(
mod$set_user(user = list(x = 1), unused_user_action = "error"),
"Unknown user parameters: x")
})
test_that_odin("sum over integer", {
gen <- odin({
x[] <- user()
dim(x) <- user()
idx[] <- user()
dim(idx) <- user()
initial(v[]) <- x[idx[i]]
update(v[]) <- sum(idx)
dim(v) <- length(x)
})
set.seed(1)
idx <- sample(15)
x <- runif(length(idx))
mod <- gen$new(x = x, idx = idx)
dat <- mod$contents()
expect_equal(dat$idx, idx)
expect_equal(dat$initial_v, x[idx])
expect_equal(mod$update(0, mod$initial(0)),
rep(sum(idx), 15))
})
test_that_odin("force integer on use", {
gen <- odin({
vec[] <- i
dim(vec) <- 2
idx <- if (t > 5) 2 else 1
deriv(x) <- vec[as.integer(idx)]
initial(x) <- 0
})
mod <- gen$new()
t <- seq(0, 10, length.out = 101)
y <- mod$run(t, atol = 1e-9, rtol = 1e-9)
expect_equal(y[, 2], ifelse(t <= 5, t, 2 * t - 5))
})
test_that_odin("force integer on a numeric vector truncates", {
gen <- odin({
vec[] <- i
dim(vec) <- 10
idx <- user()
initial(x) <- vec[as.integer(idx)]
deriv(x) <- 0
})
expect_equal(gen$new(idx = 1.5)$initial(0), 1)
expect_equal(gen$new(idx = 3 - 1e-8)$initial(0), 2)
expect_equal(gen$new(idx = 3 + 1e-8)$initial(0), 3)
})
test_that_odin("user c functions can be passed arrays and indexes", {
skip_for_target("r")
gen <- odin({
config(include) <- "user_fns4.c"
n <- 5
x[] <- user()
y[] <- f(i, x)
dim(x) <- n
dim(y) <- n
output(y) <- TRUE
initial(a) <- 0
deriv(a) <- 0
})
x <- runif(5)
mod <- gen$new(user = list(x = x))
y <- mod$run(c(0, 1))
expect_equal(mod$transform_variables(y[2, ])$y, cumsum(x))
})
test_that_odin("self output for scalar: rewrite corner case", {
gen <- odin({
initial(a) <- 1
deriv(a) <- 0
x <- 2 + 5
output(x) <- TRUE
})
tt <- seq(0, 10, length.out = 11)
expect_equal(gen$new()$run(tt)[, "x"], rep(7, 11))
})
test_that_odin("deprecation warning finds used constructor name", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- 2
config(base) <- "mymodel"
})
expect_warning(gen(), "'gen(...)' is deprecated", fixed = TRUE)
expect_warning(local(gen()), "'gen(...)' is deprecated", fixed = TRUE)
expect_silent(gen$new())
})
test_that_odin("deprecation warning falls back on base name", {
code <- c("deriv(y) <- r",
"initial(y) <- 1",
"r <- 2",
"config(base) <- 'mymodel'")
expect_warning(odin_(code)(), "'mymodel(...)' is deprecated",
fixed = TRUE)
expect_silent(odin_(code)$new())
})
Try the odin package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.