Skip to content

Commit

Permalink
Merge pull request #142 from nlmixr2/poped-g_xt
Browse files Browse the repository at this point in the history 
Fix G_xt in event table
  • Loading branch information
@mattfidler
mattfidler authored Oct 24, 2024
2 parents 13a25ec + a56bad9 commit 8f7b4ac
Show file tree
Hide file tree
Showing 2 changed files with 110 additions and 9 deletions.
23 changes: 14 additions & 9 deletions R/poped.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1181,7 +1181,7 @@ attr(rxUiGet.popedNotfixedSigma, "desc") <- "PopED database $notfixed_sigma"
.wid <- which(.nd == id)
if (length(.wid) == 0L) {
.data$id <- 1L
.nd <- names(.data)
.nd <- tolower(names(.data))
.wid <- which(.nd == id)
} else if (length(.wid) != 1L) {
stop("duplicate ids found",
Expand Down Expand Up @@ -1216,7 +1216,8 @@ attr(rxUiGet.popedNotfixedSigma, "desc") <- "PopED database $notfixed_sigma"
if (length(.wg_xt) == 1L) {
.g_xt <- .data[[.wg_xt]]
.g_xt <- .g_xt[.wd]
return(time=.time, dvid=i, G_xt=.g_xt)

return(data.frame(time=.time, dvid=i, G_xt=.g_xt))
}
return(data.frame(time=.time, dvid=i))
}
Expand All @@ -1231,7 +1232,7 @@ attr(rxUiGet.popedNotfixedSigma, "desc") <- "PopED database $notfixed_sigma"
if (length(.wg_xt) == 1L) {
.g_xt <- .data[[.wg_xt]]
.g_xt <- .g_xt[.wd]
return(time=.time, dvid=i, G_xt=.g_xt)
return(data.frame(time=.time, dvid=i, G_xt=.g_xt))
}
return(data.frame(time=.time, dvid=i))
}
Expand All @@ -1240,9 +1241,6 @@ attr(rxUiGet.popedNotfixedSigma, "desc") <- "PopED database $notfixed_sigma"
call.=FALSE)
}))
})
if (length(.wg_xt) == 1L) {
.G_xt <- .xt$G_xt
}
} else {
.xt <- lapply(.poped$uid,
function(id) {
Expand All @@ -1253,6 +1251,14 @@ attr(rxUiGet.popedNotfixedSigma, "desc") <- "PopED database $notfixed_sigma"
.ret
})
}
if (length(.wg_xt) == 1L) {
.G_xt <- do.call(`c`,
lapply(seq_along(.xt), function(i) {
.xt[[i]]$G_xt
}))
} else {
.G_xt <- NULL
}
.single <- FALSE
.modelSwitch <- NULL
if (length(.xt) == 1L) {
Expand Down Expand Up @@ -2043,7 +2049,6 @@ rxUiGet.popedOptsw <- function(x, ...) {
discrete_a=.poped$discrete_a,
optsw=.ui$popedOptsw,
G_xt=.poped$G_xt)

} else {
.ln <- tolower(names(data))
.w <- which(.ln == "id")
Expand Down Expand Up @@ -3124,10 +3129,10 @@ babelBpopIdx <- function(popedInput, var) {
}

#' Internal function to use with PopED to run PopED in parallel on Windows
#'
#'
#' @param babelmixr2 environment in poped environment
#' @return nothing, called for side effects
#' @export
#' @export
#' @author Matthew L. Fidler
#' @keywords internal
.popedCluster <- function(babelmixr2) {
Expand Down
96 changes: 96 additions & 0 deletions tests/testthat/test-poped.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -167,6 +167,7 @@ if (requireNamespace("PopED", quietly=TRUE)) {
withr::with_seed(42, {

set.seed(42)

phenoWt <- function() {
ini({
tcl <- log(0.008) # typical value of clearance
Expand Down Expand Up @@ -746,4 +747,99 @@ if (requireNamespace("PopED", quietly=TRUE)) {
expect_equal(eval(.popedRxModel(p))$lhs, c("rx_pred_", "rx_r_"))

})

test_that("test G_xt setup", {

library(PopED)

##-- Model: One comp first order absorption + inhibitory imax
## -- works for both mutiple and single dosing
f <- function() {
ini({
tV <- 72.8
tKa <- 0.25
tCl <- 3.75
tFavail <- fix(0.9)
tE0 <- 1120
tImax <- 0.807
tIC50 <- 0.0993
eta.v ~ 0.09
eta.ka ~ 0.09
eta.cl ~ 0.25^2
eta.e0 ~ 0.09
conc.prop.sd <- fix(sqrt(0.04))
conc.sd <- fix(sqrt(5e-6))
eff.prop.sd <- fix(sqrt(0.09))
eff.sd <- fix(sqrt(100))
})
model({
V<- tV*exp(eta.v)
KA <- tKa*exp(eta.ka)
CL <- tCl*exp(eta.cl)
Favail <- tFavail
E0 <- tE0*exp(eta.e0)
IMAX <- tImax
IC50 <- tIC50
# PK
N <- floor(time/TAU)+1
CONC <- (DOSE*Favail/V)*(KA/(KA - CL/V)) *
(exp(-CL/V * (time - (N - 1) * TAU)) *
(1 - exp(-N * CL/V * TAU))/(1 - exp(-CL/V * TAU)) -
exp(-KA * (time - (N - 1) * TAU)) * (1 - exp(-N * KA * TAU))/(1 - exp(-KA * TAU)))
# PD model
EFF <- E0*(1 - CONC*IMAX/(IC50 + CONC))
CONC ~ add(conc.sd) + prop(conc.prop.sd)
EFF ~ add(eff.sd) + prop(eff.prop.sd)
})
}

# Note that design point 240 is repeated
e1 <- et(c( 1,2,8,240, 240)) %>%
as.data.frame() %>%
dplyr::mutate(dvid=1)

e1$low <- c(0,0,0,240, 240)
e1$high <- c(10,10,10,248, 248)
# Since the design point is repeated, there needs to be a grouping
# variable which is defined in the dataset as G_xt since it is defined
# in PopED as G_xt
e1$G_xt <- seq_along(e1$low)

e2 <- e1
e2$dvid <- 2
e <- rbind(e1, e2)

babel.db <- nlmixr2(f, e, "poped",
popedControl(
groupsize=20,
discrete_xt = list(0:248),
bUseGrouped_xt=TRUE,
a=list(c(DOSE=20,TAU=24),
c(DOSE=40, TAU=24),
c(DOSE=0, TAU=24)),
maxa=c(DOSE=200,TAU=40),
mina=c(DOSE=0,TAU=2),
ourzero=0))

expect_false(is.null(babel.db$design_space$G_xt))

e <- rbind(e1, e2)
e <- e[,names(e) != "G_xt"]

babel.db <- nlmixr2(f, e, "poped",
popedControl(
groupsize=20,
discrete_xt = list(0:248),
bUseGrouped_xt=TRUE,
a=list(c(DOSE=20,TAU=24),
c(DOSE=40, TAU=24),
c(DOSE=0, TAU=24)),
maxa=c(DOSE=200,TAU=40),
mina=c(DOSE=0,TAU=2),
ourzero=0))

expect_true(is.null(babel.db$design$G_xt))

})

}

0 comments on commit 8f7b4ac

Please sign in to comment.