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()) })