Merge pull request #151 from nlmixr2/150-advan5

Initial implementation
nlmixr2 · Jun 30, 2023 · 3d61c01 · 3d61c01
2 parents cef6736 + c4b4474
commit 3d61c01
Show file tree

Hide file tree

Showing 9 changed files with 170 additions and 9 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # nonmem2rx (development version)
 
+* Added support for `ADVAN5` and `ADVAN7` models
+
 * Add parsing of accept/ignore characters for example `IGNORE=(C='C')`
   (See Issue #140)
 

diff --git a/R/advan5.R b/R/advan5.R
@@ -0,0 +1,48 @@
+#' Handle the Ks for advan5/7 ode processing
+#' @param k This is the detected K parameter
+#' @return nothing called for side effects
+#' @noRd
+#' @author Matthew L. Fidler
+.advan5handleK <- function(k) {
+  if (!(.nonmem2rx$advan %in% c(5L, 7L))) return(NULL)
+  if (k %in% .nonmem2rx$advan5k) return(NULL)
+  .reg1 <- "^[Kk]([1-9])[Tt]?([0-9])$"
+  .reg2 <- "^[Kk]([1-9][0-9]*)[Tt]([0-9]+)$"
+  if (grepl(.reg1, k)) {
+    .n1 <- as.numeric(gsub(.reg1, "\\1", k))
+    .n2 <- as.numeric(gsub(.reg1, "\\2", k))
+  } else if (grepl(.reg2, k)) {
+    .n1 <- as.numeric(gsub(.reg2, "\\1", k))
+    .n2 <- as.numeric(gsub(.reg2, "\\2", k))
+  } else {
+    return(NULL)
+  }
+  .newMax <- max(.n1, .n2, .nonmem2rx$advan5max)
+  if (.newMax > .nonmem2rx$advan5max) {
+    .nonmem2rx$advan5 <- c(.nonmem2rx$advan5, rep("", .newMax - .nonmem2rx$advan5max))
+    .nonmem2rx$advan5max <- .newMax
+  }
+  .nonmem2rx$advan5[.n1] <- paste0(.nonmem2rx$advan5[.n1], "-", k, "*rxddta", .n1)
+  .pushObservedDadt(.n1)
+  .setMaxA(.n1)
+  if (.n2 != 0) {
+    .nonmem2rx$advan5[.n2] <- paste0(.nonmem2rx$advan5[.n2], "+", k, "*rxddta", .n1)
+    .pushObservedDadt(.n2)
+    .setMaxA(.n2)
+  }
+  .nonmem2rx$advan5k <- c(.nonmem2rx$advan5k, k)
+  NULL
+}
+#' Get the advan5 odes
+#'  
+#' @return advan5 odes if defined
+#' @author Matthew L. Fidler
+ #' @noRd
+.advan5odes <- function() {
+  if (!(.nonmem2rx$advan %in% c(5L, 7L))) return("")
+  .w <- which(.nonmem2rx$advan5 == "")
+  .ret <- paste0("d/dt(rxddta", seq_along(.nonmem2rx$advan5), ") <- ",
+                 gsub("^[+]", "", .nonmem2rx$advan5))
+  if (length(.w) > 0) .ret <- .ret[-.w]
+  paste0("\n",paste(.ret, collapse="\n"))
+}
diff --git a/R/nonmem2rx.R b/R/nonmem2rx.R
@@ -69,6 +69,9 @@
   .nonmem2rx$needExtCalc <- TRUE
   .nonmem2rx$mixp <- integer(0)
   .nonmem2rx$nspop <- 0L
+  .nonmem2rx$advan5 <- NULL
+  .nonmem2rx$advan5max <- 0L
+  .nonmem2rx$advan5k <- NULL
 }
 #' Add theta name to .nonmem2rx info
 #'
@@ -725,7 +728,7 @@ nonmem2rx <- function(file, inputData=NULL, nonmemOutputDir=NULL,
                           "d/dt(depot)=0\nd/dt(central)=0\n"),
                    ifelse(.nonmem2rx$needExit, "ierprdu <- -1\n", ""),
                    paste(.nonmem2rx$model, collapse="\n"),
-
+                  .advan5odes(),
                    "\n})",
                    "}")
     .fun <- eval(parse(text=.txt))

