From b3409a821f69abb2ec1231e9fee3be0c0ae6688f Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Sat, 30 Nov 2024 22:59:26 -0600 Subject: [PATCH] Get a bit farther on fixing issue --- src/genModelVars.h | 40 ++++++++++++++++++++------------------- src/parseDdt.h | 2 +- src/parseFunsDosing.h | 7 +++++-- tests/testthat/test-tad.R | 32 +++++++++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 22 deletions(-) diff --git a/src/genModelVars.h b/src/genModelVars.h index 01a1ef5c5..3f7d29821 100644 --- a/src/genModelVars.h +++ b/src/genModelVars.h @@ -105,13 +105,13 @@ static inline void calcNparamsNlhsNslhs(void) { static inline void calcNextra(void) { int offCmt=0,nExtra = 0; - char *buf, buf2[200]; + char *buf=NULL, buf2[200]; for (int i = 0; i < tb.statei; i++){ if (offCmt == 0 && tb.idu[i] == 0){ + buf=tb.ss.line[tb.di[i]]; offCmt = 1; nExtra++; - buf=tb.ss.line[tb.di[i]]; - } else if (offCmt == 1 && tb.idu[i] == 1){ + } else if (offCmt == 1 && tb.idu[i] == 1) { // There is an compartment that doesn't have a derivative if (tb.linCmt == 0){ char *v = rc_dup_str(buf, 0); @@ -203,55 +203,57 @@ static inline int sortStateVectorsErrHandle(int prop, int pass, int i) { if (prop == 0 || pass == 1) { return 1; } + char *buf = NULL; + buf = tb.ss.line[tb.di[i]]; if ((prop & prop0) != 0) { - sAppend(&sbt, "'%s(0)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'%s(0)', ", buf); } if ((prop & propF) != 0) { - sAppend(&sbt, "'f(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'f(%s)', ", buf); } if ((prop & propAlag) != 0) { - sAppend(&sbt, "'alag(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'alag(%s)', ", buf); } if ((prop & propRate) != 0) { - sAppend(&sbt, "'rate(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'rate(%s)', ", buf); } if ((prop & propDur) != 0) { - sAppend(&sbt, "'dur(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'dur(%s)', ", buf); } if ((prop & propTad) != 0) { - sAppend(&sbt, "'tad(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tad(%s)', ", buf); } if ((prop & propTad0) != 0) { - sAppend(&sbt, "'tad0(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tad0(%s)', ", buf); } if ((prop & propTafd) != 0) { - sAppend(&sbt, "'tafd(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tafd(%s)', ", buf); } if ((prop & propTafd0) != 0) { - sAppend(&sbt, "'tafd0(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tafd0(%s)', ", buf); } if ((prop & propTlast) != 0) { - sAppend(&sbt, "'tlast(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tlast(%s)', ", buf); } if ((prop & propTlast0) != 0) { - sAppend(&sbt, "'tlast0(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tlast0(%s)', ", buf); } if ((prop & propTfirst) != 0) { - sAppend(&sbt, "'tfirst(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tfirst(%s)', ", buf); } if ((prop & propTfirst0) != 0) { - sAppend(&sbt, "'tfirst0(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'tfirst0(%s)', ", buf); } if ((prop & propPodo) != 0) { - sAppend(&sbt, "'podo(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'podo(%s)', ", buf); } if ((prop & propDose) != 0) { - sAppend(&sbt, "'dose(%s)', ", tb.ss.line[tb.di[i]]); + sAppend(&sbt, "'dose(%s)', ", buf); } // Take off trailing "', sbt.o -= 2; sbt.s[sbt.o] = 0; - sAppend(&sbt, " present, but d/dt(%s) not defined\n", tb.ss.line[tb.di[i]]); + sAppend(&sbt, " present, but d/dt(%s) not defined\n", buf); return 0; } diff --git a/src/parseDdt.h b/src/parseDdt.h index 5fd6d1adb..295296f95 100644 --- a/src/parseDdt.h +++ b/src/parseDdt.h @@ -40,7 +40,7 @@ static inline int new_de(const char *s, int fromWhere) { static inline int isCmtLhsStatement(nodeInfo ni, char *name, char *v) { int hasLhs = 0; - if (nodeHas(cmt_statement)){ + if (nodeHas(cmt_statement)) { new_or_ith(v); if (tb.lh[tb.ix] || tb.ini[tb.ix]){ hasLhs=1; diff --git a/src/parseFunsDosing.h b/src/parseFunsDosing.h index 72e2f51d4..ae37c2be1 100644 --- a/src/parseFunsDosing.h +++ b/src/parseFunsDosing.h @@ -59,11 +59,14 @@ static inline int handleFunctionTadSingleStateCcode(transFunctions *tf,char *v2) if (new_de(v2, 0)){ // cannot be lhs statements in tad style assignments // also cannot be from anywhere + // temporarily turn off that this is a function + int fn = tb.fn; + tb.fn = 0; add_de(tf->ni, tf->name, v2, 0, 0); - aProp(tb.de.n); + // turn back on that this is a function + tb.fn = fn; } else { new_or_ith(v2); - aProp(tb.ix); } sAppend(&sb, "__DDT%d__)", tb.id); sAppend(&sbDt, "__DDT%d__)", tb.id); diff --git a/tests/testthat/test-tad.R b/tests/testthat/test-tad.R index bbb7ebfb9..36352568f 100644 --- a/tests/testthat/test-tad.R +++ b/tests/testthat/test-tad.R @@ -519,4 +519,36 @@ rxTest({ expect_false(isTRUE(all.equal(x$tad, x$tade))) }) + + test_that("tad parsing", { + + mod2 <- function() { + ini({ + ## Table 3 from Savic 2007 + cl <- 17.2 # (L/hr) + vc <- 45.1 # L + ka <- 0.38 # 1/hr + mtt <- 1.37 # hr + f2 <-0.5 # Fraction of 1st Order portion + n <- 20.1 + }) + model({ + k <- cl/vc + bio <- 1-f2 + ktr = (n+1)/mtt + ## note that lgammafn is the same as lgamma in R. + d/dt(depot1) = exp(log(bio*podo(depot))+ + log(ktr)+n*log(ktr*tad(depot))- + ktr*tad(depot)-lgammafn(n+1))-ka*depot1 + d/dt(depot2) <- -ka*depot2 + f(depot2) <-f2 + d/dt(cen) <- ka*depot1 + ka*depot2-k*cen + }) + } + + mod2 <- mod2() + + mod2$simulationModel + + }) })