Move PopED here

.github/workflows/R-CMD-check.yaml

@@ -54,6 +54,9 @@ jobs:
           pak-version: stable
           extra-packages: |
             any::rcmdcheck
+            nlmixr2/n1qn1c
+            nlmixr2/lbfgsb3c
+            nlmixr2/PreciseSums
             nlmixr2/dparser-R
             nlmixr2/lotri
             nlmixr2/rxode2ll

.github/workflows/pkgdown.yaml

@@ -34,6 +34,9 @@ jobs:
             any::pkgdown
             any::mrgsolve
             any::PKPDsim
+            nlmixr2/n1qn1c
+            nlmixr2/lbfgsb3c
+            nlmixr2/PreciseSums
             nlmixr2/lotri
             nlmixr2/dparser-R
             nlmixr2/rxode2ll

.github/workflows/test-coverage.yaml

@@ -28,6 +28,10 @@ jobs:
           pak-version: devel
           extra-packages: |
             any::covr
+            nlmixr2/n1qn1c
+            nlmixr2/lbfgsb3c
+            nlmixr2/PreciseSums
+            nlmixr2/dparser-R
             nlmixr2/lotri
             nlmixr2/rxode2ll
             nlmixr2/rxode2

R/RcppExports.R

@@ -5,6 +5,30 @@ convertDataBack <- function(id, time, amt, ii, evid, cmt, cmtDvid, dvidDvid, lin
     .Call(`_babelmixr2_convertDataBack`, id, time, amt, ii, evid, cmt, cmtDvid, dvidDvid, linNcmt, linKa, neq, replaceEvid, zeroDose2)
 }
 
+popedFree <- function() {
+    .Call(`_babelmixr2_popedFree`)
+}
+
+popedSetup <- function(e, full) {
+    .Call(`_babelmixr2_popedSetup`, e, full)
+}
+
+popedSolveIdN2 <- function(theta, mt, id, totn) {
+    .Call(`_babelmixr2_popedSolveIdN2`, theta, mt, id, totn)
+}
+
+popedSolveIdN <- function(theta, mt, id, totn) {
+    .Call(`_babelmixr2_popedSolveIdN`, theta, mt, id, totn)
+}
+
+popedSolveIdME <- function(theta, umt, mt, ms, nend, id, totn) {
+    .Call(`_babelmixr2_popedSolveIdME`, theta, umt, mt, ms, nend, id, totn)
+}
+
+popedSolveIdME2 <- function(theta, umt, mt, ms, nend, id, totn) {
+    .Call(`_babelmixr2_popedSolveIdME2`, theta, umt, mt, ms, nend, id, totn)
+}
+
 transDv <- function(inDv, inCmt, cmtTrans, lambda, yj, low, high) {
     .Call(`_babelmixr2_transDv`, inDv, inCmt, cmtTrans, lambda, yj, low, high)
 }

R/poped.R