diff --git a/R/sub.R b/R/sub.R
@@ -26,10 +26,10 @@ nonmem2rxRec.sub <- function(x) {
   for (.cur in .x) {
     .Call(`_nonmem2rx_trans_sub`, .cur)
   }
-  if (.nonmem2rx$advan %in% c(5L, 7L)) {
-    stop("General Linear model translation not supported (ADVAN5 or ADVAN7)",
-         call.=FALSE)
-  }
+  ## if (.nonmem2rx$advan %in% c(5L, 7L)) {
+  ##   stop("General Linear model translation not supported (ADVAN5 or ADVAN7)",
+  ##        call.=FALSE)
+  ## }
   if (.nonmem2rx$advan %in% c(9L, 15L)) {
     stop("Differential Algebra Equations are not supported in translation (ADVAN9 or ADVAN15)",
          call.=FALSE)

diff --git a/src/abbrev.c b/src/abbrev.c
@@ -88,6 +88,7 @@ SEXP nonmem2rxAddLhsVar(const char* v);
 SEXP nonmem2rxGetExtendedVar(const char *v);
 SEXP nonmem2rxMixP(int p);
 SEXP nonmem2rxNspop(int nspop);
+SEXP nonmem2rxAdvan5handleK(const char* v);
 
 int maxA = 0,
   definingScale = 0;
@@ -309,6 +310,7 @@ int abbrev_identifier_or_constant(char *name, int i, D_ParseNode *pn) {
       sAppendN(&curLine, "nmipredsim", 10);
       return 1;
     }
+    if (v[0] == 'K') nonmem2rxAdvan5handleK(v);
     // use only upper case in output since NONMEM is case insensitive and rxode2 is sensitive.
     if (extendedCtrlInt && strstr(curLine.s, "<-") != NULL) {
       char *v2 = (char*) rc_dup_str(CHAR(STRING_ELT(nonmem2rxGetExtendedVar(v), 0)),0);

diff --git a/src/util.cpp b/src/util.cpp
@@ -536,3 +536,11 @@ extern "C" SEXP nonmem2rxNspop(int nspop) {
   END_RCPP
 }
 
+
+extern "C" SEXP nonmem2rxAdvan5handleK(const char* v) {
+  BEGIN_RCPP
+  Environment nonmem2rxNs = loadNamespace("nonmem2rx");
+  Function advan5handleK(".advan5handleK", nonmem2rxNs);
+  return advan5handleK(v);
+  END_RCPP
+}
diff --git a/tests/testthat/test-advan5.R b/tests/testthat/test-advan5.R
@@ -0,0 +1,99 @@
+test_that("test advan5/advan7 translations", {
+
+  .a <- function(k, clear=FALSE) {
+    if (clear) .clearNonmem2rx()
+    .nonmem2rx$advan <- 5L
+    .advan5handleK(k)
+    list(advan5=.nonmem2rx$advan5,
+         advan5k=.nonmem2rx$advan5k,
+         advan5max=.nonmem2rx$advan5max)
+  }
+
+
+  expect_equal(.a("k15", clear=TRUE),
+               list(advan5 = c("-k15*rxddta1", "", "", "", "+k15*rxddta1"), advan5k = "k15", advan5max = 5))
+
+  expect_equal(.a("k56"),
+               list(advan5 = c("-k15*rxddta1", "", "", "",
+                               "+k15*rxddta1-k56*rxddta5",
+                               "+k56*rxddta5"),
+                    advan5k = c("k15", "k56"), advan5max = 6))
+
+  expect_equal(.a("K67"),
+               list(advan5 = c("-k15*rxddta1", "", "", "",
+                               "+k15*rxddta1-k56*rxddta5",
+                               "+k56*rxddta5-K67*rxddta6",
+                               "+K67*rxddta6"),
+                    advan5k = c("k15", "k56", "K67"),
+                    advan5max = 7))
+
+  expect_equal(.a("K74"),
+               list(advan5 = c("-k15*rxddta1", "", "",
+                               "+K74*rxddta7", "+k15*rxddta1-k56*rxddta5",
+                               "+k56*rxddta5-K67*rxddta6",
+                               "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74"),
+                    advan5max = 7))
+
+  expect_equal(.a("K42"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4", "",
+                               "+K74*rxddta7-K42*rxddta4", "+k15*rxddta1-k56*rxddta5",
+                               "+k56*rxddta5-K67*rxddta6", "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42"),
+                    advan5max = 7))
+
+  expect_equal(.a("K42"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4", "",
+                               "+K74*rxddta7-K42*rxddta4", "+k15*rxddta1-k56*rxddta5",
+                               "+k56*rxddta5-K67*rxddta6", "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42"),
+                    advan5max = 7))
+
+  expect_equal(.a("K40"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4", "",
+                               "+K74*rxddta7-K42*rxddta4-K40*rxddta4",
+                               "+k15*rxddta1-k56*rxddta5", "+k56*rxddta5-K67*rxddta6",
+                               "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42", "K40"), advan5max =7))
+
+  expect_equal(.a("K24"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4-K24*rxddta2", "",
+                               "+K74*rxddta7-K42*rxddta4-K40*rxddta4+K24*rxddta2",
+                               "+k15*rxddta1-k56*rxddta5", "+k56*rxddta5-K67*rxddta6",
+                               "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42", "K40", "K24"), advan5max = 7))
+
+  expect_equal(.a("K24"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4-K24*rxddta2", "",
+                               "+K74*rxddta7-K42*rxddta4-K40*rxddta4+K24*rxddta2",
+                               "+k15*rxddta1-k56*rxddta5", "+k56*rxddta5-K67*rxddta6",
+                               "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42", "K40", "K24"), advan5max = 7))
+
+  expect_equal(.a("K23"),
+               list(advan5 =
+                      c("-k15*rxddta1",
+                        "+K42*rxddta4-K24*rxddta2-K23*rxddta2",
+                        "+K23*rxddta2", "+K74*rxddta7-K42*rxddta4-K40*rxddta4+K24*rxddta2",
+                        "+k15*rxddta1-k56*rxddta5", "+k56*rxddta5-K67*rxddta6",
+                        "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42", "K40", "K24", "K23"), advan5max = 7))
+
+  expect_equal(.a("K32"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4-K24*rxddta2-K23*rxddta2+K32*rxddta3",
+                               "+K23*rxddta2-K32*rxddta3", "+K74*rxddta7-K42*rxddta4-K40*rxddta4+K24*rxddta2",
+                               "+k15*rxddta1-k56*rxddta5", "+k56*rxddta5-K67*rxddta6", "+K67*rxddta6-K74*rxddta7"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42", "K40", "K24", "K23", "K32"), advan5max = 7))
+
+  expect_equal(.a("K10T0"),
+               list(advan5 = c("-k15*rxddta1", "+K42*rxddta4-K24*rxddta2-K23*rxddta2+K32*rxddta3",
+                               "+K23*rxddta2-K32*rxddta3", "+K74*rxddta7-K42*rxddta4-K40*rxddta4+K24*rxddta2",
+                               "+k15*rxddta1-k56*rxddta5", "+k56*rxddta5-K67*rxddta6", "+K67*rxddta6-K74*rxddta7",
+                               "", "", "-K10T0*rxddta10"),
+                    advan5k = c("k15", "k56", "K67", "K74", "K42", "K40", "K24", "K23", "K32", "K10T0"),
+                    advan5max = 10))
+
+  expect_equal(.advan5odes(),
+               "\nd/dt(rxddta1) <- -k15*rxddta1\nd/dt(rxddta2) <- K42*rxddta4-K24*rxddta2-K23*rxddta2+K32*rxddta3\nd/dt(rxddta3) <- K23*rxddta2-K32*rxddta3\nd/dt(rxddta4) <- K74*rxddta7-K42*rxddta4-K40*rxddta4+K24*rxddta2\nd/dt(rxddta5) <- k15*rxddta1-k56*rxddta5\nd/dt(rxddta6) <- k56*rxddta5-K67*rxddta6\nd/dt(rxddta7) <- K67*rxddta6-K74*rxddta7\nd/dt(rxddta10) <- -K10T0*rxddta10")
+
+})
diff --git a/tests/testthat/test-psn.R b/tests/testthat/test-psn.R
@@ -194,14 +194,14 @@ if (identical(Sys.getenv("NOT_CRAN"), "true")) {
              "PsN/test_files/postfrem/frem_covstep_removed/final_models/model_4.lst",
              "PsN/test_files/run45.lst",
              "PsN/test_files/output/onePROB/oneEST/noSIM/warfarin_ddmore.lst",
-             "PsN/test_files/output/special_mod/rounding_errors.lst")
+             "PsN/test_files/output/special_mod/rounding_errors.lst",
+             "PsN/test_files/output/special_mod/two_digit_cov_index.lst",
+             "PsN/test_files/output/nm6/nm61_1.lst")
 
   .fileError <- c("PsN/test_files/output/special_mod/missingmodel.lst",
                   "PsN/test_files/output/special_mod/empty.lst",
                   "PsN/test_files/output/special_mod/empty_lines.lst",
                   #bad advan
-                  "PsN/test_files/output/special_mod/two_digit_cov_index.lst",
-                  "PsN/test_files/output/nm6/nm61_1.lst",
                   # bad lincmt
                   "PsN/test_files/output/special_mod/objv_infinity.lst",
                   "PsN/test_files/output/special_mod/interrupted_at_eigen.lst",

diff --git a/tests/testthat/test-sub.R b/tests/testthat/test-sub.R
@@ -19,7 +19,6 @@ test_that("test sub", {
   .s("ADVAN=ADVAN2 TRANS=TRANS2", c(advan=2L, trans=2L, abbrevLin=2L))
   expect_error(.s("ADVAN1 TRANS3"), "ADVAN1 does not support TRANS3")
   expect_error(.s("ADVAN20"), "Unsupported ADVAN20")
-  expect_error(.s("ADVAN7"), "General Linear model translation not supported")
   expect_error(.s("ADVAN9"), "Differential Algebra Equations")
   expect_error(.s("ADVAN15"), "Differential Algebra Equations")