diff --git a/R/tran.R b/R/tran.R index b07d5884..e2e49c45 100644 --- a/R/tran.R +++ b/R/tran.R @@ -27,7 +27,8 @@ #' @eval rxode2parseFuns() #' @examples #' rxode2parse("a=3") -rxode2parse <- function(model, linear=FALSE, linCmtSens = c("linCmtA", "linCmtB", "linCmtC"), verbose=FALSE, +rxode2parse <- function(model, linear=FALSE, linCmtSens = c("linCmtA", "linCmtB", "linCmtC"), + verbose=FALSE, code=NULL, envir=parent.frame()) { rxParseSuppressMsg() .udfEnvSet(envir) diff --git a/inst/include/rxode2parseSortInd.h b/inst/include/rxode2parseSortInd.h index ed9cda3b..12501898 100644 --- a/inst/include/rxode2parseSortInd.h +++ b/inst/include/rxode2parseSortInd.h @@ -1,7 +1,6 @@ static inline void rxode2parse_sortRest(rx_solving_options_ind *ind, int i0) { // Here the ix has been calculated at least once. Sort it if it changed rx_solve *rx = &rx_global; - rx_solving_options *op = &op_global; int evid0 = getEvid(ind, i0); if (evid0 == 0 || evid0 == 2) return; // Reset times for infusion diff --git a/src/codegen.c b/src/codegen.c index 74b933a2..b7fce9ca 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -217,10 +217,10 @@ void codegen(char *model, int show_ode, const char *prefix, const char *libname, prefix); } } else if (show_ode == ode_lag){ - if (foundLag){ + if (foundLag) { int nnn = tb.de.n; - if (tb.linCmt){ - if (tb.hasKa){ + if (tb.linCmt) { + if (tb.hasKa) { nnn+=2; } else { nnn+=1; diff --git a/src/genModelVars.c b/src/genModelVars.c index 9d0b9b30..f85124b0 100644 --- a/src/genModelVars.c +++ b/src/genModelVars.c @@ -2,6 +2,11 @@ #define STRICT_R_HEADERS #include "genModelVars.h" +extern int alagLin0; +extern int alagLin1; +extern int foundLinCmt; + + SEXP _rxode2parse_getUdf(void); SEXP generateModelVars(void) { calcExtracmt(); @@ -117,10 +122,40 @@ SEXP generateModelVars(void) { SET_STRING_ELT(names, 18, mkChar("slhs")); SET_VECTOR_ELT(lst, 18, slhs); - SEXP alagVarSexp = PROTECT(allocVector(INTSXP, tb.alagn));pro++; + int extraAlag = 0; + int extraAlagAlloc = 0; + if (alagLin0) { + extraAlagAlloc++; + } + if (alagLin1) { + extraAlagAlloc++; + } + SEXP alagVarSexp = PROTECT(allocVector(INTSXP, tb.alagn+extraAlagAlloc));pro++; int *alagVar = INTEGER(alagVarSexp); + extraAlagAlloc = 0; + if (foundLinCmt) { + if (tb.hasKa) { + // depot + central + extraAlag = 2; + if (alagLin0) { + alagVar[extraAlagAlloc] = 1; + extraAlagAlloc++; + } + if (alagLin1) { + alagVar[extraAlagAlloc] = 2; + extraAlagAlloc++; + } + } else { + // central + extraAlag = 1; + if (alagLin0) { + alagVar[extraAlagAlloc] = 1; + extraAlagAlloc++; + } + } + } for (int i = 0; i < tb.alagn; ++i) { - alagVar[i] = tb.alag[i]; + alagVar[extraAlagAlloc+i] = tb.alag[i] + extraAlag; } SET_STRING_ELT(names, 19, mkChar("alag")); SET_VECTOR_ELT(lst, 19, alagVarSexp); diff --git a/src/parseFunsLinCmt.h b/src/parseFunsLinCmt.h index eaffae58..6635d898 100644 --- a/src/parseFunsLinCmt.h +++ b/src/parseFunsLinCmt.h @@ -2,6 +2,8 @@ extern sbuf sbExtra; extern D_Parser *curP; +extern int alagLin0; +extern int alagLin1; static inline void handleFunctionLinCmtAlag(transFunctions *tf, D_ParseNode *xpn1, D_ParseNode *xpn2) { @@ -17,6 +19,7 @@ static inline void handleFunctionLinCmtAlag(transFunctions *tf, D_ParseNode *xpn // has interesting tlag if (foundLag == 0) needSort+=needSortAlag; // & 2 when alag foundLag=1; + alagLin0=1; sAppend(&sbExtra,"rxlin___=rxAlagLin(%s);\n", v2); } } @@ -147,6 +150,7 @@ static inline void handleFunctionLinCmtKa(transFunctions *tf, D_ParseNode *xpn1, // has interesting tlag if (foundLag == 0) needSort+= needSortAlag; // & 2 when alag foundLag=1; + alagLin1=1; sAppend(&sbExtra,"rxlin___=rxAlag1Lin(%s);\n", v2); } } @@ -257,6 +261,7 @@ static inline int handleFunctionLinCmt(transFunctions *tf) { if (handleFunctionLinCmtJitProp(tf)) return 1; if (!strcmp("linCmtA", tf->v) || !strcmp("linCmtC", tf->v) || (tf->isLinB=!strcmp("linCmtB", tf->v))) { + foundLinCmt = 1; D_ParseNode *xpn1 = d_get_child(tf->pn, 3); D_ParseNode *xpn2 = d_get_child(xpn1, 1); char *v2 = (char*)rc_dup_str(xpn2->start_loc.s, xpn2->end); diff --git a/src/tran.c b/src/tran.c index 8c8c7fb5..e0a3a2da 100644 --- a/src/tran.c +++ b/src/tran.c @@ -96,7 +96,8 @@ const char *model_prefix = NULL; const char *me_code = NULL; const char *md5 = NULL; int badMd5 = 0; -int foundF=0,foundLag=0, foundRate=0, foundDur=0, foundF0=0, needSort=0; +int foundF=0,foundLag=0, foundRate=0, foundDur=0, foundF0=0, needSort=0, + alagLin0 = 0, alagLin1 = 0, foundLinCmt = 0; sbuf sbOut; @@ -410,6 +411,9 @@ void reset(void) { lastSyntaxErrorLine=0; foundF=0; foundLag=0; + alagLin0 = 0; + alagLin1 = 0; + foundLinCmt = 0; foundRate=0; gBufLast=0; lastStrLoc=0; diff --git a/tests/testthat/test-lag.R b/tests/testthat/test-lag.R index 6e982c21..a50c246e 100644 --- a/tests/testthat/test-lag.R +++ b/tests/testthat/test-lag.R @@ -1,5 +1,5 @@ test_that("test lag-time information parsing", { - + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -24,6 +24,27 @@ test_that("test lag-time information parsing", { eff(0) = 1") expect_equal(m1$alag, 1L) + + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + alag(depot) = alagDepot + C2 <- linCmt() + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + eff(0) = 1", linear=TRUE) + expect_equal(m1$alag, 1L) + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -48,6 +69,27 @@ test_that("test lag-time information parsing", { eff(0) = 1") expect_equal(m1$alag, 2L) + + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + C2 = linCmt() + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + lag(central) = alagDepot + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + eff(0) = 1", linear=TRUE) + expect_equal(m1$alag, 2L) + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -72,6 +114,29 @@ test_that("test lag-time information parsing", { eff(0) = 1") expect_equal(m1$alag, 3L) + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + C2 = centr/V2; + C3 = peri/V3; + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + C2 <- linCmt() + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + alag(eff) = alagDepot + eff(0) = 1", linear=TRUE) + expect_equal(m1$alag, 3L) + + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -123,6 +188,28 @@ test_that("test lag-time information parsing", { eff(0) = 1") expect_equal(m1$alag, 1:4) + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + alag(depot) = alagDepot + alag(central) = alagDepot + C2 <- linCmt() + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + alag(eff) = alagDepot + eff(0) = 1", linear=TRUE) + expect_equal(m1$alag, 1:3) + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -149,6 +236,28 @@ test_that("test lag-time information parsing", { eff(0) = 1") expect_equal(m1$alag, c(1L, 3:4)) + + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + C2 = linCmt() + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + alag(depot) = alagDepot + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + alag(eff) = alagDepot + eff(0) = 1", linear=TRUE) + expect_equal(m1$alag, c(1L, 3L)) + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -175,6 +284,28 @@ test_that("test lag-time information parsing", { eff(0) = 1") expect_equal(m1$alag, 2:4) + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + C2 = linCmt() + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + alag(central) = alagDepot + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + alag(eff) = alagDepot + eff(0) = 1", linear=TRUE) + expect_equal(m1$alag, 2:3) + + m1 <- rxode2parse("KA=2.94E-01; CL=1.86E+01; V2=4.02E+01; @@ -197,5 +328,26 @@ test_that("test lag-time information parsing", { d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; eff(0) = 1") expect_equal(m1$alag, integer(0)) - + + + m1 <- rxode2parse("KA=2.94E-01; + CL=1.86E+01; + V2=4.02E+01; + Q=1.05E+01; + V3=2.97E+02; + Kin=1; + Kout=1; + EC50=200; + fdepot = 1; + durDepot = 8; + rateDepot = 1250; + C2 = linCmt(); + f(depot) = fdepot + dur(depot) = durDepot + rate(depot) = rateDepot + d/dt(eff) = Kin - Kout*(1-C2/(EC50+C2))*eff; + eff(0) = 1", linear=TRUE) + + expect_equal(m1$alag, integer(0)) + })