@@ -1,3 +1,80 @@
+#' Free Poped memory (if any is allocated)
+#'
+#' This should not be called directly but is used in babelmixr2's
+#' poped interface
+#'
+#' @return nothing, called for side effects
+#'
+#' @export
+#' @author Matthew L. Fidler
+#' @keywords internal
+.popedFree <- function() {
+  invisible(.Call(`_babelmixr2_popedFree`))
+}
+
+#' Setup the PopED environment
+#'
+#' This should not typically be called directly
+#'
+#' @param e environment with setup information for popEd
+#' @param full setup the full model
+#' @return nothing, called for side effects
+#' @export
+#' @keywords internal
+#' @author Matthew L. Fidler
+.popedSetup <- function(e, full=FALSE) {
+  invisible(.Call(`_babelmixr2_popedSetup`, e, full))
+}
+#' Solve poped problem for appropriate times (may already be setup)
+#'
+#' This really should not be called directly (if not setup correctly
+#' can crash R)
+#'
+#' @param theta parameters (includes covariates)
+#' @param xt original unsorted time (to match the f/w against)
+#' @param id this is the design identifier
+#' @param totn This is the total number of design points tested
+#' @return a data frame with $f and $w corresponding to the function
+#'   value and standard deviation at the sampling point
+#' @export
+#' @author Matthew L. Fidler
+#' @keywords internal
+.popedSolveIdN <- function(theta, xt, id, totn) {
+  .Call(`_babelmixr2_popedSolveIdN`, theta, xt, id, totn)
+}
+#' @rdname dot-popedSolveIdN
+#' @export
+.popedSolveIdN2 <- function(theta, xt, id, totn) {
+  .Call(`_babelmixr2_popedSolveIdN2`, theta, xt, id, totn)
+}
+
+#' Solve poped problem for appropriate times with multiple endpoint models
+#'
+#' This really should not be called directly (if not setup correctly
+#' can crash R)
+#'
+#' @param theta parameters (includes covariates and modeling times)
+#' @param umt unique times sampled
+#' @param mt original unsorted time (to match the f/w against)
+#' @param ms model switch parameter integer starting with 1 (related to dvid in rxode2)
+#' @param nend specifies the number of endpoints in this model
+#' @param id this is the design identifier
+#' @param totn This is the total number of design points tested
+#' @return a data frame with $f and $w corresponding to the function
+#'   value and standard deviation at the sampling point
+#' @export
+#' @author Matthew L. Fidler
+#' @keywords internal
+.popedSolveIdME <- function(theta, umt, mt, ms, nend, id, totn) {
+  .Call(`_babelmixr2_popedSolveIdME`, theta, umt, mt, ms, nend, id, totn)
+}
+
+#' @rdname dot-popedSolveIdME
+#' @export
+.popedSolveIdME2 <- function(theta, umt, mt, ms, nend, id, totn) {
+  .Call(`_babelmixr2_popedSolveIdME2`, theta, umt, mt, ms, nend, id, totn)
+}
+
 #' get the bpop number (which is a theta in PopED)
 #'
 #' @param theta name of the population parameter
@@ -120,14 +197,14 @@
       if (.totn <  .(.poped$maxn)) {
         .p <- c(.p, .xt, seq(.(.poped$mt), by=0.1, length.out=.(.poped$maxn) - .totn))
         .popedRxRunSetup(poped.db)
-        .ret <- nlmixr2est::.popedSolveIdN(.p, .xt, .id - 1L, .totn)
+        .ret <- .popedSolveIdN(.p, .xt, .id - 1L, .totn)
       } else if (.totn > .(.poped$maxn)) {
         .popedRxRunFullSetup(poped.db, .xt)
-        .ret <- nlmixr2est::.popedSolveIdN2(.p, .xt, .id - 1L, .totn)
+        .ret <- .popedSolveIdN2(.p, .xt, .id - 1L, .totn)
       } else {
         .p <- c(.p, .xt)
         .popedRxRunSetup(poped.db)
-        .ret <- nlmixr2est::.popedSolveIdN(.p, .xt, .id - 1L, .totn)
+        .ret <- .popedSolveIdN(.p, .xt, .id - 1L, .totn)
       }
       return(list(f=matrix(.ret$rx_pred_, ncol=1),
                   poped.db=poped.db))
