tests/testthat/test-ui-mod-functions.R
In nlmixr2/rxode2: Facilities for Simulating from ODE-Based Models
rxTest({
test_that("binding together two models without inis", {
ocmt <- function() {
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
}
idr <- function() {
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_equal(m1$theta, setNames(numeric(0), character(0)))
})
test_that("binding together with first model missing an ini", {
ocmt <- function() {
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_true("idr.sd" %in% m1$iniDf$name)
})
test_that("binding together second model missing ini", {
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)
})
}
idr <- function() {
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_true("tv" %in% m1$iniDf$name)
})
test_that("binding together", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_true("idr.sd" %in% m1$iniDf$name)
expect_true("tv" %in% m1$iniDf$name)
expect_error(rxAppendModel(ocmt, idr))
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
suppressMessages(
expect_error(
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2)
}, append=TRUE),
NA
)
)
suppressMessages(
addModelLine <-
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2)
},
append=TRUE
)
)
expect_true(any(addModelLine$iniDf$name == "idr.sd2"))
expect_false(any(addModelLine$iniDf$name == "eff"))
expect_false(any(addModelLine$iniDf$name == "eff2"))
suppressMessages(
expect_error(
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2) | matt
},
append=TRUE),
NA
)
)
suppressMessages(
addModelLine <-
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2) | matt
},
append=TRUE
)
)
expect_true(any(addModelLine$iniDf$name == "idr.sd2"))
expect_false(any(addModelLine$iniDf$name == "eff"))
expect_false(any(addModelLine$iniDf$name == "eff2"))
expect_false(any(addModelLine$iniDf$name == "matt"))
})
test_that("bind together functions where population parameters overlap", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
tv <- 3
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
v <- exp(tv)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) * v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$theta,
c(tka = 1.56831218549017, tcl = 2.71828182845905, tv = 31.5003923087479, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together functions where population parameters where all parameters overlap", {
ocmt <- function() {
ini({
tv <- exp(3.45)
})
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
}
idr <- function() {
ini({
tv <- 3
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
v <- exp(tv)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) * v)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$theta,
c(tv = 31.5003923087479))
})
test_that("etas in first model but not in second", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("etas in second model but not first", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 1.56831218549017, tcl = 2.71828182845905, tv = 31.5003923087479, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 1", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka + eta.cl ~ c(0.1,
0.001, 0.1)
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka + eta.cl ~ c(0.1, 0.001, 0.1)
eta.v ~ 0.1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 2", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin + eta.kout~ c(0.1,
0.01, 0.1)
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
eta.kin + eta.kout ~ c(0.1, 0.01, 0.1)
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 1", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.v + eta.cl~ c(0.1,
0.01, 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
expect_error(rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 2", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.v ~ 0.1
eta.cl ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 + eta.v ~ c(0.1,
0.001, 1)
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
expect_error(rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr))
})
test_that("combine models without anything in common", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt, idr, common=FALSE)
expect_true("idr.sd" %in% m1$iniDf$name)
expect_true("tv" %in% m1$iniDf$name)
})
test_that("combine 3 models", {
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)
})
}
d1 <- ocmt |> rxRename(tkaD1=tka,
tclD1=tcl,
tvD1=tv,
add.sd.d1=add.sd,
kaD1=ka,
clD1=cl,
vD1=v,
depotD1=depot,
centerD1=center,
cpD1=cp)
d2 <- ocmt |> rxRename(tkad2=tka,
tcld2=tcl,
tvd2=tv,
add.sd.d2=add.sd,
kad2=ka,
cld2=cl,
vd2=v,
depotd2=depot,
centerd2=center,
cpd2=cp)
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
idr <- idr |> model(ceff=cpD1 + cpd2, append=NA)
full <- rxAppendModel(d1, d2, idr, common=FALSE)
expect_equal(full$theta,
c(tkaD1 = 1.56831218549017, tclD1 = 2.71828182845905, tvD1 = 31.5003923087479, add.sd.d1 = 0.7, tkad2 = 1.56831218549017, tcld2 = 2.71828182845905, tvd2 = 31.5003923087479, add.sd.d2 = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
})
nlmixr2/rxode2 documentation built on Jan. 11, 2025, 8:48 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
rxTest({
test_that("binding together two models without inis", {
ocmt <- function() {
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
}
idr <- function() {
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_equal(m1$theta, setNames(numeric(0), character(0)))
})
test_that("binding together with first model missing an ini", {
ocmt <- function() {
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_true("idr.sd" %in% m1$iniDf$name)
})
test_that("binding together second model missing ini", {
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)
})
}
idr <- function() {
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_true("tv" %in% m1$iniDf$name)
})
test_that("binding together", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_output(
expect_error(print(m1), NA),
"Normalized Syntax"
)
expect_true("idr.sd" %in% m1$iniDf$name)
expect_true("tv" %in% m1$iniDf$name)
expect_error(rxAppendModel(ocmt, idr))
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
suppressMessages(
expect_error(
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2)
}, append=TRUE),
NA
)
)
suppressMessages(
addModelLine <-
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2)
},
append=TRUE
)
)
expect_true(any(addModelLine$iniDf$name == "idr.sd2"))
expect_false(any(addModelLine$iniDf$name == "eff"))
expect_false(any(addModelLine$iniDf$name == "eff2"))
suppressMessages(
expect_error(
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2) | matt
},
append=TRUE),
NA
)
)
suppressMessages(
addModelLine <-
idr %>% model({
eff2 <- eff + 3
eff2 ~ add(idr.sd2) | matt
},
append=TRUE
)
)
expect_true(any(addModelLine$iniDf$name == "idr.sd2"))
expect_false(any(addModelLine$iniDf$name == "eff"))
expect_false(any(addModelLine$iniDf$name == "eff2"))
expect_false(any(addModelLine$iniDf$name == "matt"))
})
test_that("bind together functions where population parameters overlap", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
tv <- 3
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
v <- exp(tv)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) * v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$theta,
c(tka = 1.56831218549017, tcl = 2.71828182845905, tv = 31.5003923087479, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together functions where population parameters where all parameters overlap", {
ocmt <- function() {
ini({
tv <- exp(3.45)
})
model({
ka <- tka
cl <- tcl
v <- tv
d/dt(depot) = -ka * depot
d/dt(center) = ka * depot - cl / v * center
cp = center / v
})
}
idr <- function() {
ini({
tv <- 3
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
v <- exp(tv)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) * v)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$theta,
c(tv = 31.5003923087479))
})
test_that("etas in first model but not in second", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("etas in second model but not first", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 1.56831218549017, tcl = 2.71828182845905, tv = 31.5003923087479, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 1", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka + eta.cl ~ c(0.1,
0.001, 0.1)
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka + eta.cl ~ c(0.1, 0.001, 0.1)
eta.v ~ 0.1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 2", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin + eta.kout~ c(0.1,
0.01, 0.1)
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr)
expect_equal(m1$omega,
lotri({
eta.ka ~ 0.1
eta.cl ~ 0.1
eta.v ~ 0.1
eta.kin + eta.kout ~ c(0.1, 0.01, 0.1)
eta.ic50 ~ 0.1
}))
expect_equal(m1$theta,
c(tka = 0.45, tcl = 1, tv = 3.45, add.sd = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 1", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.v + eta.cl~ c(0.1,
0.01, 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 ~ 0.1
eta.v ~ 1
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
expect_error(rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr))
})
test_that("bind together 2 models with etas with overlapping etas w/cov in 2", {
ocmt <- function() {
ini({
tka <- 0.45
tcl <- 1
tv <- 3.45
eta.ka ~ 0.1
eta.v ~ 0.1
eta.cl ~ 0.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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
eta.kin ~ 0.1
eta.kout ~ 0.1
eta.ic50 + eta.v ~ c(0.1,
0.001, 1)
})
model({
kin <- exp(tkin + eta.kin)
kout <- exp(tkout + eta.kout)
ic50 <- exp(tic50 + eta.ic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma) + eta.v)
eff ~ add(idr.sd)
})
}
expect_error(rxAppendModel(ocmt %>% model(ceff=cp,append=TRUE), idr))
})
test_that("combine models without anything in common", {
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)
})
}
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
m1 <- rxAppendModel(ocmt, idr, common=FALSE)
expect_true("idr.sd" %in% m1$iniDf$name)
expect_true("tv" %in% m1$iniDf$name)
})
test_that("combine 3 models", {
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)
})
}
d1 <- ocmt |> rxRename(tkaD1=tka,
tclD1=tcl,
tvD1=tv,
add.sd.d1=add.sd,
kaD1=ka,
clD1=cl,
vD1=v,
depotD1=depot,
centerD1=center,
cpD1=cp)
d2 <- ocmt |> rxRename(tkad2=tka,
tcld2=tcl,
tvd2=tv,
add.sd.d2=add.sd,
kad2=ka,
cld2=cl,
vd2=v,
depotd2=depot,
centerd2=center,
cpd2=cp)
idr <- function() {
ini({
tkin <- log(1)
tkout <- log(1)
tic50 <- log(10)
gamma <- fix(1)
idr.sd <- 1
})
model({
kin <- exp(tkin)
kout <- exp(tkout)
ic50 <- exp(tic50)
d/dt(eff) <- kin - kout*(1-ceff^gamma/(ic50^gamma+ceff^gamma))
eff ~ add(idr.sd)
})
}
idr <- idr |> model(ceff=cpD1 + cpd2, append=NA)
full <- rxAppendModel(d1, d2, idr, common=FALSE)
expect_equal(full$theta,
c(tkaD1 = 1.56831218549017, tclD1 = 2.71828182845905, tvD1 = 31.5003923087479, add.sd.d1 = 0.7, tkad2 = 1.56831218549017, tcld2 = 2.71828182845905, tvd2 = 31.5003923087479, add.sd.d2 = 0.7, tkin = 0, tkout = 0, tic50 = 2.30258509299405, gamma = 1, idr.sd = 1))
})
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.