Nothing
library(RTMB)
tol <- sqrt(.Machine$double.eps)
################################################################################
## Test 1 (GH issue 13)
################################################################################
f <- MakeTape(function(x) c(x[1],x[1]+x[2]+3*x[3],x[1]+x[2]+x[3],x[1]*x[2]),numeric(3))
J123 <- structure(c(1, 1, 1, 2, 0, 1, 1, 1, 0, 3, 1, 0), dim = 4:3)
expect_identical(f$jacobian(1:3), J123, info="Jacobian evaluation")
expect_identical(f$jacfun()(1:3), J123, info="Jacobian transformation")
################################################################################
## Test 2 (NA propagation on the tape)
################################################################################
## Arithmetic with NA/NaN constants
## Compiler optimizations (--fast-math) can cause this test to fail:
vec <- c(NA, NaN, 1)
f <- function(x) x + vec
F <- MakeTape(f, numeric(1))
expect_identical(F(0), vec, info="NA propagation on the tape")
## Tapes f1 and f2 should be identical assuming correct propagation of
## NAs from 'obs' to 'nll':
obs <- c(2, NA, NA, NA)
f1 <- MakeTape(function(p){
nll <- -dnorm(obs, p, 1, TRUE)
sum(nll, na.rm=TRUE)
}, 0)
f2 <- MakeTape(function(p){
nll <- -dnorm(obs, p, 1, TRUE)
sum(nll[!is.na(obs)])
}, 0)
expect_identical(f1(1.234), f2(1.234), info="NA propagation on the tape")
################################################################################
## (GH issue 17)
################################################################################
expect_silent(
MakeTape(function(x) {
y <- numeric(3)
f <- MakeTape(sin, 1:10)
y[1] <- x[1] ## Error here is side-effect of previous line
y
}, 1:10)
)
################################################################################
## (GH issue 18)
################################################################################
F <- MakeTape(function(x) {
G <- MakeTape(function(y) y*x, numeric(5))
G(1:5)
}, numeric(5))
expect_equal(F(1:5), (1:5)^2, info="https://github.com/kaskr/RTMB/issues/18")
################################################################################
## (GH issue 20)
################################################################################
F <- MakeTape(function(x) {
as.numeric(x)
}, numeric(3))
expect_equal(F(1:3), 1:3, info="https://github.com/kaskr/RTMB/issues/20")
################################################################################
## Tape keeps attributes
################################################################################
F <- MakeTape(function(x) x * diag(2), 1) ## : R^1 -> R^4
expect_identical(dim(F(1)), c(2L, 2L),
"Tape keeps matrix output")
F <- MakeTape(F, 1)
expect_identical(dim(F(1)), c(2L, 2L),
"Re-playing tape keeps matrix output")
I <- Matrix::.symDiagonal(2)
F <- MakeTape(function(x) x * I , 1) ## : R^1 -> R^2
expect_true(is(F(1), "sparseMatrix"),
"Tape keeps sparse matrix output")
F <- MakeTape(F, 1)
expect_true(is(F(1), "sparseMatrix"),
"Re-playing tape keeps sparse matrix output")
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.