@@ -147,16 +224,16 @@
       if (.lu <  .(.poped$maxn)) {
         .p <- c(.p, .u, seq(.(.poped$mt), by=0.1, length.out=.(.poped$maxn) - .lu))
         .popedRxRunSetup(poped.db)
-        .ret <- nlmixr2est::.popedSolveIdME(.p, .u, .xt, model_switch, .(length(.predDf$cond)),
+        .ret <- .popedSolveIdME(.p, .u, .xt, model_switch, .(length(.predDf$cond)),
                                             .id - 1, .totn)
       } else if (.lu > .(.poped$maxn)) {
         .popedRxRunFullSetupMe(poped.db, .xt, model_switch)
-        .ret <- nlmixr2est::.popedSolveIdME2(.p, .u, .xt, model_switch, .(length(.predDf$cond)),
+        .ret <- .popedSolveIdME2(.p, .u, .xt, model_switch, .(length(.predDf$cond)),
                                              .id - 1, .totn)
       } else {
         .p <- c(.p, .u)
         .popedRxRunSetup(poped.db)
-        .ret <- nlmixr2est::.popedSolveIdME(.p, .u, .xt, model_switch, .(length(.predDf$cond)),
+        .ret <- .popedSolveIdME(.p, .u, .xt, model_switch, .(length(.predDf$cond)),
                                             .id - 1L, .totn)
       }
       return(list(f=matrix(.ret$rx_pred_, ncol=1),
@@ -221,7 +298,7 @@
   }
   if (.poped$setup != 1L) {
     rxode2::rxSolveFree()
-    nlmixr2est::.popedSetup(popedDb$babelmixr2, FALSE)
+    .popedSetup(popedDb$babelmixr2, FALSE)
     .poped$setup <- 1L
     .poped$curNumber <- popedDb$babelmixr2$modelNumber
     .poped$fullXt <- NULL
@@ -281,7 +358,7 @@
                                 })))
     .et <- rxode2::etTrans(.dat, .e$modelF)
     .e$dataF <- .et
-    nlmixr2est::.popedSetup(.e, TRUE)
+    .popedSetup(.e, TRUE)
     .poped$fullXt <- length(xt)
     .poped$curNumber <- popedDb$babelmixr2$modelNumber
     .poped$setup <- 2L
@@ -338,7 +415,7 @@
                                 })))
     .et <- rxode2::etTrans(.dat, .e$modelF)
     .e$dataF <- .et
-    nlmixr2est::.popedSetup(.e, TRUE)
+    .popedSetup(.e, TRUE)
     .poped$fullXt <- length(xt)
     .poped$curNumber <- popedDb$babelmixr2$modelNumber
     .poped$setup <- 2L

R/zzz.R

@@ -1,7 +1,29 @@
+# This will be saved when compiled
+rxode2.api <- names(rxode2::.rxode2ptrs())
+
+.iniRxode2Ptr <- function() {
+  .ptr <- rxode2::.rxode2ptrs()
+  .nptr <- names(.ptr)
+  if (length(rxode2.api) > length(.nptr)) {
+    stop("babelmixr2 requires a newer version of rxode2 api, cannot run nlmixr2est\ntry `install.packages(\"rxode2\")` to get a newer version of rxode2", call.=FALSE)
+  } else {
+    .nptr <- .nptr[seq_along(rxode2.api)]
+    if (!identical(rxode2.api, .nptr)) {
+      .bad <- TRUE
+      stop("babelmixr2 needs a different version of rxode2 api, cannot run nlmixr2est\ntry `install.packages(\"rxode2\")` to get a newer version of rxode2, or update both packages", call.=FALSE)
+    }
+  }
+  .Call(`_babelmixr2_iniRxodePtrs`, .ptr,
+        PACKAGE = "babelmixr2")
+}
+
+
+
 .onLoad <- function(libname, pkgname) {
   rxode2::.s3register("nlmixr2est::nlmixr2Est", "monolix")
   rxode2::.s3register("nlmixr2est::getValidNlmixrCtl", "monolix")
   rxode2::.s3register("nlmixr2est::nmObjGetFoceiControl", "monolix")
   rxode2::.s3register("nlmixr2est::nmObjHandleControlObject", "monolixControl")
   rxode2::.s3register("nlmixr2est::nlmixr2", "pkncaEst")
+  .iniRxode2Ptr()
 }

src/RcppExports.cpp

