Export linear compartment single point solver to R for testing

nlmixr2 · Jul 19, 2024 · e4a5da0 · e4a5da0
1 parent 9596d4a
commit e4a5da0
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 1 deletion.
diff --git a/src/comp.c b/src/comp.c
@@ -19,6 +19,7 @@
 
 #include "../inst/include/rxode2.h"
 #include "comp.h"
+#include "parTrans.h"
 
 #ifdef ENABLE_NLS
 #include <libintl.h>
@@ -28,6 +29,43 @@
 #define _(String) (String)
 #endif
 
-SEXP _roxde2_linCmt1() {
+int comp1c(int ncmt,
+           int trans,
+           double *yp, // prior y
+           double xp, // initial time point
+           double xout, // final time point
+           double *p,
+           double *rate) {
+  // no update for same time
+  if (isSameTime(xout, xp)) return 1;
   lin_context_c_t lin;
+  lin.ncmt = ncmt;
+  lin.ka=lin.k10=
+    lin.k12=lin.k21=
+    lin.k13=lin.k31=lin.v=
+    lin.dt=xout-xp;
+  lin.rate = rate;
+  if (!parTrans(&trans, &p[0], &p[1], &p[2], &p[3], &p[4], &p[5],
+                &ncmt, &(lin.k10), &(lin.v), &(lin.k12),
+                &(lin.k21), &(lin.k13), &(lin.k31))){
+    return 0;
+  }
+  return comp1(yp, &lin);
+}
+
+// This is a R wrapper for comp1c
+SEXP _rxode2_comp1c(SEXP prior, SEXP xpS, SEXP xoutS,
+                    SEXP rateS, SEXP transS, SEXP parS) {
+  SEXP retS = PROTECT(Rf_allocVector(INTSXP, 1));
+  int *ret = INTEGER(retS);
+  ret[0] = 0;
+  int ncmt = INTEGER(VECTOR_ELT(transS, 1))[0];
+  int trans = INTEGER(VECTOR_ELT(transS, 2))[0];
+  comp1c(ncmt, trans, REAL(prior), // prior y
+         REAL(xpS)[0], // initial time point
+         REAL(xoutS)[0], // final time point
+         REAL(rateS),
+         REAL(rateS));
+  UNPROTECT(1);
+  return retS;
 }
diff --git a/src/init.c b/src/init.c
@@ -367,8 +367,12 @@ SEXP _rxode2_rxQs(SEXP);
 SEXP _rxode2_solComp2(SEXP, SEXP, SEXP);
 SEXP _rxode2_solComp3(SEXP, SEXP, SEXP, SEXP, SEXP);
 
+SEXP _rxode2_comp1c(SEXP, SEXP, SEXP, SEXP, SEXP,
+                    SEXP);
+
 void R_init_rxode2(DllInfo *info){
   R_CallMethodDef callMethods[]  = {
+    {"_rxode2_comp1c", (DL_FUNC) &_rxode2_comp1c, 6},
     {"_rxode2_solComp2", (DL_FUNC) &_rxode2_solComp2, 3},
     {"_rxode2_solComp3", (DL_FUNC) &_rxode2_solComp3, 5},
     {"_rxode2_rxode2parseSetRstudio", (DL_FUNC) &_rxode2_rxode2parseSetRstudio, 1},