Test and another fix

nlmixr2 · Oct 24, 2024 · a56bad9 · a56bad9
1 parent ce525cd
commit a56bad9
Show file tree

Hide file tree

Showing 2 changed files with 104 additions and 6 deletions.
diff --git a/R/poped.R b/R/poped.R
@@ -1241,12 +1241,6 @@ attr(rxUiGet.popedNotfixedSigma, "desc") <- "PopED database $notfixed_sigma"
                                           call.=FALSE)
                                    }))
                   })
-    if (length(.wg_xt) == 1L) {
-      .G_xt <- do.call(`c`,
-                       lapply(seq_along(.xt), function(i) {
-        .xt[[i]]$G_xt
-                       }))
-    }
   } else {
     .xt <- lapply(.poped$uid,
                   function(id) {
@@ -1257,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) {

diff --git a/tests/testthat/test-poped.R b/tests/testthat/test-poped.R
@@ -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
@@ -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))
+
+  })
+
 }