@@ -34,6 +34,90 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// popedFree
+RObject popedFree();
+RcppExport SEXP _babelmixr2_popedFree() {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    rcpp_result_gen = Rcpp::wrap(popedFree());
+    return rcpp_result_gen;
+END_RCPP
+}
+// popedSetup
+RObject popedSetup(Environment e, bool full);
+RcppExport SEXP _babelmixr2_popedSetup(SEXP eSEXP, SEXP fullSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< Environment >::type e(eSEXP);
+    Rcpp::traits::input_parameter< bool >::type full(fullSEXP);
+    rcpp_result_gen = Rcpp::wrap(popedSetup(e, full));
+    return rcpp_result_gen;
+END_RCPP
+}
+// popedSolveIdN2
+Rcpp::DataFrame popedSolveIdN2(NumericVector& theta, NumericVector& mt, int id, int totn);
+RcppExport SEXP _babelmixr2_popedSolveIdN2(SEXP thetaSEXP, SEXP mtSEXP, SEXP idSEXP, SEXP totnSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector& >::type theta(thetaSEXP);
+    Rcpp::traits::input_parameter< NumericVector& >::type mt(mtSEXP);
+    Rcpp::traits::input_parameter< int >::type id(idSEXP);
+    Rcpp::traits::input_parameter< int >::type totn(totnSEXP);
+    rcpp_result_gen = Rcpp::wrap(popedSolveIdN2(theta, mt, id, totn));
+    return rcpp_result_gen;
+END_RCPP
+}
+// popedSolveIdN
+Rcpp::DataFrame popedSolveIdN(NumericVector& theta, NumericVector& mt, int id, int totn);
+RcppExport SEXP _babelmixr2_popedSolveIdN(SEXP thetaSEXP, SEXP mtSEXP, SEXP idSEXP, SEXP totnSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector& >::type theta(thetaSEXP);
+    Rcpp::traits::input_parameter< NumericVector& >::type mt(mtSEXP);
+    Rcpp::traits::input_parameter< int >::type id(idSEXP);
+    Rcpp::traits::input_parameter< int >::type totn(totnSEXP);
+    rcpp_result_gen = Rcpp::wrap(popedSolveIdN(theta, mt, id, totn));
+    return rcpp_result_gen;
+END_RCPP
+}
+// popedSolveIdME
+Rcpp::DataFrame popedSolveIdME(NumericVector& theta, NumericVector& umt, NumericVector& mt, IntegerVector& ms, int nend, int id, int totn);
+RcppExport SEXP _babelmixr2_popedSolveIdME(SEXP thetaSEXP, SEXP umtSEXP, SEXP mtSEXP, SEXP msSEXP, SEXP nendSEXP, SEXP idSEXP, SEXP totnSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector& >::type theta(thetaSEXP);
+    Rcpp::traits::input_parameter< NumericVector& >::type umt(umtSEXP);
+    Rcpp::traits::input_parameter< NumericVector& >::type mt(mtSEXP);
+    Rcpp::traits::input_parameter< IntegerVector& >::type ms(msSEXP);
+    Rcpp::traits::input_parameter< int >::type nend(nendSEXP);
+    Rcpp::traits::input_parameter< int >::type id(idSEXP);
+    Rcpp::traits::input_parameter< int >::type totn(totnSEXP);
+    rcpp_result_gen = Rcpp::wrap(popedSolveIdME(theta, umt, mt, ms, nend, id, totn));
+    return rcpp_result_gen;
+END_RCPP
+}
+// popedSolveIdME2
+Rcpp::DataFrame popedSolveIdME2(NumericVector& theta, NumericVector& umt, NumericVector& mt, IntegerVector& ms, int nend, int id, int totn);
+RcppExport SEXP _babelmixr2_popedSolveIdME2(SEXP thetaSEXP, SEXP umtSEXP, SEXP mtSEXP, SEXP msSEXP, SEXP nendSEXP, SEXP idSEXP, SEXP totnSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector& >::type theta(thetaSEXP);
+    Rcpp::traits::input_parameter< NumericVector& >::type umt(umtSEXP);
+    Rcpp::traits::input_parameter< NumericVector& >::type mt(mtSEXP);
+    Rcpp::traits::input_parameter< IntegerVector& >::type ms(msSEXP);
+    Rcpp::traits::input_parameter< int >::type nend(nendSEXP);
+    Rcpp::traits::input_parameter< int >::type id(idSEXP);
+    Rcpp::traits::input_parameter< int >::type totn(totnSEXP);
+    rcpp_result_gen = Rcpp::wrap(popedSolveIdME2(theta, umt, mt, ms, nend, id, totn));
+    return rcpp_result_gen;
+END_RCPP
+}
 // transDv
 List transDv(NumericVector& inDv, IntegerVector& inCmt, IntegerVector& cmtTrans, NumericVector& lambda, IntegerVector& yj, NumericVector& low, NumericVector& high);
 RcppExport SEXP _babelmixr2_transDv(SEXP inDvSEXP, SEXP inCmtSEXP, SEXP cmtTransSEXP, SEXP lambdaSEXP, SEXP yjSEXP, SEXP lowSEXP, SEXP highSEXP) {

src/init.c

@@ -10,7 +10,23 @@ SEXP _babelmixr2_convertDataBack(SEXP, SEXP, SEXP, SEXP, SEXP,
 SEXP _babelmixr2_transDv(SEXP, SEXP, SEXP, SEXP, SEXP,
                          SEXP, SEXP);
 
+SEXP _babelmixr2_iniRxodePtrs(SEXP in);
+
+SEXP _babelmixr2_popedFree(void);
+SEXP _babelmixr2_popedSetup(SEXP eSEXP, SEXP fullSEXP);
+SEXP _babelmixr2_popedSolveIdN(SEXP thetaSEXP, SEXP mtSEXP, SEXP idSEXP, SEXP totnSEXP);
+SEXP _babelmixr2_popedSolveIdME(SEXP thetaSEXP, SEXP umtSEXP, SEXP mtSEXP, SEXP msSEXP, SEXP nendSEXP, SEXP idSEXP, SEXP totnSEXP);
+SEXP _babelmixr2_popedSolveIdME2(SEXP thetaSEXP, SEXP umtSEXP, SEXP mtSEXP, SEXP msSEXP, SEXP nendSEXP, SEXP idSEXP, SEXP totnSEXP);
+SEXP _babelmixr2_popedSolveIdN2(SEXP thetaSEXP, SEXP mtSEXP, SEXP idSEXP, SEXP totnSEXP);
+
 static const R_CallMethodDef CallEntries[] = {
+  {"_babelmixr2_popedFree", (DL_FUNC) &_babelmixr2_popedFree, 0},
+  {"_babelmixr2_popedSetup", (DL_FUNC) &_babelmixr2_popedSetup, 2},
+  {"_babelmixr2_popedSolveIdN", (DL_FUNC) &_babelmixr2_popedSolveIdN, 4},
+  {"_babelmixr2_popedSolveIdN2", (DL_FUNC) &_babelmixr2_popedSolveIdN, 4},
+  {"_babelmixr2_popedSolveIdME", (DL_FUNC) &_babelmixr2_popedSolveIdME, 7},
+  {"_babelmixr2_popedSolveIdME2", (DL_FUNC) &_babelmixr2_popedSolveIdME2, 7},
+  {"_babelmixr2_iniRxodePtrs", (DL_FUNC) &_babelmixr2_iniRxodePtrs, 1},
   {"_babelmixr2_convertDataBack", (DL_FUNC) &_babelmixr2_convertDataBack, 13},
   {"_babelmixr2_transDv", (DL_FUNC) &_babelmixr2_transDv, 7},
   {NULL, NULL, 0}
@@ -25,4 +41,3 @@ void R_init_babelmixr2(DllInfo *dll)
 
 void R_unload_babelmixr2(DllInfo *info){
 }
-