rxTest({
testPipeQuote <- function(..., envir=parent.frame(), iniDf = NULL) {
rxUnloadAll()
gc()
.quoteCallInfoLines(match.call(expand.dots = TRUE)[-1], envir=envir, iniDf=iniDf)
}
rxTest({
test_that("nse evaluation", {
tmp <- "d/dt(depot)"
expect_equal(testPipeQuote(tmp),
list(quote(d/dt(depot))))
t <- c("-d/dt(peripheral1)", "-d/dt(peripheral2)")
expect_equal(testPipeQuote(t),
list(quote(-d/dt(peripheral1)),
quote(-d/dt(peripheral2))))
t <- c(a="x", b="y")
expect_equal(testPipeQuote(t),
list(quote(a <- x), quote(b <- y)))
tmp <- list(tmp="d/dt(depot)")
expect_equal(testPipeQuote(tmp$tmp),
list(quote(d/dt(depot))))
tmp <- list(tmp=list(tmp="d/dt(depot)"))
expect_equal(testPipeQuote(tmp$tmp$tmp),
list(quote(d/dt(depot))))
})
test_that("equivalent drop statements", {
expect_equal(.changeDropNullLine(quote(a <- NULL)),
quote(-a))
expect_equal(.changeDropNullLine(quote(a ~ NULL)),
quote(-a))
expect_equal(.changeDropNullLine(str2lang("a = NULL")),
quote(-a))
expect_equal(.changeDropNullLine(quote(d/dt(a) <- NULL)),
quote(-d/dt(a)))
expect_equal(.changeDropNullLine(quote(d/dt(a) ~ NULL)),
quote(-d/dt(a)))
expect_equal(.changeDropNullLine(str2lang("d/dt(a) = NULL")),
quote(-d/dt(a)))
expect_equal(.changeDropNullLine(quote(lag(a) <- NULL)),
quote(-lag(a)))
expect_equal(.changeDropNullLine(quote(lag(a) ~ NULL)),
quote(-lag(a)))
expect_equal(.changeDropNullLine(str2lang("lag(a) = NULL")),
quote(-lag(a)))
expect_equal(.changeDropNullLine(quote(alag(a) <- NULL)),
quote(-alag(a)))
expect_equal(.changeDropNullLine(quote(alag(a) ~ NULL)),
quote(-alag(a)))
expect_equal(.changeDropNullLine(str2lang("alag(a) = NULL")),
quote(-alag(a)))
expect_equal(.changeDropNullLine(quote(F(a) <- NULL)),
quote(-F(a)))
expect_equal(.changeDropNullLine(quote(F(a) ~ NULL)),
quote(-F(a)))
expect_equal(.changeDropNullLine(str2lang("F(a) = NULL")),
quote(-F(a)))
expect_equal(.changeDropNullLine(quote(f(a) <- NULL)),
quote(-f(a)))
expect_equal(.changeDropNullLine(quote(f(a) ~ NULL)),
quote(-f(a)))
expect_equal(.changeDropNullLine(str2lang("f(a) = NULL")),
quote(-f(a)))
expect_equal(.changeDropNullLine(quote(rate(a) <- NULL)),
quote(-rate(a)))
expect_equal(.changeDropNullLine(quote(rate(a) ~ NULL)),
quote(-rate(a)))
expect_equal(.changeDropNullLine(str2lang("rate(a) = NULL")),
quote(-rate(a)))
expect_equal(.changeDropNullLine(quote(dur(a) <- NULL)),
quote(-dur(a)))
expect_equal(.changeDropNullLine(quote(dur(a) ~ NULL)),
quote(-dur(a)))
expect_equal(.changeDropNullLine(str2lang("dur(a) = NULL")),
quote(-dur(a)))
expect_equal(.changeDropNullLine(quote(a(0) <- NULL)),
quote(-a(0)))
expect_equal(.changeDropNullLine(quote(a(0) ~ NULL)),
quote(-a(0)))
expect_equal(.changeDropNullLine(str2lang("a(0) = NULL")),
quote(-a(0)))
})
test_that("test fix/unfix for eta", {
expect_equal(testPipeQuote(a~fix),
list(quote(a<-fix)))
expect_equal(testPipeQuote(a~unfix),
list(quote(a<-unfix)))
})
test_that("test as formula", {
expect_equal(testPipeQuote(as.formula(a~b)),
list(quote(a~b)))
})
test_that("test of standard quoting of piping arguments", {
expect_equal(testPipeQuote(-ka, tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
cl = exp(tcl + eta.cl)
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, "tv10=3"), list(quote(-ka),
quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(cl <- exp(tcl + eta.cl)),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(tv10 <- 3)))
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2)))
expect_equal(testPipeQuote({
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2),
list(quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2)))
# Test c()
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, c(tka=1, tv=3, tcl=4)),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(tka <- 1),
quote(tv <- 3),
quote(tcl <- 4))
)
# test list()
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, list(tka=1, tv=3, tcl=4)),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(tka <- 1),
quote(tv <- 3),
quote(tcl <- 4))
)
.tmp <- list(tcl = 3, tv = 4)
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, .tmp),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(tcl <- 3),
quote(tv <- 4))
)
.tmp <- c(tcl = 3, tv = 4)
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, .tmp),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(tcl <- 3),
quote(tv <- 4))
)
.tmp <- quote({
ka = exp(tka)
})
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, .tmp),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(ka <- exp(tka)))
)
.tmp <- quote(ka <- 8)
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, .tmp),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(ka <- 8))
)
.tmp <- quote(ka4 ~ 8)
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, .tmp),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(ka4 ~ 8))
)
.tmp <- quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1))))
expect_equal(testPipeQuote(tka=0.5, {
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.ka ~ 3, eta.ka ~ 3,
{
tv = 3
tcl = 10
eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1)))
}, eta.v ~ 0.2, .tmp),
list(quote(tka <- 0.5),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.ka ~ 3),
quote(eta.ka ~ 3),
quote(tv <- 3),
quote(tcl <- 10),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))),
quote(eta.v ~ 0.2),
quote(eta.v + eta.cl ~ unfix(cor(sd(0.3, 0.02, 0.1)))))
)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, assign", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
f(depot) <- 3
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, lower case f()", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
})
one.compartment <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
F(depot) <- 3
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, upper case F()", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
lag(depot) <- 3
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, lag()", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
alag(depot) <- 3
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, alag()", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
rate(depot) <- 3
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, rate()", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
dur(depot) <- 3
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, dur()", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), 6L)
expect_equal(.getModelLineFromExpression(quote(not), f), NA_integer_)
})
# look at duplicate lines
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d/dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, duplicate d/dt(depot)", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), NULL)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -5L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -5L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -5L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -5L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -5L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -5L)
expect_equal(.getModelLineFromExpression(quote(not), f), NA_integer_)
})
# look at duplicate lines
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
f(depot) <- 3
F(depot) <- 1
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, duplicate f(depot)", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), NULL)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), NULL)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(not), f), NA_integer_)
})
# look at duplicate lag()
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
lag(depot) <- 3
alag(depot) <- 1
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("Model Line from Expression, duplicate f(depot)", {
expect_equal(.getModelLineFromExpression(quote(ka), f), 1L)
expect_equal(.getModelLineFromExpression(quote(d/dt(depot)), f), 4L)
expect_equal(.getModelLineFromExpression(quote(f(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(F(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(lag(depot)), f), NULL)
expect_equal(.getModelLineFromExpression(quote(alag(depot)), f), NULL)
expect_equal(.getModelLineFromExpression(quote(rate(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(dur(depot)), f), -4L)
expect_equal(.getModelLineFromExpression(quote(not), f), NA_integer_)
expect_equal(.getModelLineFromExpression(quote(cp), f), 8L)
expect_equal(.getModelLineFromExpression(quote(cp), f, TRUE), 9L)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
testEst <- function(ui, par, lower, value, upper, fix=FALSE) {
uiForce <- suppressMessages(force(ui))
.ini <- ui$iniDf
.w <- which(.ini$name == par)
expect_equal(length(.w), 1)
expect_equal(.ini$lower[.w], lower)
expect_equal(.ini$est[.w], value)
expect_equal(.ini$upper[.w], upper)
expect_equal(.ini$fix[.w], fix)
}
test_that("simple ini piping, uncorrelated model", {
testEst(f, "tka", -Inf, 0.45, Inf, FALSE)
testEst(f %>% ini(tka=0.5), "tka", -Inf, 0.5, Inf, FALSE)
testEst(f %>% ini(tka=fix), "tka", -Inf, 0.45, Inf, TRUE)
testEst(f %>% ini(tka=c(0, 0.5)), "tka", 0, 0.5, Inf, FALSE)
testEst(f %>% ini(tka=c(0, 0.5, 1)), "tka", 0, 0.5, 1, FALSE)
expect_error(f %>% ini(tka=c(0, 0.5, 1, 4)), "tka")
expect_error(f %>% ini(tka=c(3,2,1)), "tka")
suppressMessages(
fFix <- f %>% ini(tka=fix)
)
testEst(fFix, "tka", -Inf, 0.45, Inf, TRUE)
testEst(fFix %>% ini(tka=unfix), "tka", -Inf, 0.45, Inf, FALSE)
testEst(fFix %>% ini(tka=unfix(0.5)), "tka", -Inf, 0.5, Inf, FALSE)
testEst(f %>% ini(eta.v ~ 0.2), "eta.v", -Inf, 0.2, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "eta.cl", -Inf, 0.3, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "eta.v", -Inf, 0.1, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "(eta.cl,eta.v)", -Inf, 0.02, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "eta.cl", -Inf, 0.3, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "eta.v", -Inf, 0.1, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "(eta.cl,eta.v)", -Inf, 0.02*(sqrt(0.3)*sqrt(0.1)), Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "eta.cl", -Inf, 0.3 * 0.3, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "eta.v", -Inf, 0.1 * 0.1, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "(eta.cl,eta.v)", -Inf, 0.1 * 0.3 * 0.02, Inf, TRUE)
# Test adding matrix directly
.omega <- lotri::lotri(eta.cl+eta.v~c(0.3, 0.02, 0.1))
testEst(f %>% ini(.omega), "eta.cl", -Inf, 0.3, Inf, FALSE)
testEst(f %>% ini(.omega), "eta.v", -Inf, 0.1, Inf, FALSE)
testEst(f %>% ini(.omega), "(eta.cl,eta.v)", -Inf, 0.02, Inf, FALSE)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "eta.cl", -Inf, 0.3 * 0.3, Inf, FALSE),
regexp="unfix.*eta.cl"), regexp="unfix.*eta.v"
)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "eta.v", -Inf, 0.1 * 0.1, Inf, FALSE),
regexp="unfix.*eta.cl"), regexp="unfix.*eta.v"
)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "(eta.cl,eta.v)", -Inf, 0.1 * 0.3 * 0.02, Inf, FALSE),
regexp="unfix.*eta.cl"), regexp="unfix.*eta.v"
)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl + eta.v ~ sd(cor(0.3,
-0.7, 0.1))
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("simple ini piping, correlated model", {
testEst(f, "tka", -Inf, 0.45, Inf, FALSE)
testEst(f %>% ini(tka=0.5), "tka", -Inf, 0.5, Inf, FALSE)
testEst(f %>% ini(tka=fix), "tka", -Inf, 0.45, Inf, TRUE)
testEst(f %>% ini(tka=c(0, 0.5)), "tka", 0, 0.5, Inf, FALSE)
testEst(f %>% ini(tka=c(0, 0.5, 1)), "tka", 0, 0.5, 1, FALSE)
expect_error(f %>% ini(tka=c(0, 0.5, 1, 4)), "tka")
expect_error(f %>% ini(tka=c(3,2,1)), "tka")
suppressMessages(
fFix <- f %>% ini(tka=fix)
)
testEst(fFix, "tka", -Inf, 0.45, Inf, TRUE)
testEst(fFix %>% ini(tka=unfix), "tka", -Inf, 0.45, Inf, FALSE)
testEst(fFix %>% ini(tka=unfix(0.5)), "tka", -Inf, 0.5, Inf, FALSE)
testEst(f %>% ini(eta.v ~ 0.2), "eta.v", -Inf, 0.2, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "eta.cl", -Inf, 0.3, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "eta.v", -Inf, 0.1, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "(eta.cl,eta.v)", -Inf, 0.02, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "eta.cl", -Inf, 0.3, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "eta.v", -Inf, 0.1, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "(eta.cl,eta.v)", -Inf, 0.02*(sqrt(0.3)*sqrt(0.1)), Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "eta.cl", -Inf, 0.3 * 0.3, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "eta.v", -Inf, 0.1 * 0.1, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "(eta.cl,eta.v)", -Inf, 0.1 * 0.3 * 0.02, Inf, TRUE)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "eta.cl", -Inf, 0.3 * 0.3, Inf, FALSE),
regexp="unfix.*eta.cl"), regexp="unfix.*eta.v"
)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "eta.v", -Inf, 0.1 * 0.1, Inf, FALSE),
regexp="unfix.*eta.cl"), regexp="unfix.*eta.v"
)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "(eta.cl,eta.v)", -Inf, 0.1 * 0.3 * 0.02, Inf, FALSE),
regexp="unfix.*eta.cl"), regexp="unfix.*eta.v"
)
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl + eta.v ~ fix(sd(cor(0.3,
-0.7, 0.1)))
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("simple ini piping, fixed correlated model", {
testEst(f, "tka", -Inf, 0.45, Inf, FALSE)
testEst(f %>% ini(tka=0.5), "tka", -Inf, 0.5, Inf, FALSE)
testEst(f %>% ini(tka=fix), "tka", -Inf, 0.45, Inf, TRUE)
testEst(f %>% ini(tka=c(0, 0.5)), "tka", 0, 0.5, Inf, FALSE)
testEst(f %>% ini(tka=c(0, 0.5, 1)), "tka", 0, 0.5, 1, FALSE)
expect_error(f %>% ini(tka=c(0, 0.5, 1, 4)), "tka")
expect_error(f %>% ini(tka=c(3,2,1)), "tka")
suppressMessages(
fFix <- f %>% ini(tka=fix)
)
testEst(fFix, "tka", -Inf, 0.45, Inf, TRUE)
testEst(fFix %>% ini(tka=unfix), "tka", -Inf, 0.45, Inf, FALSE)
testEst(fFix %>% ini(tka=unfix(0.5)), "tka", -Inf, 0.5, Inf, FALSE)
# should warn? Modify fixed value
testEst(f %>% ini(eta.v ~ 0.2), "eta.v", -Inf, 0.2, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "eta.cl", -Inf, 0.3, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "eta.v", -Inf, 0.1, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1)), "(eta.cl,eta.v)", -Inf, 0.02, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "eta.cl", -Inf, 0.3, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "eta.v", -Inf, 0.1, Inf, TRUE)
testEst(f %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1)), "(eta.cl,eta.v)", -Inf, 0.02*(sqrt(0.3)*sqrt(0.1)), Inf, TRUE)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "eta.cl", -Inf, 0.3 * 0.3, Inf, TRUE),
regexp="fix.*eta.cl"), regexp="fix.*eta.v"
)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "eta.v", -Inf, 0.1 * 0.1, Inf, TRUE),
regexp="fix.*eta.cl"), regexp="fix.*eta.v"
)
expect_warning(expect_warning(
testEst(f %>% ini(eta.cl+eta.v~fix(cor(sd(0.3,0.02,0.1)))), "(eta.cl,eta.v)", -Inf, 0.1 * 0.3 * 0.02, Inf, TRUE),
regexp="fix.*eta.cl"), regexp="fix.*eta.v"
)
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "eta.cl", -Inf, 0.3 * 0.3, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "eta.v", -Inf, 0.1 * 0.1, Inf, FALSE)
testEst(f %>% ini(eta.cl+eta.v~unfix(cor(sd(0.3,0.02,0.1)))), "(eta.cl,eta.v)", -Inf, 0.1 * 0.3 * 0.02, Inf, FALSE)
})
# %>% ini(tka=0.5)
# %>% ini(tka=fix)
# %>% ini(tka=unfix)
# %>% ini(eta.v~0.2)
# Try with |>
# %>% ini(eta.cl+eta.v~c(0.3, 0.02, 0.1))
# %>% ini(eta.cl+eta.v~cor(0.3, 0.02, 0.1))
# %>% ini(eta.v+eta.cl~fix(cor(sd(0.3,0.02,0.1))))
# %>% ini(eta.v+eta.cl~unfix(cor(sd(0.3,0.02,0.1))))
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
testUi <- function(ui, has = NULL, exclude = NULL, values = NULL) {
uiForce <- suppressMessages(force(ui))
if (!is.null(has)) {
expect_true(all(has %in% paste(uiForce$ini$name)))
}
if (!is.null(values) && !is.null(names(values))) {
.vals <- setNames(uiForce$ini$est, paste(uiForce$ini$name))
.vals <- .vals[names(values)]
expect_equal(values, .vals)
}
if (!is.null(exclude)) {
expect_false(any(exclude %in% paste(uiForce$ini$name)))
}
## General UI properties
expect_true(all(!is.na(uiForce$ini$fix)))
expect_true(all(!is.na(uiForce$ini$lower)))
expect_true(all(!is.na(uiForce$ini$upper)))
}
test_that("update: Test Base model", {
testUi(f, c("tka", "tcl", "tv", "eta.ka", "eta.cl", "eta.v", "add.err"),
"matt", c(tka = 0.45, tcl = 1, tv = 3.45, eta.ka = 0.6, eta.cl = 0.3, eta.v = 0.1, add.err = 0.7))
})
test_that("UI updates work correctly", {
# context("update: Multiple component change with c()")
testUi(
f %>% update(tka = 4, cl = exp(tcl), ka = exp(tka), c(tcl = 3, tv = 4)),
c("tka", "tcl", "tv", "eta.v", "add.err"),
c("eta.ka", "eta.cl"),
c(tka = 4, tcl = 3, tv = 4, eta.v = 0.1, add.err = 0.7)
)
# context("update: Multiple component change with list()")
testUi(
f %>% update(tka = 4, cl = exp(tcl), ka = exp(tka), list(tcl = 3, tv = 4)),
c("tka", "tcl", "tv", "eta.v", "add.err"),
c("eta.ka", "eta.cl"),
c(tka = 4, tcl = 3, tv = 4, eta.v = 0.1, add.err = 0.7)
)
# context("update: Multiple component change with assigned .tmp=list()")
.tmp <- list(tcl = 3, tv = 4)
testUi(
f %>% update(tka = 4, cl = exp(tcl), ka = exp(tka), .tmp),
c("tka", "tcl", "tv", "eta.v", "add.err"),
c("eta.ka", "eta.cl"),
c(tka = 4, tcl = 3, tv = 4, eta.v = 0.1, add.err = 0.7)
)
# context("update: Multiple component change with assigned .tmp=c()")
.tmp <- c(tcl = 3, tv = 4)
testUi(
f %>% update(tka = 4, cl = exp(tcl), ka = exp(tka), .tmp),
c("tka", "tcl", "tv", "eta.v", "add.err"),
c("eta.ka", "eta.cl"),
c(tka = 4, tcl = 3, tv = 4, eta.v = 0.1, add.err = 0.7)
)
# context("update: Multiple component change with assigned .tmp={}")
.tmp <- quote({
ka <- exp(tka)
})
testUi(
f %>% update(tka = 4, cl = exp(tcl), .tmp, c(tcl = 3, tv = 4)),
c("tka", "tcl", "tv", "eta.v", "add.err"),
c("eta.ka", "eta.cl"),
c(tka = 4, tcl = 3, tv = 4, eta.v = 0.1, add.err = 0.7)
)
testUi(
f %>% update(
tka = 4,
cl = exp(tcl),
{
ka <- exp(tka)
},
c(tcl = 3, tv = 4)
),
c("tka", "tcl", "tv", "eta.v", "add.err"),
c("eta.ka", "eta.cl"),
c(tka = 4, tcl = 3, tv = 4, eta.v = 0.1, add.err = 0.7)
)
testUi(
f %>% update(ka = exp(tka)),
c("tka", "tcl", "tv", "eta.cl", "eta.v", "add.err"),
"eta.ka", c(tka = 0.45, tcl = 1, tv = 3.45, eta.cl = 0.3, eta.v = 0.1, add.err = 0.7)
)
## Now test linCmt() issue #166
one.cmt <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
linCmt() ~ add(add.err)
})
}
suppressMessages(
.ui <- one.cmt %>% update({
linCmt() ~ add(add.err) + prop(prop.err)
})
)
expect_s3_class(.ui, "rxUi")
})
# piping looks through parent environments
test_that("Looks through prior frames for the correct object", {
fit <- rxode2(one.compartment)
fits <- lapply(seq(-1, -0.1, 0.1), function(kainit) {
suppressMessages(
rxode2(update(fit, tka = kainit))
)
})
expect_type(fits, "list")
expect_error(lapply(seq(-1, -0.1, 0.1), function(kainit) {
suppressMessages(
rxode2(update(fit, tka = matt))
)
}))
})
one.compartment <- function() {
ini({
tka <- 0.45 ; label("Log Ka")
tcl <- 1 ; label("Log Cl")
tv <- 3.45 ; label("Log V")
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
test_that("piping works for correlations #1", {
testUi(f %>% ini(eta.ka + eta.cl ~ c(
0.2,
0.01, 0.2
)),
has = c("tka", "tcl", "tv", "eta.ka", "eta.cl", "eta.v", "add.err", "(eta.ka,eta.cl)"),
exclude = "matt",
values = c(
tka = 0.45, tcl = 1, tv = 3.45, eta.ka = 0.2, eta.cl = 0.2, eta.v = 0.1, add.err = 0.7,
`(eta.ka,eta.cl)` = 0.01
)
)
})
test_that("piping works for correlations #2", {
suppressMessages(
expect_error(
f %>%
ini(eta.ka + eta.matt ~ c(0.2,
0.01, 0.2)
)
)
)
})
test_that("piping works for correlations #3", {
testUi(
f %>% update(eta.ka + eta.cl ~ c(
0.2,
0.01, 0.2
)),
c("tka", "tcl", "tv", "eta.ka", "eta.cl", "eta.v", "add.err", "(eta.ka,eta.cl)"),
"matt", c(
tka = 0.45, tcl = 1, tv = 3.45, eta.ka = 0.2, eta.cl = 0.2, eta.v = 0.1, add.err = 0.7,
`(eta.ka,eta.cl)` = 0.01
)
)
})
test_that("piping works for correlations #4", {
suppressMessages(
expect_error(
f %>%
update(eta.ka + eta.matt ~ c(0.2,
0.01, 0.2)
)
)
)
})
test_that("expected piping errors", {
f <- function() {
ini({
ke <- 0.5
eta.ke ~ 0.04
prop.sd <- sqrt(0.1)
})
model({
ke <- ke * exp(eta.ke)
ipre <- 10 * exp(-ke * t)
ipre ~ prop(prop.sd)
})
}
f <- rxode2::rxode2(f)
suppressMessages(
expect_error(f %>% model(ipre ~ add(add.sd)) %>% ini(add.sd=sqrt(0.1)), NA)
)
})
test_that("new ipre", {
f <- function() {
ini({
tke <- 0.5
eta.ke ~ 0.04
prop.sd <- sqrt(0.1)
})
model({
ke <- tke * exp(eta.ke)
ipre <- 10 * exp(-ke * t)
f2 <- ipre / (ipre + 5)
ipre ~ prop(prop.sd)
})
}
f <- rxode2(f)
trans <- function(f) {
suppressMessages(
f %>% model(ipre ~ propF(prop.sd, f2)) %>% ini(prop.sd=sqrt(0.1))
)
}
f2 <- trans(f)
expect_true(!any(f2$iniDf$name %in% c("f2")))
})
test_that("piping looks in the right environment for variables with fix()", {
f <- function() {
ini({
tke <- 0.5
eta.ke ~ 0.04
prop.sd <- sqrt(0.1)
})
model({
ke <- tke * exp(eta.ke)
ipre <- 10 * exp(-ke * t)
f2 <- ipre / (ipre + 5)
ipre ~ prop(prop.sd)
})
}
intke <- 5
suppressMessages(
tmp <- f %>% ini(tke=fix(intke))
)
expect_true(tmp$iniDf[tmp$iniDf$name == "tke","fix"])
expect_equal(tmp$iniDf[tmp$iniDf$name == "tke","est"], 5)
rm(list="intke")
f2 <- function() {
f <- function() {
ini({
tke <- 0.5
eta.ke ~ 0.04
prop.sd <- sqrt(0.1)
})
model({
ke <- tke * exp(eta.ke)
ipre <- 10 * exp(-ke * t)
f2 <- ipre / (ipre + 5)
ipre ~ prop(prop.sd)
})
}
intke <- 5
f %>% ini(tke=fix(intke))
}
suppressMessages(
tmp <- f2()
)
expect_true(tmp$iniDf[tmp$iniDf$name == "tke","fix"])
expect_equal(tmp$iniDf[tmp$iniDf$name == "tke","est"], 5)
expect_false(any(ls() == "intke"))
})
test_that("invalid model pipe (more arguments than expected) throws an error", {
f <- function() {
ini({
tke <- 0.5
eta.ke ~ 0.04
prop.sd <- sqrt(0.1)
})
model({
ke <- tke * exp(eta.ke)
ipre <- 10 * exp(-ke * t)
f2 <- ipre / (ipre + 5)
f3 <- f2 * 3
lipre <- log(ipre)
ipre ~ prop(prop.sd)
})
}
expect_error(f %>% model(ipre~prop(f2,f3,c)))
})
test_that("Add an eta to a model that does not have an eta will work", {
ocmt <- function() {
ini({
tka <- exp(0.45)
tcl <- exp(1)
tv <- exp(3.45)
add.sd <- 0.7
})
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
cp ~ add(add.sd)
})
}
suppressMessages(
expect_error(
ocmt %>%
model(ka <- exp(tka + eta.ka)),
NA
)
)
})
test_that("Add covariate to model works", {
ocmt <- function() {
ini({
tka <- exp(0.45)
tcl <- exp(1)
tv <- exp(3.45)
add.sd <- 0.7
})
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
cp ~ add(add.sd)
})
}
suppressMessages(
expect_error(
ocmt %>%
model(ka <- exp(tka + covKa * wt + eta.ka)),
NA
)
)
suppressMessages(
tmp <-
ocmt %>%
model(ka <- exp(tka + covKaWt * wt + eta.ka))
)
expect_equal(tmp$allCovs, "wt")
expect_true("covKaWt" %in% tmp$iniDf$name)
expect_true("tka" %in% tmp$iniDf$name)
expect_true("eta.ka" %in% tmp$iniDf$name)
suppressMessages(
tmp <-
ocmt %>%
model(ka <- exp(covKaWt * wt + eta.ka))
)
expect_equal(tmp$allCovs, "wt")
expect_true("covKaWt" %in% tmp$iniDf$name)
expect_false("tka" %in% tmp$iniDf$name)
expect_true("eta.ka" %in% tmp$iniDf$name)
suppressMessages(
tmp <-
tmp %>%
model(ka <- exp(tka + covKaWt * wt + eta.ka))
)
expect_equal(tmp$allCovs, "wt")
expect_true("covKaWt" %in% tmp$iniDf$name)
expect_true("tka" %in% tmp$iniDf$name)
expect_true("eta.ka" %in% tmp$iniDf$name)
})
test_that("Appending or pre-pending items to a model works", {
ocmt <- function() {
ini({
tka <- exp(0.45)
tcl <- exp(1)
tv <- exp(3.45)
add.sd <- 0.7
})
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
cp ~ add(add.sd)
})
}
f <- rxode2(ocmt)
f2 <- f %>% model(cp1 <- cp, append=TRUE)
expect_true("cp1" %in% f2$mv0$lhs)
expect_equal(f2$lstExpr[[length(f2$lstExpr)]], quote(cp1 <- cp))
f <- rxode2(ocmt)
f2 <- f %>% model(cp1 <- cp, append=Inf)
expect_true("cp1" %in% f2$mv0$lhs)
expect_equal(f2$lstExpr[[length(f2$lstExpr)]], quote(cp1 <- cp))
f <- rxode2(ocmt)
f2 <- f %>% model(cp1 <- cp, append=100)
expect_true("cp1" %in% f2$mv0$lhs)
expect_equal(f2$lstExpr[[length(f2$lstExpr)]], quote(cp1 <- cp))
f2 <- f %>% model(f2 <- 3 * 2, append=NA)
expect_true("f2" %in% f2$mv0$lhs)
expect_equal(f2$lstExpr[[1]], quote(f2 <- 3 * 2))
})
test_that("ini promotion works", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
add.sd <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
cp ~ add(add.sd)
})
}
f <- rxode2(ocmt)
expect_equal(f$allCovs, c("eta.ka", "eta.cl", "tv", "eta.v"))
expect_equal(f$theta, c(tka=0.45, tcl=1, add.sd=0.7))
expect_equal(f$omega, NULL)
# now promote tv
suppressMessages(
f2 <- f %>% ini(tv=0.5)
)
expect_equal(f2$allCovs, c("eta.ka", "eta.cl", "eta.v"))
expect_equal(f2$theta, c(tka=0.45, tcl=1, add.sd=0.7, tv=0.5))
expect_equal(f2$omega, NULL)
# now promote eta.ka
suppressMessages(
f3 <- f2 %>% ini(eta.ka ~ 0.01)
)
expect_equal(f3$allCovs, c("eta.cl", "eta.v"))
expect_equal(f3$theta, c(tka=0.45, tcl=1, add.sd=0.7, tv=0.5))
expect_equal(f3$omega, matrix(0.01, dimnames=list("eta.ka", "eta.ka")))
# now promote a correlation between eta.cl and eta.v
suppressMessages(
f4 <- f2 %>% ini(eta.cl + eta.v ~ c(1,
0.01, 1))
)
expect_equal(f4$allCovs, "eta.ka")
expect_equal(f4$theta, c(tka=0.45, tcl=1, add.sd=0.7, tv=0.5))
expect_equal(f4$omega, lotri(eta.cl + eta.v ~ c(1,
0.01, 1)))
# Now promote independent eta block
suppressMessages(
f5 <- f3 %>% ini(eta.cl + eta.v ~ c(1,
0.01, 1))
)
expect_length(f5$allCovs, 0)
expect_equal(f5$theta, c(tka=0.45, tcl=1, add.sd=0.7, tv=0.5))
expect_equal(f5$omega, lotri(eta.ka ~ 0.01,
eta.cl + eta.v ~ c(1,
0.01, 1)))
# Now promote eta block that includes prior eta information
suppressMessages(
f6 <- f3 %>% ini(eta.ka + eta.cl + eta.v ~ c(1,
0.01, 1,
-0.01, 0.01, 1))
)
expect_length(f6$allCovs, 0)
expect_equal(f6$theta, c(tka=0.45, tcl=1, add.sd=0.7, tv=0.5))
expect_equal(f6$omega, lotri(eta.ka + eta.cl + eta.v ~ c(1,
0.01, 1,
-0.01, 0.01, 1)))
})
test_that("Ignoring auto-selected parameter types work", {
ocmt <- function() {
ini({
tka <- exp(0.45)
tcl <- exp(1)
eta.v ~ 0.01
add.sd <- 0.7
})
model({
ka <- tka
cl <- tcl
v <- eta.v
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
cp ~ add(add.sd)
})
}
suppressWarnings(
f <- rxode2(ocmt)
)
expect_equal(f$allCovs, character(0))
expect_equal(f$theta, c(tka=exp(0.45), tcl=exp(1), add.sd=0.7))
expect_equal(f$omega, matrix(0.01, dimnames=list("eta.v", "eta.v")))
suppressMessages(suppressWarnings(
f2 <- f %>% model(ka <- tka * exp(eta.ka), auto=FALSE)
))
expect_equal(f2$allCovs, "eta.ka")
expect_equal(f2$theta, c(tka=exp(0.45), tcl=exp(1), add.sd=0.7))
expect_equal(f2$omega, matrix(0.01, dimnames=list("eta.v", "eta.v")))
suppressMessages(suppressWarnings(
f2 <-
f %>%
model(ka <- tka * exp(eta.ka), auto=FALSE) %>%
ini(eta.ka ~ 0.02)
))
expect_equal(f2$allCovs, character(0))
expect_equal(f2$theta, c(tka=exp(0.45), tcl=exp(1), add.sd=0.7))
expect_equal(f2$omega, lotri(eta.v ~ 0.01,
eta.ka ~ 0.02))
suppressMessages(suppressWarnings(
f2 <- f %>% model(v <- tv + eta.v, auto=FALSE)
))
expect_equal(f2$allCovs, "tv")
expect_equal(f2$theta, c(tka=exp(0.45), tcl=exp(1), add.sd=0.7))
expect_equal(f2$omega, lotri(eta.v ~ 0.01))
suppressMessages(suppressWarnings(
f2 <- f %>% model(v <- tv + eta.v, auto=FALSE) %>%
ini(tv=0.2)
))
expect_equal(f2$allCovs, character(0))
expect_equal(f2$theta, c(tka=exp(0.45), tcl=exp(1), add.sd=0.7, tv=0.2))
expect_equal(f2$omega, lotri(eta.v ~ 0.01))
})
test_that("Ignoring auto-selected parameter types work", {
ocmt <- function() {
ini({
tka <- exp(0.45)
tcl <- exp(1)
eta.v ~ 0.01
add.sd <- 0.7
tprop <- 0.5
prop.eta ~ 0.01
})
model({
ka <- tka
cl <- tcl
v <- eta.v
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
prop.sd <- exp(tprop + prop.eta)
cp ~ add(add.sd)
})
}
suppressWarnings(
f1 <- ocmt()
)
suppressWarnings(
f2 <- ocmt %>% model(cp ~ add(add.sd) + prop(prop.sd))
)
expect_equal(f2$theta, f1$theta)
expect_equal(f2$omega, f1$omega)
})
test_that("Pre-declaring list of covariates works", {
rxSetCovariateNamesForPiping(c("WT","HT", "TC"))
# Note this is case sensitive
one.compartment <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d/dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
# now TC is detected as a covariate instead of a population parameter
suppressMessages(
mod <-
one.compartment %>%
model({ka <- exp(tka + eta.ka + TC * cov_C)})
)
expect_true("cov_C" %in% mod$iniDf$name)
expect_false("TC" %in% mod$iniDf$name)
rxSetCovariateNamesForPiping()
suppressMessages(
mod <-
one.compartment %>%
model({ka <- exp(tka + eta.ka + TC * cov_C)})
)
expect_true("cov_C" %in% mod$iniDf$name)
expect_true("TC" %in% mod$iniDf$name)
})
})
test_that("eff(0) piping should work", {
mod1 <- rxode2({
C2 <- centr/V2
C3 <- peri/V3
d/dt(depot) <- -KA*depot
d/dt(centr) <- KA*depot - CL*C2 - Q*C2 + Q*C3
d/dt(peri) <- Q*C2 - Q*C3
d/dt(eff) <- Kin - Kout*(1-C2/(EC50+C2))*eff
})
suppressMessages(
expect_error(
mod1 %>%
model(KA<-exp(tka+eta.ka), append=NA) %>% # Prepend a line by append=NA
ini(tka=log(2.94E-01),
eta.ka=0.2,
CL=1.86E+01, V2=4.02E+01, # central
Q=1.05E+01, V3=2.97E+02, # peripheral
Kin=1, Kout=1, EC50=200) %>%
model(eff(0) <- 1),
NA
)
)
})
test_that("auto with studid==", {
one.compartment <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.sd <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv+eta.v)
cp <- linCmt()
cp ~ add(add.sd)
})
}
i <- rxode2(one.compartment)
j <- i %>%
model({
f(central) <- 1 + f_study1*(STUDYID==1)
},
append=NA,
auto=FALSE)
expect_false(any(j$iniDf$name == "f_study1"))
expect_false(any(j$iniDf$name == "STUDYID"))
})
test_that("piping with append=lhs", {
ocmt_rx0 <- rxode2( {
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
m1 <- ocmt_rx0 %>% model( cl <- tvcl*2, append = NA)
expect_true(identical(m1$lstExpr[[1]], quote(cl <- tvcl * 2)))
m2 <- ocmt_rx0 %>% model( cl <- tvcl*2, append = d/dt(depot))
expect_true(identical(m2$lstExpr[[2]], quote(cl <- tvcl * 2)))
expect_error(ocmt_rx0 %>% model( cl <- tvcl*2, append = notFound))
m3 <- ocmt_rx0 %>% model( cl <- tvcl*2, append = cp)
expect_true(identical(m3$lstExpr[[4]], quote(cl <- tvcl * 2)))
test_that("piping ui functions", {
m1 <- function() {
ini({
tka <- 0.463613555325211
label("Ka")
tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)
label("Log Cl")
tv <- 3.46039743010498
label("log V")
add.sd <- c(0, 0.694761430696633)
eta.ka ~ 0.400673718508127
eta.cl ~ 0.069154564934726
eta.v ~ 0.0191298379535425
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
linCmt() ~ add(add.sd)
})
}
m1 <- m1()
m2 <- function() {
ini({
tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)
label("Log Cl")
tv <- 3.46039743010498
label("log V")
add.sd <- c(0, 0.694761430696633)
eta.cl ~ 0.069154564934726
eta.v ~ 0.0191298379535425
})
model({
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
linCmt() ~ add(add.sd)
})
}
m2 <- m2()
expect_equal(testPipeQuote(m1, iniDf=m2$iniDf),
list(quote(tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)),
quote(tv <- 3.46039743010498),
quote(add.sd <- c(0, 0.694761430696633)),
quote(eta.cl ~ 0.069154564934726),
quote(eta.v ~ 0.0191298379535425)))
expect_equal(testPipeQuote(m2, iniDf=m1$iniDf),
list(quote(tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)),
quote(tv <- 3.46039743010498),
quote(add.sd <- c(0, 0.694761430696633)),
quote(eta.cl ~ 0.069154564934726),
quote(eta.v ~ 0.0191298379535425)))
m4 <- function() {
ini({
tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)
label("Log Cl")
tv <- 3.46039743010498
label("log V")
add.sd <- c(0, 0.694761430696633)
eta..cl ~ 0.069154564934726
eta..v ~ 0.0191298379535425
})
model({
cl <- exp(tcl + eta..cl)
v <- exp(tv + eta..v)
linCmt() ~ add(add.sd)
})
}
# no etas
m4 <- m4()
expect_equal(testPipeQuote(m4, iniDf=m1$iniDf),
list(quote(tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)),
quote(tv <- 3.46039743010498),
quote(add.sd <- c(0, 0.694761430696633))))
expect_equal(testPipeQuote(m1, iniDf=m4$iniDf),
list(quote(tcl <- c(-Inf, 1.01211464338867, 4.60517018598809)),
quote(tv <- 3.46039743010498),
quote(add.sd <- c(0, 0.694761430696633))))
# no thetas
m5 <- function() {
ini({
t.cl <- c(-Inf, 1.01211464338867, 4.60517018598809)
label("Log Cl")
t.v <- 3.46039743010498
label("log V")
add..sd <- c(0, 0.694761430696633)
eta.cl ~ 0.069154564934726
eta.v ~ 0.0191298379535425
})
model({
cl <- exp(t.cl + eta.cl)
v <- exp(t.v + eta.v)
linCmt() ~ add(add..sd)
})
}
m5 <- m5()
expect_equal(testPipeQuote(m5, iniDf=m1$iniDf),
list(quote(eta.cl ~ 0.069154564934726),
quote(eta.v ~ 0.0191298379535425)))
expect_equal(testPipeQuote(m1, iniDf=m5$iniDf),
list(quote(eta.cl ~ 0.069154564934726),
quote(eta.v ~ 0.0191298379535425)))
m6 <- function() {
ini({
t.cl <- c(-Inf, 1.01211464338867, 4.60517018598809)
label("Log Cl")
t.v <- 3.46039743010498
label("log V")
add..sd <- c(0, 0.694761430696633)
eta..cl ~ 0.069154564934726
eta..v ~ 0.0191298379535425
})
model({
cl <- exp(t.cl + eta..cl)
v <- exp(t.v + eta..v)
linCmt() ~ add(add..sd)
})
}
m6 <- m6()
expect_equal(testPipeQuote(m6, iniDf=m1$iniDf),
list())
expect_equal(testPipeQuote(m1, iniDf=m6$iniDf),
list())
})
test_that("model piping that shares err parameter#427", {
u <- function() {
ini({
b <- 3
err.sd <- 2
})
model({
a <- x + err.sd
c <- 1+b
c ~ add(err.sd)
})
}
expect_error(u %>% model(-a), NA)
})
test_that("adding a constant does not add to the ini block", {
u <- function() {
ini({
b <- 3
err.sd <- 2
})
model({
a <- x + err.sd
c <- 1+b
c ~ add(err.sd)
})
}
n <- u %>% model(aa <- pi+4, append=c)
expect_false(any(n$iniDf$name == "pi"))
})
test_that("adding a line with a defined constant doesn't add to ini()", {
u <- function() {
ini({
b <- 3
err.sd <- 2
})
model({
a <- x + err.sd
aa <- 3
c <- 1+b
c ~ add(err.sd)
})
}
n <- u %>% model(aaa <- aa+4, append=c)
expect_false(any(n$iniDf$name == "aa"))
})
})
test_that("test ui appending of derived variables like `sim` can work", {
one.compartment <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.6
eta.cl ~ 0.3
eta.v ~ 0.1
add.err <- 0.7
})
model({
ka <- exp(tka + eta.ka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d / dt(depot) <- -ka * depot
d / dt(center) <- ka * depot - cl / v * center
cp <- center / v
cp ~ add(add.err)
})
}
f <- rxode2(one.compartment)
expect_error(model(f$simulationModel, sim2=sim+1, append=sim), NA)
})
test_that("off-diagonal piping issue #518", {
mod <- function() {
ini({
a <- 1
b <- 2
etaa + etab ~ c(3, 0.1, 4)
c <- 5
etac ~ 6
d <- 7
f <- 9
etad + etaf ~ c(8, 0.2, 10)
})
model({
g <- (a + etaa)/(b + etab)
h <- (c + etac)
i <- (d + etad)
j <- f + etaf
})
}
modNew <-
ini(
rxode2(mod),
etab + etac + etad ~
c(7,
0.2, 8,
0.3, 0.4, 9),
etaa ~ 0
)
expect_error(modNew$omega, NA)
})
test_that("piping append", {
mod <- function() {
ini({
tka <- 0.45
label("Ka")
tcl <- 1
label("Cl")
tv <- 3.45
label("V")
add.sd <- c(0, 0.7)
eta.cl ~ 0.3
eta.v ~ 0.1
})
model({
ka <- exp(tka)
cl <- exp(tcl + eta.cl)
v <- exp(tv + eta.v)
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl/v * center
cp = center/v
cp ~ add(add.sd)
})
}
t <- c("-cp","-d/dt(depot)")
expect_error(mod |> model(t), NA)
t <- c("cp <- NULL","d/dt(depot) = NULL")
expect_error(mod |> model(t), NA)
t <- c("cp <- NULL","d/dt(depot) ~ NULL")
expect_error(mod |> model(t), NA)
mod5 <- mod |>
model({
PD <- 1-emax*cp/(ec50+cp)
##
effect(0) <- e0
kin <- e0*kout
d/dt(effect) <- kin*PD -kout*effect
}, append=d/dt(center))
expect_equal(mod5$theta, c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7))
mod5 <- mod |>
model({
PD <- 1-emax*cp/(ec50+cp)
##
effect(0) <- e0
kin <- e0*kout
d/dt(effect) <- kin*PD -kout*effect
}, append="d/dt(center)")
expect_equal(mod5$theta, c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7))
mod6 <- mod5 |>
model({
emax <- exp(temax)
e0 <- exp(te0 + eta.e0)
ec50 <- exp(tec50)
kin <- exp(tkin)
kout <- exp(tkout)
}, append=NA)
expect_equal(mod6$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, temax = 1, te0 = 1, tec50 = 1, tkin = 1, tkout = 1))
expect_equal(
mod6$omega,
lotri({
eta.cl ~ 0.3
eta.v ~ 0.1
eta.e0 ~ 1
}))
mod6 <- mod5 |>
model({
emax <- exp(temax)
e0 <- exp(te0 + eta.e0)
ec50 <- exp(tec50)
kin <- exp(tkin)
kout <- exp(tkout)
}, append=FALSE)
expect_equal(
mod6$omega,
lotri({
eta.cl ~ 0.3
eta.v ~ 0.1
eta.e0 ~ 1
}))
expect_equal(mod6$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, temax = 1, te0 = 1, tec50 = 1, tkin = 1, tkout = 1))
mod6 <- mod5 |>
model({
emax <- exp(temax)
e0 <- exp(te0 + eta.e0)
ec50 <- exp(tec50)
kin <- exp(tkin)
kout <- exp(tkout)
}, append=0)
expect_equal(
mod6$omega,
lotri({
eta.cl ~ 0.3
eta.v ~ 0.1
eta.e0 ~ 1
}))
expect_equal(mod6$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, temax = 1, te0 = 1, tec50 = 1, tkin = 1, tkout = 1))
# make sure auto model piping turns off
withr::with_options(list(rxode2.autoVarPiping=FALSE),
mod7 <- mod5 |>
model({
emax <- exp(temax)
e0 <- exp(te0 + eta.e0)
ec50 <- exp(tec50)
kin <- exp(tkin)
kout <- exp(tkout)
}, append=NA))
expect_equal(mod7$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7))
expect_equal(
mod7$omega,
lotri({
eta.cl ~ 0.3
eta.v ~ 0.1
}))
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.