Skip to content
This repository has been archived by the owner on Jul 17, 2024. It is now read-only.

Commit

Permalink
start traking lag times for linCmt()
Browse files Browse the repository at this point in the history
  • Loading branch information
mattfidler committed Jan 16, 2024
1 parent ea58aa9 commit e97f8e3
Show file tree
Hide file tree
Showing 7 changed files with 206 additions and 10 deletions.
3 changes: 2 additions & 1 deletion R/tran.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
1 change: 0 additions & 1 deletion inst/include/rxode2parseSortInd.h
Original file line number Diff line number Diff line change
@@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/codegen.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
39 changes: 37 additions & 2 deletions src/genModelVars.c
Original file line number Diff line number Diff line change
Expand Up @@ -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();
Expand Down Expand Up @@ -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);
Expand Down
5 changes: 5 additions & 0 deletions src/parseFunsLinCmt.h
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand All @@ -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);
}
}
Expand Down Expand Up @@ -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);
}
}
Expand Down Expand Up @@ -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);
Expand Down
6 changes: 5 additions & 1 deletion src/tran.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand Down Expand Up @@ -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;
Expand Down
156 changes: 154 additions & 2 deletions tests/testthat/test-lag.R
Original file line number Diff line number Diff line change
@@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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))

})

0 comments on commit e97f8e3

Please sign in to comment.