context("odin: basic")
test_that_odin("trivial model", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- 2
}, options = odin_options(rewrite_constants = FALSE))
mod <- gen$new()
expect_is(mod, "odin_model")
expect_equal(mod$initial(0), 1)
expect_equal(mod$initial(10), 1)
expect_equal(mod$deriv(0, 0), 2)
expect_equal(mod$deriv(10, 10), 2)
tt <- 0:10
yy <- mod$run(tt)
expect_equal(colnames(yy), c("t", "y"))
expect_equal(yy[, 1], tt)
expect_equal(yy[, 2], seq(1, length.out = length(tt), by = 2))
expect_equal(mod$contents(), sort_list(list(initial_y = 1, r = 2)))
})
## This tests a few things
##
## 1. can we use time dependent rhs
## 2. can we make transient variables work correctly
## 3. we can construct somewhat nontrivial expressions
##
## This should integrate to a parabola y = 1 + t^2
test_that_odin("Time dependent rhs", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- 2 * t
})
## This looks like a reasonable rhs but it's going through the
## internal storage instead of being transient.
mod <- gen$new()
tt <- 0:10
yy <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
expect_equal(yy[, 1], tt)
expect_equal(yy[, 2], 1 + tt^2)
expect_equal(mod$contents(), list(initial_y = 1))
})
test_that_odin("Time dependent initial conditions", {
gen <- odin({
y1 <- cos(t)
y2 <- y1 * (r + t)
r <- 1
deriv(y3) <- y2
initial(y3) <- y2
})
mod <- gen$new()
f <- function(t) {
cos(t) * (1 + t)
}
expect_equal(mod$initial(0), f(0))
expect_equal(mod$initial(1), f(1))
expect_equal(mod$deriv(0, 1), f(0))
expect_equal(mod$deriv(1, 1), f(1))
expect_equal(mod$contents()$initial_y3, f(1))
})
## Tests: that we can actually use state variables in a calculation
test_that_odin("use state in derivative calculation", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- 1
K <- 100
r <- 2.0
})
mod <- gen$new()
## two equilibria:
expect_equal(mod$deriv(0, 0), 0)
expect_equal(mod$deriv(0, 100), 0)
## off equilibria:
expect_equal(mod$deriv(0, 1), 2 * 1 * 99 / 100)
})
## Tests: multiple scalar variables can be packed together properly
test_that_odin("multiple variables", {
gen <- odin({
deriv(y1) <- sigma * (y2 - y1)
deriv(y2) <- R * y1 - y2 - y1 * y3
deriv(y3) <- -b * y3 + y1 * y2
initial(y1) <- 10.0
initial(y2) <- 1.0
initial(y3) <- 1.0
sigma <- 10.0
R <- 28.0
b <- 8.0 / 3.0
})
mod <- gen$new()
expect_equal(mod$initial(0), c(10, 1, 1))
expect_equal(mod$deriv(0, mod$initial(0)), c(-90, 269, 22 / 3))
})
## Tests: scalar user variables
test_that_odin("user variables", {
gen <- odin({
deriv(N) <- r * N * (1 - N / K)
initial(N) <- N0
N0 <- user(1)
K <- 100
r <- user()
})
expect_error(gen$new())
expect_error(gen$new(r = NULL),
"Expected a (number|value) for 'r'")
expect_error(gen$new(r = 1:2),
"Expected a (number|scalar numeric) for 'r'")
expect_error(gen$new(r = numeric(0)),
"Expected a (number|scalar numeric) for 'r'")
expect_equal(gen$new(r = pi)$contents()[c("N0", "r")],
list(N0 = 1, r = pi))
expect_equal(gen$new(r = pi, N0 = 10)$contents()[c("N0", "r")],
list(N0 = 10, r = pi))
expect_equal(gen$new(r = pi, N0 = 10)$initial(0), 10)
expect_equal(gen$new(r = pi, N0 = 10)$deriv(0, 10),
pi * 10 * (1 - 10 / 100))
mod <- gen$new(r = pi, N0 = exp(1))
mod$set_user()
expect_equal(mod$contents()$r, pi)
expect_equal(mod$contents()$N0, exp(1))
})
test_that_odin("simple operations in user variables are allowed", {
gen <- odin({
deriv(x) <- 1
initial(x) <- x0
x0 <- user(-1 / (2 + 3 * 4))
})
mod <- gen$new()
expect_equal(mod$contents()$x0, -1 / (2 + 3 * 4))
})
## Tests: basic output
##
## This one is about as basic as I can see!
test_that_odin("output", {
gen <- odin({
deriv(y) <- 2
initial(y) <- 1
output(z) <- t
})
tt <- 0:10
mod <- gen$new()
expect_equal(mod$deriv(0, 1), structure(2, output = 0))
expect_equal(mod$deriv(10, 1), structure(2, output = 10))
yy1 <- mod$run(tt)
expect_equal(colnames(yy1), c("t", "y", "z"))
expect_equal(yy1[, "t"], tt)
expect_equal(yy1[, "y"], seq(1, length.out = length(tt), by = 2))
expect_equal(yy1[, "z"], tt)
## TODO: this is pretty poor, we might think about silently ignoring
## this argument?
skip_for_target("js") # R interface specific
yy2 <- gen$new(use_dde = TRUE)$run(tt)
expect_equal(colnames(yy2), c("t", "y", "z"))
expect_equal(yy2[, "t"], tt)
expect_equal(yy2[, "y"], seq(1, length.out = length(tt), by = 2))
expect_equal(yy2[, "z"], tt)
})
## Do some nontrivial calculation in the output
test_that_odin("output", {
gen <- odin({
deriv(y) <- 2
initial(y) <- 1
output(z) <- a * 2
a <- t + y
})
mod <- gen$new()
expect_equal(mod$deriv(0, 1), structure(2, output = 2))
expect_equal(mod$deriv(10, 1), structure(2, output = 22))
})
test_that_odin("copy output", {
gen <- odin({
deriv(y) <- 1
initial(y) <- 1
z[] <- t
dim(z) <- 5
output(z[]) <- TRUE
})
mod <- gen$new()
tt <- 0:10
y <- mod$run(tt)
yy <- mod$transform_variables(y)
expect_equal(yy$y, tt + 1)
expect_equal(yy$z, matrix(tt, length(tt), 5))
})
test_that_odin("copy output, explicitly", {
gen <- odin({
deriv(y) <- 1
initial(y) <- 1
z[] <- t
dim(z) <- 5
output(z[]) <- z[i]
})
mod <- gen$new()
tt <- 0:10
y <- mod$run(tt)
yy <- mod$transform_variables(y)
expect_equal(yy$y, tt + 1)
expect_equal(yy$z, matrix(tt, length(tt), 5))
})
## Basic discrete models
test_that_odin("discrete", {
gen <- odin({
initial(x) <- 1
update(x) <- x + 1
})
mod <- gen$new()
expect_equal(mod$initial(0), 1)
expect_equal(mod$update(0, 1), 2)
tt <- 0:10
yy <- mod$run(tt)
expect_equal(yy, cbind(step = tt, x = tt + 1))
})
test_that_odin("discrete with output", {
skip_for_target("js") # discrete output, removed from odin soon?
gen <- odin({
initial(x) <- 1
update(x) <- x + 1
output(y) <- x + step
})
mod <- gen$new()
expect_equal(mod$update(2, 3), structure(4, output = 5))
tt <- 0:10
yy <- mod$run(tt)
expect_equal(yy, cbind(step = tt, x = tt + 1, y = 2 * tt + 1))
})
## Fairly minimal array model, though it does mix array and non array
## variables, plus an array support variable.
test_that_odin("array support", {
gen <- odin({
initial(x[]) <- 1
initial(y) <- 2
deriv(x[]) <- r[i]
deriv(y) <- n
r[] <- i
n <- 3
dim(r) <- n
dim(x) <- n
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
mod <- gen$new()
## internal data is ok:
expect_equal(sort_list(mod$contents()),
sort_list(list(dim_r = 3, dim_x = 3, initial_x = rep(1, 3),
initial_y = 2, n = 3, r = 1:3)))
expect_equal(mod$initial(0), c(2, 1, 1, 1))
expect_equal(mod$deriv(0, c(2, 1, 1, 1)), c(3, 1, 2, 3))
tt <- 0:10
yy <- mod$run(tt)
expect_equivalent(yy[, ],
cbind(tt, 2 + tt * 3, 1 + tt, 1 + tt * 2, 1 + tt * 3,
deparse.level = 0))
expect_equal(colnames(yy), c("t", "y", "x[1]", "x[2]", "x[3]"))
expect_equal(mod$transform_variables(yy),
list(t = tt,
y = yy[, 2],
x = unname(yy[, 3:5])))
})
test_that_odin("multi-line array expression", {
gen <- odin({
initial(x) <- 1
deriv(x) <- 1
a[1] <- 1
a[2] <- 1
a[3:n] <- a[i - 1] + a[i - 2]
dim(a) <- n
n <- 10
})
expect_equal(gen$new()$contents()$a, c(1, 1, 2, 3, 5, 8, 13, 21, 34, 55))
})
test_that_odin("3d array", {
gen <- odin({
initial(y[, , ]) <- 1
deriv(y[, , ]) <- y[i, j, k] * 0.1
dim(y) <- c(2, 3, 4)
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
mod <- gen$new()
d <- mod$contents()
expect_equal(d$initial_y, array(1, c(2, 3, 4)))
expect_equal(d$dim_y, 24)
expect_equal(d$dim_y_1, 2)
expect_equal(d$dim_y_2, 3)
expect_equal(d$dim_y_3, 4)
expect_equal(d$dim_y_12, 6)
expect_equal(mod$initial(0), rep(1, 24))
expect_equal(mod$deriv(0, mod$initial(0)), rep(0.1, 24))
tt <- 0:10
yy <- mod$run(tt, atol = 1e-8, rtol = 1e-8)
expect_equal(colnames(yy)[[12]], "y[1,3,2]")
expect_equal(yy[, 1], tt)
expect_equal(unname(yy[, -1]), matrix(rep(exp(0.1 * tt), 24), 11))
})
## User provided, constant defined arrays
test_that_odin("user array", {
gen <- odin({
initial(x[]) <- 1
deriv(x[]) <- r[i]
r[] <- user()
n <- 3
dim(r) <- n
dim(x) <- n
})
mod <- gen$new(r = 1:3)
expect_equal(mod$contents()$r, as.numeric(1:3))
expect_error(gen$new(r = 1), "Expected length 3 value for 'r'")
})
test_that_odin("user matrix", {
gen <- odin({
initial(y[, ]) <- 1
deriv(y[, ]) <- y[i, j] * r[i, j]
dim(y) <- c(2, 3)
dim(r) <- c(2, 3)
r[, ] <- user()
})
r <- matrix(runif(6), 2, 3)
mod <- gen$new(r = r)
expect_equal(mod$contents()$r, r)
## TODO: this would be nice to tidy up but it's really tricky to
## throw these errors the same way in C
if (odin_target_name() == "r") {
msg1 <- msg2 <- "Expected a numeric array with dimensions 2 * 3 for 'r'"
} else {
msg1 <- "Expected a numeric matrix for 'r'"
msg2 <- "Incorrect size of dimension 1 of 'r' (expected 2)"
}
expect_error(gen$new(r = c(r)), msg1, fixed = TRUE)
expect_error(gen$new(r = r[2, 2]), msg1, fixed = TRUE)
expect_error(gen$new(r = array(1, 2:4)), msg1, fixed = TRUE)
expect_error(gen$new(r = 1), msg1, fixed = TRUE)
expect_error(gen$new(r = t(r)), msg2, fixed = TRUE)
})
test_that_odin("user array - indirect", {
gen <- odin({
initial(x[]) <- 1
deriv(x[]) <- r[i]
r[] <- user()
dim(r) <- n
dim(x) <- n
n <- user()
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
mod <- gen$new(n = 3, r = 1:3)
expect_equal(sort_list(mod$contents()),
sort_list(list(
dim_r = 3,
dim_x = 3,
initial_x = rep(1, 3),
n = 3,
r = 1:3)))
expect_error(gen$new(n = 4, r = 1:3),
"Expected length 4 value for 'r'")
})
test_that_odin("user array - direct", {
gen <- odin({
initial(x[]) <- 1
deriv(x[]) <- r[i]
r[] <- user()
dim(r) <- user()
dim(x) <- length(r)
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
mod <- gen$new(r = 1:3)
expect_equal(
sort_list(mod$contents()),
sort_list(list(dim_r = 3, dim_x = 3, initial_x = rep(1, 3), r = 1:3)))
expect_error(gen$new(r = matrix(1, 2, 3)),
"Expected a numeric vector for 'r'")
expect_error(gen$new(r = NULL),
"Expected a value for 'r'")
expect_silent(mod$set_user(r = NULL))
expect_equal(mod$contents()$r, 1:3)
})
test_that_odin("user array - direct 3d", {
gen <- odin({
initial(y) <- 1
deriv(y) <- 1
r[, , ] <- user()
dim(r) <- user()
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
m <- array(runif(24), 2:4)
mod <- gen$new(r = m)
expect_equal(sort_list(mod$contents()),
sort_list(list(dim_r = 24, dim_r_1 = 2, dim_r_12 = 6,
dim_r_2 = 3, dim_r_3 = 4, initial_y = 1,
r = m)))
expect_error(gen$new(r = 1), "Expected a numeric array of rank 3 for 'r'")
expect_error(gen$new(r = matrix(1)),
"Expected a numeric array of rank 3 for 'r'")
})
## NOTE: this is the test from test-interpolation.R
test_that_odin("interpolation", {
gen <- odin({
deriv(y) <- pulse
initial(y) <- 0
##
pulse <- interpolate(tp, zp, "constant")
##
tp[] <- user()
zp[] <- user()
dim(tp) <- user()
dim(zp) <- user()
output(p) <- pulse
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
tt <- seq(0, 3, length.out = 301)
tp <- c(0, 1, 2)
zp <- c(0, 1, 0)
mod <- gen$new(tp = tp, zp = zp)
dat <- mod$contents()
expect_equal(sort(names(dat)),
sort(c("dim_tp", "dim_zp", "initial_y", "interpolate_pulse",
"tp", "zp")))
pulse <- cinterpolate::interpolation_function(tp, zp, "constant")(tt)
## TODO: this can be done for c models too but it requires a bit
## more work
if (odin_target_name() == "r") {
## Interpolating function works
expect_equal(vnapply(tt, dat$interpolate_pulse), pulse)
}
yy <- mod$run(tt)
zz <- ifelse(tt < 1, 0, ifelse(tt > 2, 1, tt - 1))
tol <- variable_tolerance(mod, 1e-5, js = 1e-4)
expect_equal(yy[, "y"], zz, tolerance = tol)
expect_equal(yy[, "p"], pulse)
})
test_that_odin("stochastic", {
gen <- odin({
initial(x) <- 0
update(x) <- x + unif_rand()
})
mod <- gen$new()
expect_equal(mod$initial(0), 0)
set.seed(1)
x <- runif(3)
set.seed(1)
y <- replicate(3, mod$update(0, 0))
expect_equal(x, y)
})
test_that_odin("multiple arrays: constant", {
gen <- odin({
initial(x[]) <- 1
initial(y[]) <- 2
deriv(x[]) <- r[i]
deriv(y[]) <- r[i]
r[] <- i
n <- 3
dim(r) <- n
dim(x) <- n
dim(y) <- n
})
mod <- gen$new()
expect_equal(mod$initial(0), rep(1:2, each = 3))
expect_equal(mod$deriv(0, mod$initial(0)), rep(1:3, 2))
})
test_that_odin("multiple arrays: dynamic", {
gen <- odin({
initial(x[]) <- 1
initial(y[]) <- 2
deriv(x[]) <- r[i]
deriv(y[]) <- r[i]
r[] <- i
n <- user()
dim(r) <- n
dim(x) <- n
dim(y) <- n
})
mod <- gen$new(n = 4)
expect_equal(mod$initial(0), rep(1:2, each = 4))
expect_equal(mod$deriv(0, mod$initial(0)), rep(1:4, 2))
})
test_that_odin("multiple 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)
expect_equal(mod$initial(0), 1:3)
expect_equal(
mod$deriv(0, mod$initial(0)),
structure(1:3 * r, output = c(1:3 / 1:3, 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)))
})
test_that_odin("3d array time dependent and variable", {
gen <- odin({
initial(y[, , ]) <- 1
deriv(y[, , ]) <- y[i, j, k] * r[i, j, k]
dim(y) <- c(2, 3, 4)
dim(r) <- c(2, 3, 4)
r[, , ] <- t * 0.1
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
mod <- gen$new()
d <- mod$contents()
expect_equal(d$initial_y, array(1, c(2, 3, 4)))
expect_equal(d$dim_y, 24)
expect_equal(d$dim_y_1, 2)
expect_equal(d$dim_y_2, 3)
expect_equal(d$dim_y_3, 4)
expect_equal(d$dim_y_12, 6)
expect_equal(mod$initial(0), rep(1, 24))
expect_equal(mod$deriv(2, mod$initial(0)), rep(0.2, 24))
tt <- 0:10
yy <- mod$run(tt)
expect_equal(colnames(yy)[[12]], "y[1,3,2]")
expect_equal(yy[, 1], tt)
if (odin_target_name() == "js") {
skip_if_not_installed("dde")
cmp <- dde::dopri(1, tt, function(t, y, p) y * t * 0.1, NULL)[, 2]
} else {
cmp <- deSolve::ode(1, tt, function(t, y, p) list(y * t * 0.1))[, 2]
}
expect_equal(
unname(yy[, -1]),
matrix(rep(cmp, 24), 11))
})
test_that_odin("rich user arrays", {
gen <- odin({
initial(y[, ]) <- 1
deriv(y[, ]) <- y[i, j] * r[i, j]
dim(y) <- c(2, 3)
r[, ] <- user(min = 0)
dim(r) <- c(2, 3)
})
r <- matrix(runif(6), 2, 3)
expect_error(gen$new(r = r), NA)
expect_error(gen$new(r = -r), "Expected 'r' to be at least 0")
r[5] <- -1
expect_error(gen$new(r = r), "Expected 'r' to be at least 0")
r[5] <- NA
expect_error(gen$new(r = r), "'r' must not contain any NA values")
})
test_that_odin("rich user sized arrays", {
gen <- odin({
initial(y[, ]) <- 1
deriv(y[, ]) <- y[i, j] * r[i, j]
dim(y) <- c(2, 3)
r[, ] <- user(min = 0)
dim(r) <- user()
})
r <- matrix(runif(6), 2, 3)
expect_error(gen$new(r = r), NA)
expect_error(gen$new(r = -r), "Expected 'r' to be at least 0")
r[5] <- -1
expect_error(gen$new(r = r), "Expected 'r' to be at least 0")
})
test_that_odin("discrete delays: matrix", {
skip_for_target("js") # discrete delays, not supported
gen <- odin({
initial(y[, ]) <- 1
update(y[, ]) <- y[i, j] + 1
initial(z[, ]) <- 1
update(z[, ]) <- a[i, j]
a[, ] <- delay(y[i, j], 2)
dim(y) <- c(2, 3)
dim(z) <- c(2, 3)
dim(a) <- c(2, 3)
}, options = odin_options(rewrite_constants = FALSE, rewrite_dims = FALSE))
mod <- gen$new()
tt <- 0:10
yy <- mod$run(tt)
zz <- mod$transform_variables(yy)
expect_equal(zz$z[1:3, , ], array(1, c(3, 2, 3)))
expect_equal(zz$z[4:11, , ], zz$y[1:8, , ])
})
test_that_odin("multinomial", {
skip_for_target("js") # multinomial needs random.js support
gen <- odin({
q[] <- user()
p[] <- q[i] / sum(q)
initial(x[]) <- 0
update(x[]) <- y[i]
y[] <- rmultinom(5, p)
dim(p) <- 5
dim(q) <- 5
dim(x) <- 5
dim(y) <- 5
})
set.seed(1)
p <- runif(5)
mod <- gen$new(q = p)
set.seed(1)
y <- mod$update(0, mod$initial(0))
set.seed(1)
cmp <- drop(rmultinom(1, 5, p))
expect_equal(cmp, y)
})
test_that_odin("local scope of loop variables", {
gen <- odin({
deriv(x[1, ]) <- 1
deriv(x[2:n, ]) <- 2
deriv(y[1, ]) <- 2
deriv(y[2:n, ]) <- 4
initial(x[, ]) <- 1
initial(y[, ]) <- 1
dim(x) <- c(n, m)
dim(y) <- c(n, m)
n <- 4
m <- 2
})
mod <- gen$new()
y0 <- mod$initial(0)
y <- mod$transform_variables(mod$deriv(0, y0))
cmp <- matrix(rep(1:2, c(2, 6)), 4, 2, TRUE)
expect_equal(y$x, cmp)
expect_equal(y$y, cmp * 2)
})
test_that_odin("Can set or omit names", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- 2
})
mod <- gen$new()
expect_equal(colnames(mod$run(0:10)), c("t", "y"))
expect_equal(colnames(mod$run(0:10, use_names = FALSE)), NULL)
})
test_that_odin("Can set initial conditions directly in an ode", {
gen <- odin({
deriv(y) <- r
initial(y) <- 1
r <- 2
})
mod <- gen$new()
y <- mod$run(0:10, 2)
expect_equal(y[, "y"], seq(2, by = 2, length.out = 11))
})
test_that_odin("Can substitute user variables", {
gen <- odin({
n <- user(integer = TRUE)
m <- user()
deriv(S[, ]) <- 0
deriv(I) <- S[n, m]
dim(S) <- c(n, m)
initial(S[, ]) <- S0[i, j]
initial(I) <- 0
S0[, ] <- user()
dim(S0) <- c(n, m)
}, options = odin_options(rewrite_dims = TRUE,
rewrite_constants = FALSE,
substitutions = list(n = 2, m = 3)))
expect_equal(nrow(coef(gen)), 1) # only S0 now
S0 <- matrix(rpois(6, 10), 2, 3)
mod <- gen$new(S0 = S0)
dat <- mod$contents()
expect_equal(dat$n, 2)
expect_equal(dat$m, 3)
expect_equal(dat$initial_S, S0)
})
test_that_odin("Can rewrite common dimensions", {
gen <- odin({
n <- user(integer = TRUE)
m <- user()
deriv(S[, ]) <- 0
deriv(I) <- S[n, m]
dim(S) <- c(n, m)
initial(S[, ]) <- S0[i, j]
initial(I) <- 0
S0[, ] <- user()
dim(S0) <- c(n, m)
}, options = odin_options(rewrite_constants = TRUE))
S0 <- matrix(rpois(6, 10), 2, 3)
mod <- gen$new(S0 = S0, n = 2, m = 3)
dat <- mod$contents()
expect_equal(sum(c("dim_S0", "dim_S") %in% names(dat)), 1)
expect_equal(dat$initial_S, S0)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.