Nothing
tests/testthat/test-solComp.R
In rxode2: Facilities for Simulating from ODE-Based Models
rxTest({
test_that("test the matrices of the linear compartment solutions .solComp2", {
v <- list(L = c(4.07546291005291, 0.0245370899470903),
C1 = structure(c(0.759200006770939,-0.740571447916969,
0.240799993229061, 0.740571447916969),
dim = c(2L, 2L)),
C2 = structure(c(-0.246857149305656, 0.240799993229061,
0.246857149305656, 0.759200006770939),
dim = c(2L, 2L)))
expect_equal(.solComp2(k10=0.1, k12=3, k21=1), v)
v <- list(L = c(5.8977832399092, 0.0122878774411843, 0.689928882649618),
C1 = structure(c(0.86252789433926, -0.528317313419071, -0.319585969277925,
0.120784508040635, 0.366861472939276, 0.495310665672737,
0.016687597620105, 0.161455840479795, -0.175724696394812),
dim = c(3L, 3L)),
C2 = structure(c(-0.17610577113969, 0.107868659665074, 0.0652511460029109,
0.122287157646425, 0.371425504011093, 0.501472700759773,
0.053818613493265, 0.520705836323833, -0.566723846762684),
dim = c(3L, 3L)),
C3 = structure(c(-0.0798964923194813, 0.0489383595021832, 0.0296034459956658,
0.123827666418184, 0.37610452556983, 0.507789987948271,
-0.043931174098703, -0.425042885072013, 0.462606566056063),
dim = c(3L, 3L)))
expect_equal(.solComp3(k10=0.1, k12=3, k21=1, k13=2, k31=0.5),
v)
})
if (requireNamespace("pmxTools", quietly = TRUE)) {
f <- function(dt, CL=25, V=20, DOSE=100) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- DOSE
rateNV <- 0
oral0 <- 0
trans <- 1
ncmt <- 1
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the one compartment linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, CL=25, V=20, KA=2, DOSE=100) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- KA
alastNV <- c(DOSE, 0)
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 1
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_1cmt_linear_oral_1(CL=CL, V=V, ka=KA, t=dt, dose=DOSE),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the oral 1-cmt linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(t, CL=25, V=20, DOSE=100, tinf=1) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
deriv <- FALSE
if (t < tinf) {
alastNV <- 0
rateNV <- DOSE/tinf
dt <- t
} else {
alastNV <- pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=tinf, dose=DOSE, tinf=tinf)*V # amt not conc
rateNV <- 0
dt <- t - tinf
}
oral0 <- 0
trans <- 1
ncmt <- 1
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
l <- l$val
c(s=pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t, dose=DOSE, tinf=tinf),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the iv infusion 1-cmt linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- c(DOSE, 0)
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 2
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_2cmt_linear_bolus(CL=CL, V=V, V2=V2, Q=Q,
t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the two compartment linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100, tinf=1) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- c(0, 0)
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1
ncmt <- 2
extra <- 0
deriv <- FALSE
if (dt <= tinf) {
} else {
l <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
dt <- dt - tinf
extra <- tinf
rateNV <- 0
alastNV <- l$Alast
}
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_2cmt_linear_infusion(CL=CL, V=V, V2=V2, Q=Q,
t=dt+extra, dose=DOSE, tinf=tinf),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the two compartment iv infusion linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
# 3 compartment tests
f <- function(dt,
V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
alastNV <- c(DOSE, 0, 0)
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 3
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_3cmt_linear_bolus(CL=CL, V=V, V2=V2, Q=Q,
V3=V3, Q3=Q2,
t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the two compartment linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
# 3 compartment tests, oral
f <- function(dt,
V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
ka=2,
DOSE=100) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- ka
alastNV <- c(DOSE, 0, 0, 0)
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 3
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_3cmt_linear_oral_1(CL=CL, V=V, V2=V2, Q=Q,
V3=V3, Q3=Q2,
ka=ka,
t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the three compartment linear oral compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100, tinf=1) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
alastNV <- c(0, 0, 0)
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1
ncmt <- 3
extra <- 0
deriv <- FALSE
if (dt <= tinf) {
} else {
l <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
dt <- dt - tinf
extra <- tinf
rateNV <- 0
alastNV <- l$Alast
}
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_3cmt_linear_infusion(CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2,
t=dt+extra, dose=DOSE, tinf=tinf),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the three compartment linear infusion compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
####################################################
## AD linCmt()
####################################################
f0 <- function(dt, CL=25, V=20, DOSE=100,
alastNV=c(DOSE, 0, 0)) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
rateNV <- 0
oral0 <- 0
trans <- 1
ncmt <- 1
deriv <- TRUE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
l
#c(s=pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=dt, dose=DOSE), l=l$val)
}
f <- function(dt, CL=25, V=20, DOSE=100) {
test_that(paste0("one compartment bolus t=", dt, ";CL=", CL,
"; V=", V, "; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, DOSE=DOSE)
#
expect_equal(pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, DOSE=100)
})
f0 <- function(dt, CL=25, V=20, KA=2, DOSE=100,
alastNV=c(DOSE, 0, 0, 0, 0, 0)) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- KA
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 1
deriv <- TRUE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1,
p2, p3,
p4, p5,
ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
l
}
f <- function(dt, CL=25, V=20, KA=2, DOSE=100) {
test_that(paste0("one compartment oral t=", dt, ";CL=", CL,
"; V=", V, "; KA=", KA, "; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, KA=KA, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_1cmt_linear_oral_1(CL=CL, V=V, ka=KA, t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, KA=KA, DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, KA=KA, DOSE=DOSE)
#
expect_equal(pmxTools::calc_sd_1cmt_linear_oral_1(CL=CL, V=V, ka=KA, t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, KA=2, DOSE=100)
})
## One compartment IV infusion
f0i <- function(t, CL=25, V=20, DOSE=100, tinf=1,
alastNV=rep(0, 3), rateNV=DOSE/tinf) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
deriv <- TRUE
oral0 <- 0
trans <- 1
ncmt <- 1
if (all(rateNV == 0)) {
# Now a simple eliminiation; Handles the case where the infusion has already past
dt <- t
} else if (t < tinf) {
# infusion not complete
dt <- t
} else {
#Infusion completes during the time
v <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
if (t == tinf) return(v)
# Infusion is now complete
alastNV <- v$Alast
rateNV <- 0
dt <- t - tinf
}
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, CL=25, V=20, DOSE=100, tinf=1) {
test_that(paste0("one compartment infusion t=", dt, ";CL=", CL,
"; V=", V, "; tinf=", tinf, "; DOSE=", DOSE), {
t0 <- dt/2
# See if more care is needed for IV comparison
if (dt < tinf) {
f1 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, alastNV=f1$Alast)
#
f3 <- f0i(t0*2, CL=CL, V=V, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else if (t0 > tinf) {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, rateNV=0,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f2$val)
f3 <- f0i(t0*2, CL=CL, V=V, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0, dose=DOSE, tinf=tinf),
f1$val)
f3 <- f0i(t0*2, CL=CL, V=V, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
tinf2 <- tinf-t0
f2 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf2, rateNV=rateNV,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
}
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, tinf=1, DOSE=100)
})
## Two compartment bolus
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100,
alastNV=c(DOSE, rep(0, 9))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 2
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100) {
test_that(paste0("two compartment bolus t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_2cmt_linear_bolus(CL=CL, V=V,
V2=V2, Q=Q,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_2cmt_linear_bolus(CL=CL, V=V, V2=V2, Q=Q,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Two compartment oral
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100, ka=2,
alastNV=c(DOSE, rep(0, 13))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 2
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, ka=2, DOSE=100) {
test_that(paste0("two compartment oral t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; ka=", ka, "DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, ka=ka, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_2cmt_linear_oral_1(
CL=CL, V=V,
V2=V2, Q=Q, ka=ka,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, ka=ka,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2, ka=ka,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_2cmt_linear_oral_1(
CL=CL, V=V, V2=V2, Q=Q, ka=ka,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Two compartment IV infusion
f0i <- function(t, CL=25, V=20, V2 = 297, Q = 10, DOSE=100, tinf=1,
alastNV=rep(0, 10), rateNV=DOSE/tinf) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
deriv <- TRUE
oral0 <- 0
trans <- 1
ncmt <- 2
if (all(rateNV == 0)) {
# Now a simple eliminiation; Handles the case where the infusion has already past
dt <- t
} else if (t < tinf) {
# infusion not complete
dt <- t
} else {
#Infusion completes during the time
v <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
if (t == tinf) return(v)
# Infusion is now complete
alastNV <- v$Alast
rateNV <- 0
dt <- t - tinf
}
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, CL=25, V=20, V2 = 297, Q = 10, DOSE=100, tinf=1) {
test_that(paste0("two compartment infusion t=", dt, ";CL=", CL,
"; V2 = ", V2, "; Q = ", Q,
"; V=", V, "; tinf=", tinf, "; DOSE=", DOSE), {
t0 <- dt/2
# See if more care is needed for IV comparison
if (dt < tinf) {
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q,
DOSE=DOSE, tinf=tinf, alastNV=f1$Alast)
#
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else if (t0 > tinf) {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q,
DOSE=DOSE, tinf=tinf, rateNV=0,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f2$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0, dose=DOSE, tinf=tinf),
f1$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
tinf2 <- tinf-t0
f2 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf2, rateNV=rateNV,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
}
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, tinf=1, DOSE=100)
})
## Three compartment model bolus
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100,
alastNV=c(DOSE, rep(0, 20))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 3
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400, DOSE=100) {
test_that(paste0("two compartment bolus t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; Q2=", Q2,
"; V3=", V3,
"; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_3cmt_linear_bolus(
CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_3cmt_linear_bolus(
CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Three compartment model oral
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
ka=2,
DOSE=100,
alastNV=c(DOSE, rep(0, 25))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- ka
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- TRUE
trans <- 1
ncmt <- 3
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
ka=2, DOSE=100) {
test_that(paste0("three compartment oral t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; ka=", ka,
"; Q2=", Q2, "; V3=", V3, "; ka=", ka,
"; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, ka=ka, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_3cmt_linear_oral_1(
CL=CL, V=V,
V2=V2, Q=Q, Q3=Q2, V3=V3, ka=ka,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, ka=ka,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, ka=ka,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_3cmt_linear_oral_1(
CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2, ka=ka,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Three compartment IV infusion
f0i <- function(t, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100, tinf=1,
alastNV=rep(0, 21),
rateNV=DOSE/tinf) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
deriv <- TRUE
oral0 <- 0
trans <- 1
ncmt <- 3
if (all(rateNV == 0)) {
# Now a simple eliminiation; Handles the case where the infusion has already past
dt <- t
} else if (t < tinf) {
# infusion not complete
dt <- t
} else {
#Infusion completes during the time
v <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
if (t == tinf) return(v)
# Infusion is now complete
alastNV <- v$Alast
rateNV <- 0
dt <- t - tinf
}
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100, tinf=1) {
test_that(paste0("three compartment infusion t=", dt, ";CL=", CL,
"; V2 = ", V2, "; Q = ", Q,
"; V3 = ", V3, "; Q2 = ", Q2,
"; V=", V, "; tinf=", tinf, "; DOSE=", DOSE), {
t0 <- dt/2
# See if more care is needed for IV comparison
if (dt < tinf) {
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, alastNV=f1$Alast)
#
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, V3=V3, Q2=Q2,
DOSE=DOSE)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else if (t0 > tinf) {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, rateNV=0,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f2$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
tinf2 <- tinf-t0
f2 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, tinf=tinf2, rateNV=rateNV,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
}
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, tinf=1, DOSE=100)
})
}
testVal <- function(rx, val) {
state <- rx$state
state <- setNames(seq_along(state), state)
expect_equal(.getCmtNum(rx),
state[val])
}
testInf <- function(rx, val) {
state <- rx$state
state <- setNames(seq_along(state), state)
.num <- .getCmtNum(rx)
expect_equal(setNames(cmtSupportsInfusion_(.num, rxModelVars(rx)),
names(.getCmtNum(rx))),
val)
}
testOff <- function(rx, val) {
state <- rx$state
state <- setNames(seq_along(state), state)
.num <- .getCmtNum(rx)
expect_equal(setNames(cmtSupportsOff_(.num, rxModelVars(rx)),
names(.num)),
val)
}
test_that("rxode2 parsing of linCmt() 1 compartment with ka", {
rx <- function() {
ini({
popCl <- 1
popV <- 20
bsvCl ~ 0.1
bsvV ~ 0.1
popKeo <- 1.4
bsvKeo ~ 0.1
popKa <- 1
})
model({
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
}
rx <- rxode2({
popCl <- 1
popV <- 20
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
popKa <- 1
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 2L, depotLin = 1L))
testVal(rx, c("depot", "central", "ce"))
testInf(rx, c(depot=TRUE, central=TRUE, ce=TRUE))
testOff(rx, c(depot=FALSE, central=FALSE, ce=TRUE))
expect_equal(rx$state, c("ce", "depot", "central"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popKa <- 1
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 4L, numLin = 2L, depotLin = 1L))
testVal(rx, c("depot", "central", "ce",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_ka", "rx__sens_depot_BY_ka"))
testInf(rx, c(depot=TRUE, central=TRUE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE,
rx__sens_central_BY_ka=FALSE, rx__sens_depot_BY_ka=FALSE))
testOff(rx, c(depot=FALSE, central=FALSE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE,
rx__sens_central_BY_ka=FALSE, rx__sens_depot_BY_ka=FALSE))
expect_equal(rx$state, c("ce",
"depot", "central",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_ka",
"rx__sens_depot_BY_ka"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 1 compartment without ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 1L, depotLin = 0L))
testVal(rx, c("central", "ce"))
testInf(rx, c(central=TRUE, ce=TRUE))
testOff(rx, c(central=FALSE, ce=TRUE))
expect_equal(rx$state, c("ce", "central"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 2L, numLin = 1L, depotLin = 0L))
testVal(rx, c("central","ce",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1"))
testInf(rx, c(central=TRUE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE))
testOff(rx, c(central=FALSE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE))
expect_equal(rx$state, c("ce",
"central",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 2 compartment without ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 2L, depotLin = 0L))
testVal(rx, c("central", "ce", "peripheral1"))
testInf(rx, c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE))
testOff(rx, c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 8L, numLin = 2L, depotLin = 0L))
testVal(rx, c("central", "ce", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3"))
testInf(rx, c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE))
testOff(rx, c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 2 compartment with ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
popKa <- 1
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvKa <-0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa * exp(bsvKa)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagDepot <- 0
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagDepot <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(depot) <- popLagDepot * exp(bsvLagDepot)
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 3L, depotLin = 1L))
testVal(rx, c("depot", "central", "ce", "peripheral1"))
testInf(rx, c("depot"=TRUE, "central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE))
testOff(rx, c("depot"=FALSE, "central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popKa <- 1
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvKa <-0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa * exp(bsvKa)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagDepot <- 0
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagDepot <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(depot) <- popLagDepot * exp(bsvLagDepot)
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
a=depot
b=central
c=peripheral1
}, linCmtSens="linCmtB")
testVal(rx, c("depot", "central", "ce", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_depot_BY_ka"))
testInf(rx, c("depot"=TRUE, "central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
testOff(rx, c("depot"=FALSE, "central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 11L, numLin = 3L, depotLin = 1L))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_depot_BY_ka"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 3 compartment without ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
popVp2 <- 1
popQ2 <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 3L, depotLin = 0L))
testVal(rx, c("central", "ce", "peripheral1", "peripheral2"))
testInf(rx, c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE))
testOff(rx, c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1", "peripheral2"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popVp2 <- 3
popQ2 <- 4
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 18L, numLin = 3L, depotLin = 0L))
testVal(rx,c("central", "ce", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5"))
testInf(rx,c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE))
testOff(rx,c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5"
))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 3 compartment with ka", {
rx <- rxode2({
popCl <- 1
popKa <- 4
popV <- 20
popVp <- 10
popQ <- 2
popVp2 <- 1
popQ2 <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
ka ~ popKa
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
etTrans(et(amt=3,cmt=1) |> et(1:10), rx)
etTrans(et(amt=3) |> et(1:10), rx)
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 4L, depotLin = 1L))
testVal(rx,
c("depot", "central", "ce", "peripheral1", "peripheral2"))
testInf(rx,
c("depot"=TRUE, "central"=TRUE, "ce"=TRUE,
"peripheral1"=FALSE, "peripheral2"=FALSE))
testOff(rx,
c("depot"=FALSE, "central"=FALSE, "ce"=TRUE,
"peripheral1"=FALSE, "peripheral2"=FALSE))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1", "peripheral2"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popKa <- 3
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popVp2 <- 3
popQ2 <- 4
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
ka ~ popKa
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 22L, numLin = 4L, depotLin = 1L))
testVal(rx,
c("depot", "central", "ce", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5",
"rx__sens_peripheral2_BY_ka",
#
"rx__sens_depot_BY_ka"))
testInf(rx,
c("depot"=TRUE, "central"=TRUE,
"ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE,
"rx__sens_peripheral2_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
testOff(rx,
c("depot"=FALSE, "central"=FALSE,
"ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE,
"rx__sens_peripheral2_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5",
"rx__sens_peripheral2_BY_ka",
#
"rx__sens_depot_BY_ka"
))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
if (requireNamespace("pmxTools", quietly = TRUE)) {
test_that("rxode2 solving of 1 compartment steady state bolus", {
f <- function(CL=6, V=25, DOSE=600, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- c(0, 0, 0)
} else {
alastNV <- 0
}
rateNV <- 0
oral0 <- 0
trans <- 1L
ncmt <- 1
type <- 3L # ss bolus
amt <- DOSE
tinf <- 1
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans, deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_1cmt_linear_bolus(t=0, CL=6, V=25, dose=600, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,pmxTools::calc_ss_1cmt_linear_bolus(t=0, CL=6, V=25, dose=600, tau=24))
expect_equal(dim(v$J), 1:2)
expect_length(v$Jg, 2)
expect_length(v$Alast, 3)
})
test_that("rxode2 solving of 1 compartment steady state infusion", {
f <- function(CL=2, V=25, DOSE=600, tinf=1, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- c(0, 0, 0)
} else {
alastNV <- 0
}
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1L
ncmt <- 1
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_1cmt_linear_infusion(tad=0, CL=2, V=25, dose=600, tinf=1, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_1cmt_linear_infusion(tad=0, CL=2, V=25, dose=600, tinf=1, tau=24))
expect_equal(dim(v$J), 1:2)
expect_length(v$Jg, 2)
expect_length(v$Alast, 3)
})
test_that("rxode2 solving of 1 compartment steady state 1st order dosing", {
f <- function(CL=2, V=25, DOSE=600, ka=0.25, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- c(0, 0, 0, 0, 0, 0)
} else {
alastNV <- c(0, 0)
}
rateNV <- c(0, 0)
oral0 <- 1L
trans <- 1L
ncmt <- 1
type <- 3L # bolus infusion
amt <- DOSE
dt <- 0
cmt <- 0L
tinf <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
pmxTools::calc_ss_1cmt_linear_oral_1(tad=0, CL=2, V=25, dose=600, ka=0.25, tau=24))
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_1cmt_linear_oral_1(tad=0, CL=2, V=25, dose=600, ka=0.25, tau=24))
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
})
test_that("rxode2 solving of 1 compartment steady state for constant infusion", {
## Now test the solutions not covered by pmxTools by cross testing
## against rxode2 lsoda
rx <- rxode2({
CL <- 6
V <- 25
kel <- CL/V
d/dt(central) = -kel*central
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, DOSE=600, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- c(0, 0, 0)
} else {
alastNV <- 0
}
rateNV <- 600
oral0 <- 0
trans <- 1L
ncmt <- 1
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1])
v <- f(deriv=TRUE)
expect_equal(v$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1])
expect_equal(dim(v$J), 1:2)
expect_length(v$Jg, 2)
expect_length(v$Alast, 3)
})
test_that("rxode2 solving of 1 compartment steady state for constant depot infusion", {
rx <- rxode2({
CL <- 6
V <- 25
ka <- 0.25
kel <- CL/V
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, DOSE=600, ka=0.25, rate=c(600, 0), deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- c(0, 0, 0, 0, 0, 0)
} else {
alastNV <- c(0, 0)
}
rateNV <- rate
oral0 <- 1L
trans <- 1L
ncmt <- 1
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1])
expect_equal(f()$Alast,
c(s$depot[1], s$central[1]))
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1])
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]))
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
# Now infusion in the 2 compartment models to central
e <- et(amt=0, rate=600, ss=1, cmt=2) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(rate=c(0, 600))$val,
s$cp[1])
expect_equal(f(rate=c(0, 600))$Alast,
c(s$depot[1], s$central[1]))
v <- f(rate=c(0, 600), deriv=TRUE)
expect_equal(v$val,
s$cp[1])
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]))
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
})
test_that("rxode2 solving of 1 compartment steady state for constant depot infusion", {
f <- function(CL=2, V=25, DOSE=600, tinf=1, tau=6, deriv=FALSE, cmt=0L,
ka=0.25) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- c(0, 0, 0, 0, 0, 0)
} else {
alastNV <- c(0, 0)
}
if (cmt == 0L) {
rateNV <- c(DOSE/tinf, 0)
} else {
rateNV <- c(0, DOSE/tinf)
}
oral0 <- 1L
trans <- 1L
ncmt <- 1
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
rx <- rxode2({
CL <- 2
V <- 25
ka <- 0.25
kel <- CL/V
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot
cp <- central/V
})
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=depot) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast,
c(s$depot[1], s$central[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=central) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(cmt=1L)$val,
s$cp[1], tolerance = 1e-3)
expect_equal(f(cmt=1L)$Alast,
c(s$depot[1], s$central[1]),
tolerance = 1e-3)
v <- f(cmt=1L, deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance = 1e-3)
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]), tolerance = 1e-3)
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
})
####################################################################
## Test the 2 compartment steady state solutions
####################################################################
test_that("rxode2 solving of 2 compartment steady state bolus", {
f <- function(CL=7.5, V=20, V2 = 30, Q = 0.5, DOSE=10, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- 0
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 3L # ss bolus
amt <- DOSE
tinf <- 1
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans, deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_2cmt_linear_bolus(0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_2cmt_linear_bolus(0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tau=24))
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 2 compartment steady state infusion", {
f <- function(CL=7.5, V=20, V2=30, Q=0.5, DOSE=10, tinf=1, tau=12, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
f()$val)
v <- f(deriv=TRUE)
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
v$val)
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 2 compartment steady state 1st order dosing", {
f <- function(CL=7.5, V=20, V2=30, Q=0.5, DOSE=1000, ka=1, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- rep(0, 14)
} else {
alastNV <- c(0, 0, 0)
}
rateNV <- c(0, 0)
oral0 <- 1L
trans <- 1L
ncmt <- 2
type <- 3L # bolus infusion
amt <- DOSE
dt <- 0
cmt <- 0L
tinf <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
pmxTools::calc_ss_2cmt_linear_oral_1(tad=0, CL=7.5, V1=20, V2=30, Q=0.5, dose=1000, ka=1, tau=24))
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_2cmt_linear_oral_1(tad=0, CL=7.5, V1=20, V2=30, Q=0.5, dose=1000, ka=1, tau=24))
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
})
test_that("rxode2 solving of 2 compartment steady state for constant infusion", {
## Now test the solutions not covered by pmxTools by cross testing
## against rxode2 lsoda
rx <- rxode2({
CL <- 6
V <- 25
Q <- 0.5
V2 <- 30
k12 <- Q/V
k21 <- Q/V2
kel <- CL/V
d/dt(central) = -kel*central + k21*peripheral - k12*central
d/dt(peripheral) = k12*central - k21*peripheral
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, Q=0.5, V2=30, DOSE=600, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- 600
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 2 compartment steady state for constant depot infusion", {
rx <- rxode2({
CL <- 6
V <- 25
Q <- 0.5
V2 <- 30
k12 <- Q/V
k21 <- Q/V2
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + k21*peripheral - k12*central + ka*depot
d/dt(peripheral) = k12*central - k21*peripheral
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, Q=0.5, V2=30, DOSE=600, ka=0.25, rate=c(600, 0), deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- rep(0, 14)
} else {
alastNV <- rep(0, 3)
}
rateNV <- rate
oral0 <- 1L
trans <- 1L
ncmt <- 2
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
# Now infusion in the 2 compartment models to central
e <- et(amt=0, rate=600, ss=1, cmt=2) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(rate=c(0, 600))$val,
s$cp[1], tolerance=1e-3)
expect_equal(f(rate=c(0, 600))$Alast[1:3],
c(s$depot[1], s$central[1],s$peripheral[1]),
tolerance=1e-3)
v <- f(rate=c(0, 600), deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
})
test_that("rxode2 solving of 2 compartment steady state for constant depot infusion", {
f <- function(CL=2, V=25, Q=0.5, V2=30, DOSE=600, tinf=1, tau=6, deriv=FALSE, cmt=0L,
ka=0.25) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- rep(0, 14)
} else {
alastNV <- rep(0, 3)
}
if (cmt == 0L) {
rateNV <- c(DOSE/tinf, 0)
} else {
rateNV <- c(0, DOSE/tinf)
}
oral0 <- 1L
trans <- 1L
ncmt <- 2
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
rx <- rxode2({
CL <- 2
V <- 25
Q <- 0.5
V2 <- 30
k12 <- Q/V
k21 <- Q/V2
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + k21*peripheral - k12*central + ka*depot
d/dt(peripheral) = k12*central - k21*peripheral
cp <- central/V
})
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=depot) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast,
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=central) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(cmt=1L)$val,
s$cp[1], tolerance = 1e-3)
expect_equal(f(cmt=1L)$Alast,
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance = 1e-3)
v <- f(cmt=1L, deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance = 1e-3)
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]), tolerance = 1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5L)
expect_length(v$Alast, 14)
})
####################################################################
## Test the 3 compartment steady state solutions
####################################################################
test_that("rxode2 solving of 3 compartment steady state bolus", {
f <- function(CL=3.5, V1=20, V2 = 500, V3=200, Q2=0.5, Q3 = 0.05, DOSE=100, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V1
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- 0
if (deriv) {
alastNV <- rep(0, 21)
} else {
alastNV <- c(0, 0, 0)
}
rateNV <- 0
oral0 <- 0
trans <- 1L
ncmt <- 3
type <- 3L # ss bolus
amt <- DOSE
tinf <- 1
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans, deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_3cmt_linear_bolus(0, CL=3.5, V1=20, V2 = 500, V3=200, Q2=0.5, Q3 = 0.05, dose=100, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_3cmt_linear_bolus(0, CL=3.5, V1=20, V2 = 500, V3=200, Q2=0.5, Q3 = 0.05, dose=100, tau=24))
expect_equal(dim(v$J), c(3L, 6L))
expect_length(v$Jg, 6)
expect_length(v$Alast, 21)
})
test_that("rxode2 solving of 3 compartment steady state infusion", {
f <- function(CL=7.5, V=20, V2=30, Q=0.5, DOSE=10, tinf=1, tau=12, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
f()$val)
v <- f(deriv=TRUE)
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
v$val)
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 3 compartment steady state 1st order dosing", {
f <- function(CL=7.5, V1=20, V2=30, V3=200, Q2=0.5, Q3=0.05, ka=1, DOSE=100, tau=24, deriv=FALSE, ndiff=127) {
p1 <- CL
v1 <- V1
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- ka
if (deriv) {
alastNV <- rep(0, 26)
} else {
alastNV <- c(0, 0, 0, 0)
}
rateNV <- c(0, 0)
oral0 <- 1L
trans <- 1L
ncmt <- 3
type <- 3L # bolus infusion
amt <- DOSE
dt <- 0
cmt <- 0L
tinf <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, ndiff, 3L, 0.001)
}
expect_equal(f()$val,
pmxTools::calc_ss_3cmt_linear_oral_1(tad = 0, CL = 7.5, V1 = 20,
V2 = 30, V3 = 200, Q2 = 0.5,
Q3 = 0.05, ka = 1, dose = 100,
tau = 24))
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_3cmt_linear_oral_1(tad = 0, CL = 7.5, V1 = 20,
V2 = 30, V3 = 200, Q2 = 0.5,
Q3 = 0.05, ka = 1, dose = 100,
tau = 24))
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
})
test_that("rxode2 solving of 3 compartment steady state for constant infusion", {
## Now test the solutions not covered by pmxTools by cross testing
## against rxode2 lsoda
rx <- rxode2({
CL <- 6
V <- 25
V2 <- 30
V3 <- 200
Q2 <- 0.5
Q3 <- 0.05
k12 <- Q2/V
k21 <- Q2/V2
k13 <- Q3/V
k31 <- Q3/V3
kel <- CL/V
d/dt(central) = -kel*central + k21*peripheral - k12*central +
k31*peripheral2 - k13*central
d/dt(peripheral) = k12*central - k21*peripheral
d/dt(peripheral2) = k13*central - k31*peripheral2
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL= 6, V = 25, V2 = 30, V3 = 200,
Q2= 0.5,
Q3= 0.05,
DOSE=600, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- 0
if (deriv) {
alastNV <- rep(0, 21)
} else {
alastNV <- c(0, 0, 0)
}
rateNV <- 600
oral0 <- 0
trans <- 1L
ncmt <- 3
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
expect_equal(dim(v$J), c(3L, 6L))
expect_length(v$Jg, 6)
expect_length(v$Alast, 21)
})
test_that("rxode2 solving of 3 compartment steady state for constant depot infusion", {
rx <- rxode2({
CL <- 6
V <- 25
Q2 <- 0.5
Q3 <- 0.05
V2 <- 30
V3 <- 300
k12 <- Q2/V
k21 <- Q2/V2
k13 <- Q3/V
k31 <- Q3/V3
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot +
k21*peripheral - k12*central +
k31*peripheral1 - k13*central
d/dt(peripheral) = k12*central - k21*peripheral
d/dt(peripheral1) = k13*central - k31*peripheral1
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
f <- function(CL=6, V=25, Q2=0.5, Q3=0.05, V2=30, V3=300, DOSE=600,
ka=0.25, rate=c(600, 0), deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- ka
if (deriv) {
alastNV <- rep(0, 26)
} else {
alastNV <- rep(0, 4)
}
rateNV <- rate
oral0 <- 1L
trans <- 1L
ncmt <- 3
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1],
s$peripheral1[1]), tolerance=1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
# Now infusion in the 3 compartment models to central
e <- et(amt=0, rate=600, ss=1, cmt=2) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(rate=c(0, 600))$val,
s$cp[1], tolerance=1e-3)
expect_equal(f(rate=c(0, 600))$Alast[1:3],
c(s$depot[1], s$central[1],s$peripheral[1]),
tolerance=1e-3)
v <- f(rate=c(0, 600), deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance=1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
})
test_that("rxode2 solving of 3 compartment steady state for constant depot infusion", {
f <- function(CL=6, V=25, Q2=0.5, Q3=0.05, V2=30, V3=300, DOSE=600, tinf=1, tau=6, deriv=FALSE, cmt=0L,
ka=0.25) {
p1 <- CL
v1 <- V
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- ka
if (deriv) {
alastNV <- rep(0, 26)
} else {
alastNV <- rep(0, 4)
}
if (cmt == 0L) {
rateNV <- c(DOSE/tinf, 0)
} else {
rateNV <- c(0, DOSE/tinf)
}
oral0 <- 1L
trans <- 1L
ncmt <- 3
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
rx <- rxode2({
CL <- 6
V <- 25
Q2 <- 0.5
Q3 <- 0.05
V2 <- 30
V3 <- 300
k12 <- Q2/V
k21 <- Q2/V2
k13 <- Q3/V
k31 <- Q3/V3
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot +
k21*peripheral - k12*central +
k31*peripheral1 - k13*central
d/dt(peripheral) = k12*central - k21*peripheral
d/dt(peripheral1) = k13*central - k31*peripheral1
cp <- central/V
})
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=depot) |>
et(time=0.5)
s <- rxSolve(rx, e, addDosing =TRUE, maxsteps=700000)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast,
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=central) |>
et(time=0.5)
s <- rxSolve(rx, e, addDosing =TRUE, , maxsteps=700000)
expect_equal(f(cmt=1L)$val,
s$cp[1], tolerance = 1e-3)
expect_equal(f(cmt=1L)$Alast,
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance = 1e-3)
v <- f(cmt=1L, deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance = 1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7L)
expect_length(v$Alast, 26)
})
}
})
Try the rxode2 package in your browser
Any scripts or data that you put into this service are public.
rxode2 documentation built on July 28, 2026, 5:08 p.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("test the matrices of the linear compartment solutions .solComp2", {
v <- list(L = c(4.07546291005291, 0.0245370899470903),
C1 = structure(c(0.759200006770939,-0.740571447916969,
0.240799993229061, 0.740571447916969),
dim = c(2L, 2L)),
C2 = structure(c(-0.246857149305656, 0.240799993229061,
0.246857149305656, 0.759200006770939),
dim = c(2L, 2L)))
expect_equal(.solComp2(k10=0.1, k12=3, k21=1), v)
v <- list(L = c(5.8977832399092, 0.0122878774411843, 0.689928882649618),
C1 = structure(c(0.86252789433926, -0.528317313419071, -0.319585969277925,
0.120784508040635, 0.366861472939276, 0.495310665672737,
0.016687597620105, 0.161455840479795, -0.175724696394812),
dim = c(3L, 3L)),
C2 = structure(c(-0.17610577113969, 0.107868659665074, 0.0652511460029109,
0.122287157646425, 0.371425504011093, 0.501472700759773,
0.053818613493265, 0.520705836323833, -0.566723846762684),
dim = c(3L, 3L)),
C3 = structure(c(-0.0798964923194813, 0.0489383595021832, 0.0296034459956658,
0.123827666418184, 0.37610452556983, 0.507789987948271,
-0.043931174098703, -0.425042885072013, 0.462606566056063),
dim = c(3L, 3L)))
expect_equal(.solComp3(k10=0.1, k12=3, k21=1, k13=2, k31=0.5),
v)
})
if (requireNamespace("pmxTools", quietly = TRUE)) {
f <- function(dt, CL=25, V=20, DOSE=100) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- DOSE
rateNV <- 0
oral0 <- 0
trans <- 1
ncmt <- 1
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the one compartment linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, CL=25, V=20, KA=2, DOSE=100) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- KA
alastNV <- c(DOSE, 0)
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 1
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_1cmt_linear_oral_1(CL=CL, V=V, ka=KA, t=dt, dose=DOSE),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the oral 1-cmt linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(t, CL=25, V=20, DOSE=100, tinf=1) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
deriv <- FALSE
if (t < tinf) {
alastNV <- 0
rateNV <- DOSE/tinf
dt <- t
} else {
alastNV <- pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=tinf, dose=DOSE, tinf=tinf)*V # amt not conc
rateNV <- 0
dt <- t - tinf
}
oral0 <- 0
trans <- 1
ncmt <- 1
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
l <- l$val
c(s=pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t, dose=DOSE, tinf=tinf),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the iv infusion 1-cmt linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- c(DOSE, 0)
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 2
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_2cmt_linear_bolus(CL=CL, V=V, V2=V2, Q=Q,
t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the two compartment linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100, tinf=1) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- c(0, 0)
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1
ncmt <- 2
extra <- 0
deriv <- FALSE
if (dt <= tinf) {
} else {
l <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
dt <- dt - tinf
extra <- tinf
rateNV <- 0
alastNV <- l$Alast
}
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_2cmt_linear_infusion(CL=CL, V=V, V2=V2, Q=Q,
t=dt+extra, dose=DOSE, tinf=tinf),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the two compartment iv infusion linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
# 3 compartment tests
f <- function(dt,
V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
alastNV <- c(DOSE, 0, 0)
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 3
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_3cmt_linear_bolus(CL=CL, V=V, V2=V2, Q=Q,
V3=V3, Q3=Q2,
t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the two compartment linear compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
# 3 compartment tests, oral
f <- function(dt,
V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
ka=2,
DOSE=100) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- ka
alastNV <- c(DOSE, 0, 0, 0)
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 3
deriv <- FALSE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_3cmt_linear_oral_1(CL=CL, V=V, V2=V2, Q=Q,
V3=V3, Q3=Q2,
ka=ka,
t=dt, dose=DOSE), l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the three compartment linear oral compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100, tinf=1) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
alastNV <- c(0, 0, 0)
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1
ncmt <- 3
extra <- 0
deriv <- FALSE
if (dt <= tinf) {
} else {
l <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
dt <- dt - tinf
extra <- tinf
rateNV <- 0
alastNV <- l$Alast
}
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)$val
c(s=pmxTools::calc_sd_3cmt_linear_infusion(CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2,
t=dt+extra, dose=DOSE, tinf=tinf),
l=l)
}
lapply(seq(.1, 10, by=0.1),
function(d) {
test_that(paste0("test the three compartment linear infusion compartment solution at ", d), {
v <- f(d)
expect_equal(stats::setNames(v["s"], NULL),
stats::setNames(v["l"], NULL))
})
})
####################################################
## AD linCmt()
####################################################
f0 <- function(dt, CL=25, V=20, DOSE=100,
alastNV=c(DOSE, 0, 0)) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
rateNV <- 0
oral0 <- 0
trans <- 1
ncmt <- 1
deriv <- TRUE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
l
#c(s=pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=dt, dose=DOSE), l=l$val)
}
f <- function(dt, CL=25, V=20, DOSE=100) {
test_that(paste0("one compartment bolus t=", dt, ";CL=", CL,
"; V=", V, "; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, DOSE=DOSE)
#
expect_equal(pmxTools::calc_sd_1cmt_linear_bolus(CL=CL, V=V, t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, DOSE=100)
})
f0 <- function(dt, CL=25, V=20, KA=2, DOSE=100,
alastNV=c(DOSE, 0, 0, 0, 0, 0)) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- KA
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 1
deriv <- TRUE
l <- .Call(`_rxode2_linCmtModelDouble`, dt, p1, v1,
p2, p3,
p4, p5,
ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
l
}
f <- function(dt, CL=25, V=20, KA=2, DOSE=100) {
test_that(paste0("one compartment oral t=", dt, ";CL=", CL,
"; V=", V, "; KA=", KA, "; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, KA=KA, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_1cmt_linear_oral_1(CL=CL, V=V, ka=KA, t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, KA=KA, DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, KA=KA, DOSE=DOSE)
#
expect_equal(pmxTools::calc_sd_1cmt_linear_oral_1(CL=CL, V=V, ka=KA, t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, KA=2, DOSE=100)
})
## One compartment IV infusion
f0i <- function(t, CL=25, V=20, DOSE=100, tinf=1,
alastNV=rep(0, 3), rateNV=DOSE/tinf) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
deriv <- TRUE
oral0 <- 0
trans <- 1
ncmt <- 1
if (all(rateNV == 0)) {
# Now a simple eliminiation; Handles the case where the infusion has already past
dt <- t
} else if (t < tinf) {
# infusion not complete
dt <- t
} else {
#Infusion completes during the time
v <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
if (t == tinf) return(v)
# Infusion is now complete
alastNV <- v$Alast
rateNV <- 0
dt <- t - tinf
}
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, CL=25, V=20, DOSE=100, tinf=1) {
test_that(paste0("one compartment infusion t=", dt, ";CL=", CL,
"; V=", V, "; tinf=", tinf, "; DOSE=", DOSE), {
t0 <- dt/2
# See if more care is needed for IV comparison
if (dt < tinf) {
f1 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, alastNV=f1$Alast)
#
f3 <- f0i(t0*2, CL=CL, V=V, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else if (t0 > tinf) {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, rateNV=0,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f2$val)
f3 <- f0i(t0*2, CL=CL, V=V, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0, dose=DOSE, tinf=tinf),
f1$val)
f3 <- f0i(t0*2, CL=CL, V=V, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
tinf2 <- tinf-t0
f2 <- f0i(t0, CL=CL, V=V, DOSE=DOSE, tinf=tinf2, rateNV=rateNV,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_1cmt_linear_infusion(CL=CL, V=V, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
}
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, tinf=1, DOSE=100)
})
## Two compartment bolus
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100,
alastNV=c(DOSE, rep(0, 9))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 2
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100) {
test_that(paste0("two compartment bolus t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_2cmt_linear_bolus(CL=CL, V=V,
V2=V2, Q=Q,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_2cmt_linear_bolus(CL=CL, V=V, V2=V2, Q=Q,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Two compartment oral
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100, ka=2,
alastNV=c(DOSE, rep(0, 13))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 1
trans <- 1
ncmt <- 2
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, ka=2, DOSE=100) {
test_that(paste0("two compartment oral t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; ka=", ka, "DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, ka=ka, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_2cmt_linear_oral_1(
CL=CL, V=V,
V2=V2, Q=Q, ka=ka,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, ka=ka,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2, ka=ka,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_2cmt_linear_oral_1(
CL=CL, V=V, V2=V2, Q=Q, ka=ka,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Two compartment IV infusion
f0i <- function(t, CL=25, V=20, V2 = 297, Q = 10, DOSE=100, tinf=1,
alastNV=rep(0, 10), rateNV=DOSE/tinf) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
deriv <- TRUE
oral0 <- 0
trans <- 1
ncmt <- 2
if (all(rateNV == 0)) {
# Now a simple eliminiation; Handles the case where the infusion has already past
dt <- t
} else if (t < tinf) {
# infusion not complete
dt <- t
} else {
#Infusion completes during the time
v <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
if (t == tinf) return(v)
# Infusion is now complete
alastNV <- v$Alast
rateNV <- 0
dt <- t - tinf
}
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, CL=25, V=20, V2 = 297, Q = 10, DOSE=100, tinf=1) {
test_that(paste0("two compartment infusion t=", dt, ";CL=", CL,
"; V2 = ", V2, "; Q = ", Q,
"; V=", V, "; tinf=", tinf, "; DOSE=", DOSE), {
t0 <- dt/2
# See if more care is needed for IV comparison
if (dt < tinf) {
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q,
DOSE=DOSE, tinf=tinf, alastNV=f1$Alast)
#
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else if (t0 > tinf) {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q,
DOSE=DOSE, tinf=tinf, rateNV=0,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f2$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0, dose=DOSE, tinf=tinf),
f1$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
tinf2 <- tinf-t0
f2 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2,
DOSE=DOSE, tinf=tinf2, rateNV=rateNV,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_2cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
}
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, tinf=1, DOSE=100)
})
## Three compartment model bolus
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100,
alastNV=c(DOSE, rep(0, 20))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- 0
trans <- 1
ncmt <- 3
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400, DOSE=100) {
test_that(paste0("two compartment bolus t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; Q2=", Q2,
"; V3=", V3,
"; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_3cmt_linear_bolus(
CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_3cmt_linear_bolus(
CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Three compartment model oral
f0 <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
ka=2,
DOSE=100,
alastNV=c(DOSE, rep(0, 25))) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- ka
alastNV <- alastNV
rateNV <- c(0, 0)
oral0 <- TRUE
trans <- 1
ncmt <- 3
deriv <- TRUE
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
ka=2, DOSE=100) {
test_that(paste0("three compartment oral t=", dt, ";CL=", CL,
"; V=", V, "; Q=", Q, "; V2=", V2, "; ka=", ka,
"; Q2=", Q2, "; V3=", V3, "; ka=", ka,
"; DOSE=", DOSE), {
t0 <- dt/2
f1 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, ka=ka, DOSE=DOSE)
expect_equal(pmxTools::calc_sd_3cmt_linear_oral_1(
CL=CL, V=V,
V2=V2, Q=Q, Q3=Q2, V3=V3, ka=ka,
t=t0, dose=DOSE),
f1$val)
#
f2 <- f0(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, ka=ka,
DOSE=DOSE, alastNV=f1$Alast)
#
f3 <- f0(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3, ka=ka,
DOSE=DOSE)
#
expect_equal(
pmxTools::calc_sd_3cmt_linear_oral_1(
CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q3=Q2, ka=ka,
t=dt, dose=DOSE),
f3$val)
# Value is in concentration
expect_equal(f2$val, f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d,V = 40, CL = 18, V2 = 297, Q = 10, DOSE=100)
})
## Three compartment IV infusion
f0i <- function(t, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100, tinf=1,
alastNV=rep(0, 21),
rateNV=DOSE/tinf) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- Q2
p5 <- V3
ka <- 0
deriv <- TRUE
oral0 <- 0
trans <- 1
ncmt <- 3
if (all(rateNV == 0)) {
# Now a simple eliminiation; Handles the case where the infusion has already past
dt <- t
} else if (t < tinf) {
# infusion not complete
dt <- t
} else {
#Infusion completes during the time
v <- .Call(`_rxode2_linCmtModelDouble`, tinf, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
if (t == tinf) return(v)
# Infusion is now complete
alastNV <- v$Alast
rateNV <- 0
dt <- t - tinf
}
.Call(`_rxode2_linCmtModelDouble`, dt, p1, v1, p2, p3, p4, p5, ka, alastNV, rateNV, ncmt, oral0, trans, deriv, 0L, 0, 0, 0, 0, 127, 3L, 0.001)
}
f <- function(dt, V = 40, CL = 18, V2 = 297, Q = 10, Q2 = 7, V3 = 400,
DOSE=100, tinf=1) {
test_that(paste0("three compartment infusion t=", dt, ";CL=", CL,
"; V2 = ", V2, "; Q = ", Q,
"; V3 = ", V3, "; Q2 = ", Q2,
"; V=", V, "; tinf=", tinf, "; DOSE=", DOSE), {
t0 <- dt/2
# See if more care is needed for IV comparison
if (dt < tinf) {
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
#
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, alastNV=f1$Alast)
#
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, V3=V3, Q2=Q2,
DOSE=DOSE)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else if (t0 > tinf) {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
f2 <- f0i(t0, CL=CL, V=V, V2=V2, Q=Q, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, rateNV=0,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f2$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
} else {
rateNV <- DOSE/tinf
f1 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2, V3=V3, Q2=Q2,
DOSE=DOSE, tinf=tinf, rateNV=rateNV)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0, dose=DOSE, tinf=tinf),
f1$val)
f3 <- f0i(t0*2, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, tinf=tinf)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
tinf2 <- tinf-t0
f2 <- f0i(t0, CL=CL, V=V, Q=Q, V2=V2, Q2=Q2, V3=V3,
DOSE=DOSE, tinf=tinf2, rateNV=rateNV,
alastNV=f1$Alast)
expect_equal(pmxTools::calc_sd_3cmt_linear_infusion(
CL=CL, V=V, Q=Q, V2=V2, Q3=Q2, V3=V3,
t=t0*2, dose=DOSE, tinf=tinf),
f3$val)
# Unadjusted Jacobian
expect_equal(f2$J, f3$J)
# Jacobian adjusted to concentration
expect_equal(f2$Jg, f3$Jg)
# Alast and gradients are in amounts
expect_equal(f2$Alast, f3$Alast)
# Value is in concentration
expect_equal(f2$val, f3$val)
}
})
}
lapply(seq(.1, 10, by=0.1),
function(d) {
f(d, CL=25, V=20, tinf=1, DOSE=100)
})
}
testVal <- function(rx, val) {
state <- rx$state
state <- setNames(seq_along(state), state)
expect_equal(.getCmtNum(rx),
state[val])
}
testInf <- function(rx, val) {
state <- rx$state
state <- setNames(seq_along(state), state)
.num <- .getCmtNum(rx)
expect_equal(setNames(cmtSupportsInfusion_(.num, rxModelVars(rx)),
names(.getCmtNum(rx))),
val)
}
testOff <- function(rx, val) {
state <- rx$state
state <- setNames(seq_along(state), state)
.num <- .getCmtNum(rx)
expect_equal(setNames(cmtSupportsOff_(.num, rxModelVars(rx)),
names(.num)),
val)
}
test_that("rxode2 parsing of linCmt() 1 compartment with ka", {
rx <- function() {
ini({
popCl <- 1
popV <- 20
bsvCl ~ 0.1
bsvV ~ 0.1
popKeo <- 1.4
bsvKeo ~ 0.1
popKa <- 1
})
model({
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
}
rx <- rxode2({
popCl <- 1
popV <- 20
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
popKa <- 1
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 2L, depotLin = 1L))
testVal(rx, c("depot", "central", "ce"))
testInf(rx, c(depot=TRUE, central=TRUE, ce=TRUE))
testOff(rx, c(depot=FALSE, central=FALSE, ce=TRUE))
expect_equal(rx$state, c("ce", "depot", "central"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popKa <- 1
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 4L, numLin = 2L, depotLin = 1L))
testVal(rx, c("depot", "central", "ce",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_ka", "rx__sens_depot_BY_ka"))
testInf(rx, c(depot=TRUE, central=TRUE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE,
rx__sens_central_BY_ka=FALSE, rx__sens_depot_BY_ka=FALSE))
testOff(rx, c(depot=FALSE, central=FALSE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE,
rx__sens_central_BY_ka=FALSE, rx__sens_depot_BY_ka=FALSE))
expect_equal(rx$state, c("ce",
"depot", "central",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_ka",
"rx__sens_depot_BY_ka"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 1 compartment without ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 1L, depotLin = 0L))
testVal(rx, c("central", "ce"))
testInf(rx, c(central=TRUE, ce=TRUE))
testOff(rx, c(central=FALSE, ce=TRUE))
expect_equal(rx$state, c("ce", "central"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
bsvCl <-0
bsvV <- 0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 2L, numLin = 1L, depotLin = 0L))
testVal(rx, c("central","ce",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1"))
testInf(rx, c(central=TRUE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE))
testOff(rx, c(central=FALSE, ce=TRUE,
rx__sens_central_BY_p1=FALSE, rx__sens_central_BY_v1=FALSE))
expect_equal(rx$state, c("ce",
"central",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 2 compartment without ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 2L, depotLin = 0L))
testVal(rx, c("central", "ce", "peripheral1"))
testInf(rx, c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE))
testOff(rx, c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 8L, numLin = 2L, depotLin = 0L))
testVal(rx, c("central", "ce", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3"))
testInf(rx, c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE))
testOff(rx, c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 2 compartment with ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
popKa <- 1
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvKa <-0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa * exp(bsvKa)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagDepot <- 0
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagDepot <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(depot) <- popLagDepot * exp(bsvLagDepot)
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 3L, depotLin = 1L))
testVal(rx, c("depot", "central", "ce", "peripheral1"))
testInf(rx, c("depot"=TRUE, "central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE))
testOff(rx, c("depot"=FALSE, "central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popKa <- 1
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvKa <-0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
ka ~ popKa * exp(bsvKa)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
keo ~ popKeo * exp(bsvKeo)
popLagDepot <- 0
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagDepot <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(depot) <- popLagDepot * exp(bsvLagDepot)
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
a=depot
b=central
c=peripheral1
}, linCmtSens="linCmtB")
testVal(rx, c("depot", "central", "ce", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_depot_BY_ka"))
testInf(rx, c("depot"=TRUE, "central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
testOff(rx, c("depot"=FALSE, "central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 11L, numLin = 3L, depotLin = 1L))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_depot_BY_ka"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 3 compartment without ka", {
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
popVp2 <- 1
popQ2 <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 3L, depotLin = 0L))
testVal(rx, c("central", "ce", "peripheral1", "peripheral2"))
testInf(rx, c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE))
testOff(rx, c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1", "peripheral2"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popVp2 <- 3
popQ2 <- 4
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 18L, numLin = 3L, depotLin = 0L))
testVal(rx,c("central", "ce", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5"))
testInf(rx,c("central"=TRUE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE))
testOff(rx,c("central"=FALSE, "ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE))
expect_equal(rx$state, c("ce", "central", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5"
))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
test_that("rxode2 parsing of linCmt() 3 compartment with ka", {
rx <- rxode2({
popCl <- 1
popKa <- 4
popV <- 20
popVp <- 10
popQ <- 2
popVp2 <- 1
popQ2 <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
ka ~ popKa
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
})
etTrans(et(amt=3,cmt=1) |> et(1:10), rx)
etTrans(et(amt=3) |> et(1:10), rx)
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 0L, numLin = 4L, depotLin = 1L))
testVal(rx,
c("depot", "central", "ce", "peripheral1", "peripheral2"))
testInf(rx,
c("depot"=TRUE, "central"=TRUE, "ce"=TRUE,
"peripheral1"=FALSE, "peripheral2"=FALSE))
testOff(rx,
c("depot"=FALSE, "central"=FALSE, "ce"=TRUE,
"peripheral1"=FALSE, "peripheral2"=FALSE))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1", "peripheral2"))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtA[(]", rxModelVars(rx)$model["normModel"]))
rx <- rxode2({
popCl <- 1
popKa <- 3
popV <- 20
popVp <- 10
popQ <- 2
bsvCl <-0
bsvV <- 0
bsvVp <- 0
bsvQ <-0
popVp2 <- 3
popQ2 <- 4
popKeo <- 1.4
bsvKeo <- 0
popE0 <- 0
popEmax <- 1
popEC50 <- 5
popGamma <- 1
bsvE0 <- 0
bsvEmax <- 0
bsvEC50 <- 0
##
ka ~ popKa
cl ~ popCl * exp(bsvCl)
v ~ popV * exp(bsvV)
q ~ popQ * exp(bsvQ)
vp ~ popVp * exp(bsvVp)
vp2 ~ popVp2
q2 ~ popQ2
keo ~ popKeo * exp(bsvKeo)
popLagCentral <- 0
popRateCentral <- 0
popDurCentral <- 0
bsvLagCentral <- 0
bsvRateCentral <- 0
bsvDurCentral <- 0
alag(central) <- popLagCentral * exp(bsvLagCentral)
rate(central) <- popRateCentral * exp(bsvRateCentral)
dur(central) <- popDurCentral * exp(bsvDurCentral)
cp <- linCmt()
d/dt(ce) = keo*(cp-ce)
effect = E0 - Emax*(Ce^gamma)/((Ce^gamma)+(Ec50^gamma));
b=central
c=peripheral1
}, linCmtSens="linCmtB")
expect_equal(getLinInfo_(rxModelVars(rx)),
c(numLinSens = 22L, numLin = 4L, depotLin = 1L))
testVal(rx,
c("depot", "central", "ce", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5",
"rx__sens_peripheral2_BY_ka",
#
"rx__sens_depot_BY_ka"))
testInf(rx,
c("depot"=TRUE, "central"=TRUE,
"ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE,
"rx__sens_peripheral2_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
testOff(rx,
c("depot"=FALSE, "central"=FALSE,
"ce"=TRUE, "peripheral1"=FALSE, "peripheral2"=FALSE,
"rx__sens_central_BY_p1"=FALSE, "rx__sens_central_BY_v1"=FALSE,
"rx__sens_central_BY_p2"=FALSE, "rx__sens_central_BY_p3"=FALSE,
"rx__sens_central_BY_p4"=FALSE, "rx__sens_central_BY_p5"=FALSE,
"rx__sens_central_BY_ka"=FALSE,
#
"rx__sens_peripheral1_BY_p1"=FALSE, "rx__sens_peripheral1_BY_v1"=FALSE,
"rx__sens_peripheral1_BY_p2"=FALSE, "rx__sens_peripheral1_BY_p3"=FALSE,
"rx__sens_peripheral1_BY_p4"=FALSE, "rx__sens_peripheral1_BY_p5"=FALSE,
"rx__sens_peripheral1_BY_ka"=FALSE,
#
"rx__sens_peripheral2_BY_p1"=FALSE, "rx__sens_peripheral2_BY_v1"=FALSE,
"rx__sens_peripheral2_BY_p2"=FALSE, "rx__sens_peripheral2_BY_p3"=FALSE,
"rx__sens_peripheral2_BY_p4"=FALSE, "rx__sens_peripheral2_BY_p5"=FALSE,
"rx__sens_peripheral2_BY_ka"=FALSE,
#
"rx__sens_depot_BY_ka"=FALSE))
expect_equal(rx$state, c("ce", "depot", "central", "peripheral1", "peripheral2",
"rx__sens_central_BY_p1", "rx__sens_central_BY_v1",
"rx__sens_central_BY_p2", "rx__sens_central_BY_p3",
"rx__sens_central_BY_p4", "rx__sens_central_BY_p5",
"rx__sens_central_BY_ka",
#
"rx__sens_peripheral1_BY_p1", "rx__sens_peripheral1_BY_v1",
"rx__sens_peripheral1_BY_p2", "rx__sens_peripheral1_BY_p3",
"rx__sens_peripheral1_BY_p4", "rx__sens_peripheral1_BY_p5",
"rx__sens_peripheral1_BY_ka",
#
"rx__sens_peripheral2_BY_p1", "rx__sens_peripheral2_BY_v1",
"rx__sens_peripheral2_BY_p2", "rx__sens_peripheral2_BY_p3",
"rx__sens_peripheral2_BY_p4", "rx__sens_peripheral2_BY_p5",
"rx__sens_peripheral2_BY_ka",
#
"rx__sens_depot_BY_ka"
))
expect_equal(rx$stateExtra, character(0))
expect_true(grepl("linCmtB[(]", rxModelVars(rx)$model["normModel"]))
})
if (requireNamespace("pmxTools", quietly = TRUE)) {
test_that("rxode2 solving of 1 compartment steady state bolus", {
f <- function(CL=6, V=25, DOSE=600, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- c(0, 0, 0)
} else {
alastNV <- 0
}
rateNV <- 0
oral0 <- 0
trans <- 1L
ncmt <- 1
type <- 3L # ss bolus
amt <- DOSE
tinf <- 1
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans, deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_1cmt_linear_bolus(t=0, CL=6, V=25, dose=600, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,pmxTools::calc_ss_1cmt_linear_bolus(t=0, CL=6, V=25, dose=600, tau=24))
expect_equal(dim(v$J), 1:2)
expect_length(v$Jg, 2)
expect_length(v$Alast, 3)
})
test_that("rxode2 solving of 1 compartment steady state infusion", {
f <- function(CL=2, V=25, DOSE=600, tinf=1, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- c(0, 0, 0)
} else {
alastNV <- 0
}
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1L
ncmt <- 1
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_1cmt_linear_infusion(tad=0, CL=2, V=25, dose=600, tinf=1, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_1cmt_linear_infusion(tad=0, CL=2, V=25, dose=600, tinf=1, tau=24))
expect_equal(dim(v$J), 1:2)
expect_length(v$Jg, 2)
expect_length(v$Alast, 3)
})
test_that("rxode2 solving of 1 compartment steady state 1st order dosing", {
f <- function(CL=2, V=25, DOSE=600, ka=0.25, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- c(0, 0, 0, 0, 0, 0)
} else {
alastNV <- c(0, 0)
}
rateNV <- c(0, 0)
oral0 <- 1L
trans <- 1L
ncmt <- 1
type <- 3L # bolus infusion
amt <- DOSE
dt <- 0
cmt <- 0L
tinf <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
pmxTools::calc_ss_1cmt_linear_oral_1(tad=0, CL=2, V=25, dose=600, ka=0.25, tau=24))
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_1cmt_linear_oral_1(tad=0, CL=2, V=25, dose=600, ka=0.25, tau=24))
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
})
test_that("rxode2 solving of 1 compartment steady state for constant infusion", {
## Now test the solutions not covered by pmxTools by cross testing
## against rxode2 lsoda
rx <- rxode2({
CL <- 6
V <- 25
kel <- CL/V
d/dt(central) = -kel*central
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, DOSE=600, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- c(0, 0, 0)
} else {
alastNV <- 0
}
rateNV <- 600
oral0 <- 0
trans <- 1L
ncmt <- 1
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1])
v <- f(deriv=TRUE)
expect_equal(v$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1])
expect_equal(dim(v$J), 1:2)
expect_length(v$Jg, 2)
expect_length(v$Alast, 3)
})
test_that("rxode2 solving of 1 compartment steady state for constant depot infusion", {
rx <- rxode2({
CL <- 6
V <- 25
ka <- 0.25
kel <- CL/V
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, DOSE=600, ka=0.25, rate=c(600, 0), deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- c(0, 0, 0, 0, 0, 0)
} else {
alastNV <- c(0, 0)
}
rateNV <- rate
oral0 <- 1L
trans <- 1L
ncmt <- 1
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1])
expect_equal(f()$Alast,
c(s$depot[1], s$central[1]))
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1])
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]))
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
# Now infusion in the 2 compartment models to central
e <- et(amt=0, rate=600, ss=1, cmt=2) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(rate=c(0, 600))$val,
s$cp[1])
expect_equal(f(rate=c(0, 600))$Alast,
c(s$depot[1], s$central[1]))
v <- f(rate=c(0, 600), deriv=TRUE)
expect_equal(v$val,
s$cp[1])
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]))
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
})
test_that("rxode2 solving of 1 compartment steady state for constant depot infusion", {
f <- function(CL=2, V=25, DOSE=600, tinf=1, tau=6, deriv=FALSE, cmt=0L,
ka=0.25) {
p1 <- CL
v1 <- V
p2 <- 0
p3 <- 0
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- c(0, 0, 0, 0, 0, 0)
} else {
alastNV <- c(0, 0)
}
if (cmt == 0L) {
rateNV <- c(DOSE/tinf, 0)
} else {
rateNV <- c(0, DOSE/tinf)
}
oral0 <- 1L
trans <- 1L
ncmt <- 1
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
rx <- rxode2({
CL <- 2
V <- 25
ka <- 0.25
kel <- CL/V
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot
cp <- central/V
})
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=depot) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast,
c(s$depot[1], s$central[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=central) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(cmt=1L)$val,
s$cp[1], tolerance = 1e-3)
expect_equal(f(cmt=1L)$Alast,
c(s$depot[1], s$central[1]),
tolerance = 1e-3)
v <- f(cmt=1L, deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance = 1e-3)
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]), tolerance = 1e-3)
expect_equal(dim(v$J), 2:3)
expect_length(v$Jg, 3)
expect_length(v$Alast, 6)
})
####################################################################
## Test the 2 compartment steady state solutions
####################################################################
test_that("rxode2 solving of 2 compartment steady state bolus", {
f <- function(CL=7.5, V=20, V2 = 30, Q = 0.5, DOSE=10, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- 0
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 3L # ss bolus
amt <- DOSE
tinf <- 1
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans, deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_2cmt_linear_bolus(0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_2cmt_linear_bolus(0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tau=24))
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 2 compartment steady state infusion", {
f <- function(CL=7.5, V=20, V2=30, Q=0.5, DOSE=10, tinf=1, tau=12, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
f()$val)
v <- f(deriv=TRUE)
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
v$val)
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 2 compartment steady state 1st order dosing", {
f <- function(CL=7.5, V=20, V2=30, Q=0.5, DOSE=1000, ka=1, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- rep(0, 14)
} else {
alastNV <- c(0, 0, 0)
}
rateNV <- c(0, 0)
oral0 <- 1L
trans <- 1L
ncmt <- 2
type <- 3L # bolus infusion
amt <- DOSE
dt <- 0
cmt <- 0L
tinf <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
pmxTools::calc_ss_2cmt_linear_oral_1(tad=0, CL=7.5, V1=20, V2=30, Q=0.5, dose=1000, ka=1, tau=24))
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_2cmt_linear_oral_1(tad=0, CL=7.5, V1=20, V2=30, Q=0.5, dose=1000, ka=1, tau=24))
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
})
test_that("rxode2 solving of 2 compartment steady state for constant infusion", {
## Now test the solutions not covered by pmxTools by cross testing
## against rxode2 lsoda
rx <- rxode2({
CL <- 6
V <- 25
Q <- 0.5
V2 <- 30
k12 <- Q/V
k21 <- Q/V2
kel <- CL/V
d/dt(central) = -kel*central + k21*peripheral - k12*central
d/dt(peripheral) = k12*central - k21*peripheral
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, Q=0.5, V2=30, DOSE=600, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- 600
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 2 compartment steady state for constant depot infusion", {
rx <- rxode2({
CL <- 6
V <- 25
Q <- 0.5
V2 <- 30
k12 <- Q/V
k21 <- Q/V2
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + k21*peripheral - k12*central + ka*depot
d/dt(peripheral) = k12*central - k21*peripheral
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL=6, V=25, Q=0.5, V2=30, DOSE=600, ka=0.25, rate=c(600, 0), deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- rep(0, 14)
} else {
alastNV <- rep(0, 3)
}
rateNV <- rate
oral0 <- 1L
trans <- 1L
ncmt <- 2
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
# Now infusion in the 2 compartment models to central
e <- et(amt=0, rate=600, ss=1, cmt=2) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(rate=c(0, 600))$val,
s$cp[1], tolerance=1e-3)
expect_equal(f(rate=c(0, 600))$Alast[1:3],
c(s$depot[1], s$central[1],s$peripheral[1]),
tolerance=1e-3)
v <- f(rate=c(0, 600), deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
})
test_that("rxode2 solving of 2 compartment steady state for constant depot infusion", {
f <- function(CL=2, V=25, Q=0.5, V2=30, DOSE=600, tinf=1, tau=6, deriv=FALSE, cmt=0L,
ka=0.25) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- ka
if (deriv) {
alastNV <- rep(0, 14)
} else {
alastNV <- rep(0, 3)
}
if (cmt == 0L) {
rateNV <- c(DOSE/tinf, 0)
} else {
rateNV <- c(0, DOSE/tinf)
}
oral0 <- 1L
trans <- 1L
ncmt <- 2
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
rx <- rxode2({
CL <- 2
V <- 25
Q <- 0.5
V2 <- 30
k12 <- Q/V
k21 <- Q/V2
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + k21*peripheral - k12*central + ka*depot
d/dt(peripheral) = k12*central - k21*peripheral
cp <- central/V
})
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=depot) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast,
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:3],
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5)
expect_length(v$Alast, 14)
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=central) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(cmt=1L)$val,
s$cp[1], tolerance = 1e-3)
expect_equal(f(cmt=1L)$Alast,
c(s$depot[1], s$central[1], s$peripheral[1]),
tolerance = 1e-3)
v <- f(cmt=1L, deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance = 1e-3)
expect_equal(v$Alast[1:2],
c(s$depot[1], s$central[1]), tolerance = 1e-3)
expect_equal(dim(v$J), c(3L, 5L))
expect_length(v$Jg, 5L)
expect_length(v$Alast, 14)
})
####################################################################
## Test the 3 compartment steady state solutions
####################################################################
test_that("rxode2 solving of 3 compartment steady state bolus", {
f <- function(CL=3.5, V1=20, V2 = 500, V3=200, Q2=0.5, Q3 = 0.05, DOSE=100, tau=24, deriv=FALSE) {
p1 <- CL
v1 <- V1
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- 0
if (deriv) {
alastNV <- rep(0, 21)
} else {
alastNV <- c(0, 0, 0)
}
rateNV <- 0
oral0 <- 0
trans <- 1L
ncmt <- 3
type <- 3L # ss bolus
amt <- DOSE
tinf <- 1
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans, deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_3cmt_linear_bolus(0, CL=3.5, V1=20, V2 = 500, V3=200, Q2=0.5, Q3 = 0.05, dose=100, tau=24),
f()$val)
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_3cmt_linear_bolus(0, CL=3.5, V1=20, V2 = 500, V3=200, Q2=0.5, Q3 = 0.05, dose=100, tau=24))
expect_equal(dim(v$J), c(3L, 6L))
expect_length(v$Jg, 6)
expect_length(v$Alast, 21)
})
test_that("rxode2 solving of 3 compartment steady state infusion", {
f <- function(CL=7.5, V=20, V2=30, Q=0.5, DOSE=10, tinf=1, tau=12, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q
p3 <- V2
p4 <- 0
p5 <- 0
ka <- 0
if (deriv) {
alastNV <- rep(0, 10)
} else {
alastNV <- c(0, 0)
}
rateNV <- DOSE/tinf
oral0 <- 0
trans <- 1L
ncmt <- 2
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
cmt <- 0L
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
f()$val)
v <- f(deriv=TRUE)
expect_equal(pmxTools::calc_ss_2cmt_linear_infusion(tad = 0, CL = 7.5, V1 = 20, V2 = 30, Q = 0.5,
dose = 10, tinf = 1, tau = 12),
v$val)
expect_equal(dim(v$J), c(2L, 4L))
expect_length(v$Jg, 4)
expect_length(v$Alast, 10)
})
test_that("rxode2 solving of 3 compartment steady state 1st order dosing", {
f <- function(CL=7.5, V1=20, V2=30, V3=200, Q2=0.5, Q3=0.05, ka=1, DOSE=100, tau=24, deriv=FALSE, ndiff=127) {
p1 <- CL
v1 <- V1
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- ka
if (deriv) {
alastNV <- rep(0, 26)
} else {
alastNV <- c(0, 0, 0, 0)
}
rateNV <- c(0, 0)
oral0 <- 1L
trans <- 1L
ncmt <- 3
type <- 3L # bolus infusion
amt <- DOSE
dt <- 0
cmt <- 0L
tinf <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, ndiff, 3L, 0.001)
}
expect_equal(f()$val,
pmxTools::calc_ss_3cmt_linear_oral_1(tad = 0, CL = 7.5, V1 = 20,
V2 = 30, V3 = 200, Q2 = 0.5,
Q3 = 0.05, ka = 1, dose = 100,
tau = 24))
v <- f(deriv=TRUE)
expect_equal(v$val,
pmxTools::calc_ss_3cmt_linear_oral_1(tad = 0, CL = 7.5, V1 = 20,
V2 = 30, V3 = 200, Q2 = 0.5,
Q3 = 0.05, ka = 1, dose = 100,
tau = 24))
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
})
test_that("rxode2 solving of 3 compartment steady state for constant infusion", {
## Now test the solutions not covered by pmxTools by cross testing
## against rxode2 lsoda
rx <- rxode2({
CL <- 6
V <- 25
V2 <- 30
V3 <- 200
Q2 <- 0.5
Q3 <- 0.05
k12 <- Q2/V
k21 <- Q2/V2
k13 <- Q3/V
k31 <- Q3/V3
kel <- CL/V
d/dt(central) = -kel*central + k21*peripheral - k12*central +
k31*peripheral2 - k13*central
d/dt(peripheral) = k12*central - k21*peripheral
d/dt(peripheral2) = k13*central - k31*peripheral2
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
f <- function(CL= 6, V = 25, V2 = 30, V3 = 200,
Q2= 0.5,
Q3= 0.05,
DOSE=600, deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- 0
if (deriv) {
alastNV <- rep(0, 21)
} else {
alastNV <- c(0, 0, 0)
}
rateNV <- 600
oral0 <- 0
trans <- 1L
ncmt <- 3
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
expect_equal(f()$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
rxSolve(rx, e, addDosing =TRUE)$cp[1],
tolerance = 1e-3)
expect_equal(dim(v$J), c(3L, 6L))
expect_length(v$Jg, 6)
expect_length(v$Alast, 21)
})
test_that("rxode2 solving of 3 compartment steady state for constant depot infusion", {
rx <- rxode2({
CL <- 6
V <- 25
Q2 <- 0.5
Q3 <- 0.05
V2 <- 30
V3 <- 300
k12 <- Q2/V
k21 <- Q2/V2
k13 <- Q3/V
k31 <- Q3/V3
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot +
k21*peripheral - k12*central +
k31*peripheral1 - k13*central
d/dt(peripheral) = k12*central - k21*peripheral
d/dt(peripheral1) = k13*central - k31*peripheral1
cp <- central/V
})
e <- et(amt=0, rate=600, ss=1) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
f <- function(CL=6, V=25, Q2=0.5, Q3=0.05, V2=30, V3=300, DOSE=600,
ka=0.25, rate=c(600, 0), deriv=FALSE) {
p1 <- CL
v1 <- V
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- ka
if (deriv) {
alastNV <- rep(0, 26)
} else {
alastNV <- rep(0, 4)
}
rateNV <- rate
oral0 <- 1L
trans <- 1L
ncmt <- 3
type <- 1L # ss infinite infusion
amt <- 0
tinf <- 0
dt <- 0
cmt <- 0L
tau <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1],
s$peripheral1[1]), tolerance=1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
# Now infusion in the 3 compartment models to central
e <- et(amt=0, rate=600, ss=1, cmt=2) |>
et(time=seq(1:25))
s <- rxSolve(rx, e, addDosing =TRUE)
expect_equal(f(rate=c(0, 600))$val,
s$cp[1], tolerance=1e-3)
expect_equal(f(rate=c(0, 600))$Alast[1:3],
c(s$depot[1], s$central[1],s$peripheral[1]),
tolerance=1e-3)
v <- f(rate=c(0, 600), deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance=1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
})
test_that("rxode2 solving of 3 compartment steady state for constant depot infusion", {
f <- function(CL=6, V=25, Q2=0.5, Q3=0.05, V2=30, V3=300, DOSE=600, tinf=1, tau=6, deriv=FALSE, cmt=0L,
ka=0.25) {
p1 <- CL
v1 <- V
p2 <- Q2
p3 <- V2
p4 <- Q3
p5 <- V3
ka <- ka
if (deriv) {
alastNV <- rep(0, 26)
} else {
alastNV <- rep(0, 4)
}
if (cmt == 0L) {
rateNV <- c(DOSE/tinf, 0)
} else {
rateNV <- c(0, DOSE/tinf)
}
oral0 <- 1L
trans <- 1L
ncmt <- 3
type <- 2L # ss infusion
amt <- DOSE
dt <- 0
.Call(`_rxode2_linCmtModelDouble`, 0.1,
p1, v1, p2, p3, p4, p5, ka,
alastNV, rateNV, ncmt, oral0, trans,
deriv, type, tau, tinf, amt, cmt, 127, 3L, 0.001)
}
rx <- rxode2({
CL <- 6
V <- 25
Q2 <- 0.5
Q3 <- 0.05
V2 <- 30
V3 <- 300
k12 <- Q2/V
k21 <- Q2/V2
k13 <- Q3/V
k31 <- Q3/V3
kel <- CL/V
ka <- 0.25
d/dt(depot) = -ka*depot
d/dt(central) = -kel*central + ka*depot +
k21*peripheral - k12*central +
k31*peripheral1 - k13*central
d/dt(peripheral) = k12*central - k21*peripheral
d/dt(peripheral1) = k13*central - k31*peripheral1
cp <- central/V
})
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=depot) |>
et(time=0.5)
s <- rxSolve(rx, e, addDosing =TRUE, maxsteps=700000)
expect_equal(f()$val,
s$cp[1], tolerance=1e-3)
expect_equal(f()$Alast,
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance=1e-3)
v <- f(deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance=1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7)
expect_length(v$Alast, 26)
e <- et(amt=600, rate=600, ss=1, ii=6, cmt=central) |>
et(time=0.5)
s <- rxSolve(rx, e, addDosing =TRUE, , maxsteps=700000)
expect_equal(f(cmt=1L)$val,
s$cp[1], tolerance = 1e-3)
expect_equal(f(cmt=1L)$Alast,
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance = 1e-3)
v <- f(cmt=1L, deriv=TRUE)
expect_equal(v$val,
s$cp[1], tolerance = 1e-3)
expect_equal(v$Alast[1:4],
c(s$depot[1], s$central[1], s$peripheral[1], s$peripheral1[1]),
tolerance = 1e-3)
expect_equal(dim(v$J), c(4L, 7L))
expect_length(v$Jg, 7L)
expect_length(v$Alast, 26)
})
}
})
Try the rxode2 package in your browser
Any scripts or data that you put into this service are public.
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.