From 65344b04c5bd34048b196c66bba800c765f5f274 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 16:04:37 -0500 Subject: [PATCH 1/7] Moved poped from nlmixr2est --- R/RcppExports.R | 24 ++ R/poped.R | 95 +++++++- R/zzz.R | 22 ++ src/RcppExports.cpp | 84 +++++++ src/init.c | 15 +- src/poped.cpp | 537 ++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 767 insertions(+), 10 deletions(-) create mode 100644 src/poped.cpp diff --git a/R/RcppExports.R b/R/RcppExports.R index b1a7d712..19c1b4e5 100644 --- a/R/RcppExports.R +++ b/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) } diff --git a/R/poped.R b/R/poped.R index 3cf07c63..8306f6a7 100644 --- a/R/poped.R +++ b/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 @@ rxUiGet.popedFfFun <- function(x, ...) { 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 @@ rxUiGet.popedFfFun <- function(x, ...) { 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 @@ attr(rxUiGet.popedFfFun, "desc") <- "PopED parameter model (ff_fun)" } 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 @@ attr(rxUiGet.popedFfFun, "desc") <- "PopED parameter model (ff_fun)" }))) .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 @@ attr(rxUiGet.popedFfFun, "desc") <- "PopED parameter model (ff_fun)" }))) .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 diff --git a/R/zzz.R b/R/zzz.R index 04e81b61..ebb5dd99 100644 --- a/R/zzz.R +++ b/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() } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 0e50affa..082e5261 100644 --- a/src/RcppExports.cpp +++ b/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) { diff --git a/src/init.c b/src/init.c index 552325bd..a130750c 100644 --- a/src/init.c +++ b/src/init.c @@ -10,7 +10,21 @@ 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); + 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_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 +39,3 @@ void R_init_babelmixr2(DllInfo *dll) void R_unload_babelmixr2(DllInfo *info){ } - diff --git a/src/poped.cpp b/src/poped.cpp new file mode 100644 index 00000000..a89225f0 --- /dev/null +++ b/src/poped.cpp @@ -0,0 +1,537 @@ +#define ARMA_WARN_LEVEL 1 +#define STRICT_R_HEADER +#define ARMA_WARN_LEVEL 1 +#define ARMA_DONT_USE_OPENMP // Known to cause speed problems +// #ifdef _OPENMP +// #include +// #endif +#include +#include +#include +#include +#include +#include + +#define max2( a , b ) ( (a) > (b) ? (a) : (b) ) +#define isSameTime(xout, xp) (fabs((xout)-(xp)) <= DBL_EPSILON*max2(fabs(xout),fabs(xp))) + +extern "C" { +#define iniRxodePtrs _babelmixr2_iniRxodePtrs + iniRxode2ptr +} + +using namespace arma; +using namespace Rcpp; + +#ifdef ENABLE_NLS +#include +#define _(String) dgettext ("babelmixr2", String) +/* replace pkg as appropriate */ +#else +#define _(String) (String) +#endif + +#define popedOde(id) ind_solve(rx, id, rxInner.dydt_liblsoda, rxInner.dydt_lsoda_dum, rxInner.jdum_lsoda, rxInner.dydt, rxInner.update_inis, rxInner.global_jt) + +struct rxSolveF { + // + // std::string estStr; + // std::string gradStr; + // std::string obfStr; + // + t_dydt dydt = NULL; + t_calc_jac calc_jac = NULL; + t_calc_lhs calc_lhs = NULL; + t_update_inis update_inis = NULL; + t_dydt_lsoda_dum dydt_lsoda_dum = NULL; + t_dydt_liblsoda dydt_liblsoda = NULL; + t_jdum_lsoda jdum_lsoda = NULL; + t_set_solve set_solve = NULL; + t_get_solve get_solve = NULL; + int global_jt = 2; + int global_mf = 22; + int global_debug = 0; + int neq = NA_INTEGER; +}; + +rxSolveF rxInner; +void rxUpdateFuns(SEXP trans, rxSolveF *inner){ + const char *lib, *s_dydt, *s_calc_jac, *s_calc_lhs, *s_inis, *s_dydt_lsoda_dum, *s_dydt_jdum_lsoda, + *s_ode_solver_solvedata, *s_ode_solver_get_solvedata, *s_dydt_liblsoda; + lib = CHAR(STRING_ELT(trans, 0)); + s_dydt = CHAR(STRING_ELT(trans, 3)); + s_calc_jac = CHAR(STRING_ELT(trans, 4)); + s_calc_lhs = CHAR(STRING_ELT(trans, 5)); + s_inis = CHAR(STRING_ELT(trans, 8)); + s_dydt_lsoda_dum = CHAR(STRING_ELT(trans, 9)); + s_dydt_jdum_lsoda = CHAR(STRING_ELT(trans, 10)); + s_ode_solver_solvedata = CHAR(STRING_ELT(trans, 11)); + s_ode_solver_get_solvedata = CHAR(STRING_ELT(trans, 12)); + s_dydt_liblsoda = CHAR(STRING_ELT(trans, 13)); + inner->global_jt = 2; + inner->global_mf = 22; + inner->global_debug = 0; + if (strcmp(CHAR(STRING_ELT(trans, 1)),"fulluser") == 0){ + inner->global_jt = 1; + inner->global_mf = 21; + } else { + inner->global_jt = 2; + inner->global_mf = 22; + } + inner->calc_lhs =(t_calc_lhs) R_GetCCallable(lib, s_calc_lhs); + inner->dydt =(t_dydt) R_GetCCallable(lib, s_dydt); + inner->calc_jac =(t_calc_jac) R_GetCCallable(lib, s_calc_jac); + inner->update_inis =(t_update_inis) R_GetCCallable(lib, s_inis); + inner->dydt_lsoda_dum =(t_dydt_lsoda_dum) R_GetCCallable(lib, s_dydt_lsoda_dum); + inner->jdum_lsoda =(t_jdum_lsoda) R_GetCCallable(lib, s_dydt_jdum_lsoda); + inner->set_solve = (t_set_solve)R_GetCCallable(lib, s_ode_solver_solvedata); + inner->get_solve = (t_get_solve)R_GetCCallable(lib, s_ode_solver_get_solvedata); + inner->dydt_liblsoda = (t_dydt_liblsoda)R_GetCCallable(lib, s_dydt_liblsoda); +} + +void rxClearFuns(rxSolveF *inner){ + inner->calc_lhs = NULL; + inner->dydt = NULL; + inner->calc_jac = NULL; + inner->update_inis = NULL; + inner->dydt_lsoda_dum = NULL; + inner->jdum_lsoda = NULL; + inner->set_solve = NULL; + inner->get_solve = NULL; + inner->dydt_liblsoda = NULL; +} + +rx_solve *rx; + +struct popedOptions { + int ntheta=0; + int stickyTol=0; + int stickyRecalcN=1; + int stickyRecalcN2=0; + int stickyRecalcN1=0; + int maxOdeRecalc; + int reducedTol; + int reducedTol2; + int naZero; + double odeRecalcFactor; + bool loaded=false; +}; + +popedOptions popedOp; + +//[[Rcpp::export]] +RObject popedFree() { + return R_NilValue; +} + +Environment _popedE; + +//[[Rcpp::export]] +RObject popedSetup(Environment e, bool full) { + popedFree(); + _popedE=e; + List control = e["control"]; + List rxControl = as(e["rxControl"]); + + RObject model; + NumericVector p; + RObject data; + if (full) { + model = e["modelF"]; + p = as(e["paramF"]); + data = e["dataF"]; //const RObject &events = + } else { + model = e["modelMT"]; + p = as(e["paramMT"]); + data = e["dataMT"]; //const RObject &events = + } + NumericVector p2 = p; + std::fill_n(p2.begin(), p2.size(), NA_REAL); + e["paramCache"]=p2; + e["lid"] = NA_INTEGER; + List mvp = rxode2::rxModelVars_(model); + rxUpdateFuns(as(mvp["trans"]), &rxInner); + + // initial value of parameters + CharacterVector pars = mvp[RxMv_params]; + popedOp.ntheta = pars.size(); + if (p.size() != popedOp.ntheta) { + Rprintf("pars\n"); + print(pars); + Rprintf("p\n"); + print(p); + Rcpp::stop("size mismatch"); + } + popedOp.stickyRecalcN=as(control["stickyRecalcN"]); + popedOp.stickyTol=0; + popedOp.stickyRecalcN2=0; + popedOp.stickyRecalcN1=0; + popedOp.reducedTol = 0; + popedOp.reducedTol2 = 0; + popedOp.naZero=0; + popedOp.maxOdeRecalc = as(control["maxOdeRecalc"]); + popedOp.odeRecalcFactor = as(control["odeRecalcFactor"]); + rxode2::rxSolve_(model, rxControl, + R_NilValue,//const Nullable &specParams = + R_NilValue,//const Nullable &extraArgs = + p,//const RObject ¶ms = + data,//const RObject &events = + R_NilValue, // inits + 1);//const int setupOnly = 0 + rx = getRxSolve_(); + return R_NilValue; +} + +void popedSolve(int &id) { + rx_solving_options *op = getSolvingOptions(rx); + rx_solving_options_ind *ind = getSolvingOptionsInd(rx, id); + popedOde(id); + int j=0; + while (popedOp.stickyRecalcN2 <= popedOp.stickyRecalcN && + hasOpBadSolve(op) && j < popedOp.maxOdeRecalc) { + popedOp.stickyRecalcN2++; + popedOp.reducedTol2 = 1; + // Not thread safe + rxode2::atolRtolFactor_(popedOp.odeRecalcFactor); + setIndSolve(ind, -1); + popedOde(id); + j++; + } + if (j != 0) { + if (popedOp.stickyRecalcN2 <= popedOp.stickyRecalcN){ + // Not thread safe + rxode2::atolRtolFactor_(pow(popedOp.odeRecalcFactor, -j)); + } else { + popedOp.stickyTol=1; + } + } +} + +static inline rx_solving_options_ind* updateParamRetInd(NumericVector &theta, int &id) { + rx = getRxSolve_(); + rx_solving_options_ind *ind = getSolvingOptionsInd(rx, id); + for (int i = popedOp.ntheta; i--;) { + setIndParPtr(ind, i, theta[i]); + } + return ind; +} + +// Solve prediction and saved based on modeling time +void popedSolveFid(double *f, double *w, double *t, NumericVector &theta, int id, int totn) { + // arma::vec ret(retD, nobs, false, true); + rx_solving_options_ind *ind = updateParamRetInd(theta, id); + rx_solving_options *op = getSolvingOptions(rx); + iniSubjectE(id, 1, ind, op, rx, rxInner.update_inis); + popedSolve(id); + int kk, k=0; + double curT; + for (int j = 0; j < getIndNallTimes(ind); ++j) { + setIndIdx(ind, j); + kk = getIndIx(ind, j); + curT = getTime(kk, ind); + double *lhs = getIndLhs(ind); + if (isDose(getIndEvid(ind, kk))) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + continue; + } else if (getIndEvid(ind, kk) == 0) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + if (ISNA(lhs[0])) { + popedOp.naZero=1; + lhs[0] = 0.0; + } + // ret(k) = lhs[0]; + // k++; + } else if (getIndEvid(ind, kk) >= 10 && getIndEvid(ind, kk) <= 99) { + // mtimes to calculate information + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + f[k] = lhs[0]; + w[k] = sqrt(lhs[1]); + t[k] = curT; + k++; + if (k >= totn) return; // vector has been created, break + } + } +} + +void popedSolveFid2(double *f, double *w, double *t, NumericVector &theta, int id, int totn) { + // arma::vec ret(retD, nobs, false, true); + rx_solving_options_ind *ind = updateParamRetInd(theta, id); + rx_solving_options *op = getSolvingOptions(rx); + iniSubjectE(id, 1, ind, op, rx, rxInner.update_inis); + popedSolve(id); + int kk, k=0; + double curT; + for (int j = 0; j < getIndNallTimes(ind); ++j) { + setIndIdx(ind, j); + kk = getIndIx(ind, j); + curT = getTime(kk, ind); + double *lhs = getIndLhs(ind); + if (isDose(getIndEvid(ind, kk))) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + continue; + } else if (getIndEvid(ind, kk) == 0) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + if (ISNA(lhs[0])) { + popedOp.naZero=1; + lhs[0] = 0.0; + } + // ret(k) = lhs[0]; + // k++; + f[k] = lhs[0]; + w[k] = sqrt(lhs[1]); + t[k] = curT; + k++; + if (k >= totn) return; // vector has been created, break + } else if (getIndEvid(ind, kk) >= 10 && getIndEvid(ind, kk) <= 99) { + // mtimes to calculate information + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + } + } +} + +static inline bool solveCached(NumericVector &theta, int &id) { + int lid = as(_popedE["lid"]); + if (lid != id) return false; + NumericVector last = as(_popedE["paramCache"]); + return as(all(last == theta)); +} + +//[[Rcpp::export]] +Rcpp::DataFrame popedSolveIdN2(NumericVector &theta, NumericVector &mt, int id, int totn) { + if (solveCached(theta, id)) return(as(_popedE["s"])); + NumericVector t(totn); + arma::vec f(totn); + arma::vec w(totn); + popedSolveFid2(&f[0], &w[0], &t[0], theta, id, totn); + DataFrame ret = DataFrame::create(_["t"]=t, + _["rx_pred_"]=f, // match rxode2/nlmixr2 to simplify code of mtime models + _["w"]=w); // w = sqrt(rx_r_) + _popedE["s"] = ret; + + return ret; +} + +//[[Rcpp::export]] +Rcpp::DataFrame popedSolveIdN(NumericVector &theta, NumericVector &mt, int id, int totn) { + if (solveCached(theta, id)) return(as(_popedE["s"])); + NumericVector t(totn); + arma::vec f(totn); + arma::vec w(totn); + popedSolveFid(&f[0], &w[0], &t[0], theta, id, totn); + // arma::uvec m = as(match(mt, t))-1; + // f = f(m); + // w = w(m); + DataFrame ret = DataFrame::create(_["t"]=t, + _["rx_pred_"]=f, // match rxode2/nlmixr2 to simplify code of mtime models + _["w"]=w); // w = sqrt(rx_r_) + _popedE["s"] = ret; + return ret; +} + +void popedSolveFidMat(arma::mat &matMT, NumericVector &theta, int id, int nrow, int nend) { + // arma::vec ret(retD, nobs, false, true); + rx_solving_options_ind *ind = updateParamRetInd(theta, id); + rx_solving_options *op = getSolvingOptions(rx); + iniSubjectE(id, 1, ind, op, rx, rxInner.update_inis); + popedSolve(id); + int kk, k=0; + double curT, lastTime; + lastTime = getTime(getIndIx(ind, 0), ind)-1; + bool isMT = false; + for (int j = 0; j < getIndNallTimes(ind); ++j) { + setIndIdx(ind, j); + kk = getIndIx(ind, j); + curT = getTime(kk, ind); + isMT = getIndEvid(ind, kk) >= 10 && getIndEvid(ind, kk) <= 99; + if (isMT && isSameTime(curT, lastTime)) { + matMT(k, 0) = curT; + for (int i = 0; i < nend; ++i) { + matMT(k, i*2+1) = matMT(k-1, i*2+1); + matMT(k, i*2+2) = matMT(k-1, i*2+1); + } + k++; + if (k >= nrow) { + return; // vector has been created, break + } + continue; + } + double *lhs = getIndLhs(ind); + if (isDose(getIndEvid(ind, kk))) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + continue; + } else if (isMT) { + // mtimes to calculate information + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + if (ISNA(lhs[0])) { + popedOp.naZero=1; + lhs[0] = 0.0; + } + matMT(k, 0) = curT; + for (int i = 0; i < nend; ++i) { + matMT(k, i*2+1) = lhs[i*2]; + matMT(k, i*2+2) = lhs[i*2+1]; + } + k++; + if (k >= nrow) { + return; // vector has been created, break + } + lastTime = curT; + } else if (getIndEvid(ind, kk) == 0) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + if (ISNA(lhs[0])) { + popedOp.naZero=1; + lhs[0] = 0.0; + } + } + } +} + +//[[Rcpp::export]] +Rcpp::DataFrame popedSolveIdME(NumericVector &theta, + NumericVector &umt, + NumericVector &mt, IntegerVector &ms, + int nend, int id, int totn) { + if (solveCached(theta, id)) return(as(_popedE["s"])); + NumericVector t(totn); + arma::vec f(totn); + arma::vec w(totn); + int nrow = umt.size(); + arma::mat matMT(nrow, nend*2+1); + List we(nend); + for (int i = 0; i < nend; i++) { + we[i] = LogicalVector(totn); + } + + popedSolveFidMat(matMT, theta, id, nrow, nend); + // arma::uvec m = as(match(mt, t))-1; + // f = f(m); + // w = w(m); + for (int i = 0; i < totn; ++i) { + double curT = mt[i]; + int curMS = ms[i]; + // Create a logical vector for which endpoint (used in error per endpoint identification) + for (int j = 0; j < nend; j++) { + LogicalVector cur = we[j]; + cur[i] = (curMS-1 == j); + we[j] = cur; + } + for (int j = 0; j < nrow; ++j) { + if (curT == matMT(j, 0)) { + f[i] = matMT(j, (curMS-1)*2+1); + w[i] = matMT(j, (curMS-1)*2+2); + break; + } + if (j == nrow-1) { + f[i] = NA_REAL; + w[i] = NA_REAL; + } + } + } + DataFrame ret = DataFrame::create(_["t"]=mt, + _["ms"]=ms, + _["rx_pred_"]=f, // match rxode2/nlmixr2 to simplify code of mtime models + _["w"]=w); // w = sqrt(rx_r_) + _popedE["s"] = ret; + _popedE["we"] = we; + return ret; +} + + +void popedSolveFidMat2(arma::mat &matMT, NumericVector &theta, int id, int nrow, int nend) { + // arma::vec ret(retD, nobs, false, true); + rx_solving_options_ind *ind = updateParamRetInd(theta, id); + rx_solving_options *op = getSolvingOptions(rx); + iniSubjectE(id, 1, ind, op, rx, rxInner.update_inis); + popedSolve(id); + int kk, k=0; + double curT, lastTime; + lastTime = getTime(getIndIx(ind, 0), ind)-1; + for (int j = 0; j < getIndNallTimes(ind); ++j) { + setIndIdx(ind, j); + kk = getIndIx(ind, j); + curT = getTime(kk, ind); + double *lhs = getIndLhs(ind); + if (getIndEvid(ind, kk) == 0 && isSameTime(curT, lastTime)) { + matMT(k, 0) = curT; + for (int i = 0; i < nend; ++i) { + matMT(k, i*2+1) = matMT(k-1, i*2+1); + matMT(k, i*2+2) = matMT(k-1, i*2+1); + } + k++; + if (k >= nrow) { + return; // vector has been created, break + } + continue; + } + if (isDose(getIndEvid(ind, kk))) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + continue; + } else if (getIndEvid(ind, kk) == 0) { + rxInner.calc_lhs(id, curT, getOpIndSolve(op, ind, j), lhs); + if (ISNA(lhs[0])) { + popedOp.naZero=1; + lhs[0] = 0.0; + } + matMT(k, 0) = curT; + for (int i = 0; i < nend; ++i) { + matMT(k, i*2+1) = lhs[i*2]; + matMT(k, i*2+2) = lhs[i*2+1]; + } + k++; + if (k >= nrow) { + return; // vector has been created, break + } + lastTime = curT; + } + } +} + +//[[Rcpp::export]] +Rcpp::DataFrame popedSolveIdME2(NumericVector &theta, + NumericVector &umt, + NumericVector &mt, IntegerVector &ms, + int nend, int id, int totn) { + if (solveCached(theta, id)) return(as(_popedE["s"])); + NumericVector t(totn); + arma::vec f(totn); + arma::vec w(totn); + int nrow = umt.size(); + arma::mat matMT(nrow, nend*2+1); + List we(nend); + for (int i = 0; i < nend; i++) { + we[i] = LogicalVector(totn); + } + + popedSolveFidMat2(matMT, theta, id, nrow, nend); + // arma::uvec m = as(match(mt, t))-1; + // f = f(m); + // w = w(m); + for (int i = 0; i < totn; ++i) { + double curT = mt[i]; + int curMS = ms[i]; + // Create a logical vector for which endpoint (used in error per endpoint identification) + for (int j = 0; j < nend; j++) { + LogicalVector cur = we[j]; + cur[i] = (curMS-1 == j); + we[j] = cur; + } + for (int j = 0; j < nrow; ++j) { + if (curT == matMT(j, 0)) { + f[i] = matMT(j, (curMS-1)*2+1); + w[i] = matMT(j, (curMS-1)*2+2); + break; + } + if (j == nrow-1) { + f[i] = NA_REAL; + w[i] = NA_REAL; + } + } + } + DataFrame ret = DataFrame::create(_["t"]=mt, + _["ms"]=ms, + _["rx_pred_"]=f, // match rxode2/nlmixr2 to simplify code of mtime models + _["w"]=w); // w = sqrt(rx_r_) + _popedE["s"] = ret; + _popedE["we"] = we; + return ret; +} From 0c0605db42e687b2c26d007a3495955958507e70 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 16:59:51 -0500 Subject: [PATCH 2/7] Add required depedencies --- .github/workflows/R-CMD-check.yaml | 3 +++ .github/workflows/pkgdown.yaml | 3 +++ .github/workflows/test-coverage.yaml | 3 +++ 3 files changed, 9 insertions(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 19fa4f17..5cc76ad2 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.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 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 799b822f..9afbfe4d 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.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 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index b5c63c24..be886a02 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -28,6 +28,9 @@ jobs: pak-version: devel extra-packages: | any::covr + nlmixr2/n1qn1c + nlmixr2/lbfgsb3c + nlmixr2/PreciseSums nlmixr2/lotri nlmixr2/rxode2ll nlmixr2/rxode2 From 7c632529bbf5deba54698b5dac75ad2f8ca6f120 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 17:13:00 -0500 Subject: [PATCH 3/7] Add dparser to coverage --- .github/workflows/test-coverage.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index be886a02..ae396791 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -31,6 +31,7 @@ jobs: nlmixr2/n1qn1c nlmixr2/lbfgsb3c nlmixr2/PreciseSums + nlmixr2/dparser-R nlmixr2/lotri nlmixr2/rxode2ll nlmixr2/rxode2 From 26605325c362ac8cca0d2dfeabf392962c4ffbb1 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 17:14:53 -0500 Subject: [PATCH 4/7] Export solve n2 --- src/init.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/init.c b/src/init.c index a130750c..8ef4f726 100644 --- a/src/init.c +++ b/src/init.c @@ -17,11 +17,13 @@ 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}, From 9ce819792de0d974aacf1b3a5005f967223d0af8 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 18:05:16 -0500 Subject: [PATCH 5/7] Fix poped tests --- tests/testthat/_snaps/poped/pheno-pred.svg | 70 +++++----- tests/testthat/_snaps/poped/pred-example1.svg | 44 +++---- tests/testthat/_snaps/poped/pred-example2.svg | 124 +++++++++--------- tests/testthat/test-poped.R | 22 +++- 4 files changed, 134 insertions(+), 126 deletions(-) diff --git a/tests/testthat/_snaps/poped/pheno-pred.svg b/tests/testthat/_snaps/poped/pheno-pred.svg index 40818c00..decf9405 100644 --- a/tests/testthat/_snaps/poped/pheno-pred.svg +++ b/tests/testthat/_snaps/poped/pheno-pred.svg @@ -21,42 +21,46 @@ - - + + - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + -41.00 -41.25 -41.50 - - - - - - -0 -10 -20 -Time +0 +10 +20 +30 +40 + + + + + + + + +0 +10 +20 +Time Model Predictions Group @@ -68,6 +72,6 @@ Group: 1 Group: 2 -pheno_pred +pheno_pred diff --git a/tests/testthat/_snaps/poped/pred-example1.svg b/tests/testthat/_snaps/poped/pred-example1.svg index 89c96366..9f9308a7 100644 --- a/tests/testthat/_snaps/poped/pred-example1.svg +++ b/tests/testthat/_snaps/poped/pred-example1.svg @@ -27,33 +27,33 @@ - - - - - - - - - - - - + + + + + + + + + + + + 0.0 -0.1 -0.2 -0.3 -0.4 -0.5 +0.1 +0.2 +0.3 +0.4 +0.5 - - - - - + + + + + diff --git a/tests/testthat/_snaps/poped/pred-example2.svg b/tests/testthat/_snaps/poped/pred-example2.svg index 64ace99f..f32fec9e 100644 --- a/tests/testthat/_snaps/poped/pred-example2.svg +++ b/tests/testthat/_snaps/poped/pred-example2.svg @@ -21,92 +21,88 @@ - - + + - - - - - - - + + + + + + + - - + + - - - - - - - + + + + + + + - - + + - - -Group: 1 + + +Group: 1 - - + + - - -Group: 2 + + +Group: 2 - - - - - - -0 -50 -100 -150 -200 -250 - - - - - - -0 -50 -100 -150 -200 -250 -0.0 -0.2 -0.4 -0.6 -0.8 - - - - - -Time + + + + + + +0 +50 +100 +150 +200 +250 + + + + + + +0 +50 +100 +150 +200 +250 +-0.0025 +0.0000 +0.0025 + + + +Time Model Predictions -pred-example2 +pred-example2 diff --git a/tests/testthat/test-poped.R b/tests/testthat/test-poped.R index 7542fedf..69ec1547 100644 --- a/tests/testthat/test-poped.R +++ b/tests/testthat/test-poped.R @@ -166,6 +166,7 @@ if (requireNamespace("PopED", quietly=TRUE)) { withr::with_seed(42, { + set.seed(42) phenoWt <- function() { ini({ tcl <- log(0.008) # typical value of clearance @@ -239,6 +240,8 @@ if (requireNamespace("PopED", quietly=TRUE)) { withr::with_seed(42, { + set.seed(42) + e <- et(amt=1, ii=24, until=250) %>% et(list(c(0, 10), c(0, 10), @@ -274,6 +277,7 @@ if (requireNamespace("PopED", quietly=TRUE)) { withr::with_seed(42, { + set.seed(42) db <- nlmixr2(f, e, "poped", popedControl(a=list(c(DOSE=20), c(DOSE=40)), @@ -294,14 +298,18 @@ if (requireNamespace("PopED", quietly=TRUE)) { dat <- model_prediction(db,DV=TRUE) expect_equal(head(dat, n=4), - data.frame(ID = factor(c(1L, 1L, 1L, 1L), levels=paste(1:40)), + data.frame( + ID = factor(c(1L, 1L, 1L, 1L), levels=paste(1:40)), Time = c(1, 2, 8, 240), - DV = c(0.0636114439502449, 0.128497965443666, 0.146365309173223, 0.165854838702936), - IPRED = c(0.0682068386181826, 0.112300266786103, 0.167870981706669, 0.153239620769789), - PRED = c(0.0532502332862765, 0.0920480197661157, 0.164096088998621, 0.126713764327394), - Group = factor(c(1L, 1L, 1L, 1L), levels = c("1", "2")), - Model = factor(c(1L, 1L, 1L, 1L), levels = "1"), - DOSE = c(20, 20, 20, 20)), + DV = c(0.0353822273010824, 0.0721765325175048, + 0.142203020963518, 0.121570466918341), + IPRED = c(0.0379965748703227, 0.0654575999147953, + 0.118727861585151, 0.15387388187677), + PRED = c(0.0532502332862765, 0.0920480197661157, + 0.164096088998621, 0.126713764327394), + Group = factor(c(1L, 1L, 1L, 1L), levels = c("1", "2")), + Model = factor(c(1L, 1L, 1L, 1L), levels = "1"), + DOSE = c(20, 20, 20, 20)), tolerance=1e-4) expect_equal(evaluate_design(db), From 93072e84008f268051df9b298df187437373fbf0 Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 18:10:57 -0500 Subject: [PATCH 6/7] Add back ui evaluation --- tests/testthat/test-nonmem.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-nonmem.R b/tests/testthat/test-nonmem.R index fe430e6b..18e7ead0 100644 --- a/tests/testthat/test-nonmem.R +++ b/tests/testthat/test-nonmem.R @@ -1,6 +1,7 @@ withr::with_tempdir({ withr::with_options(list(babelmixr2.protectZeros=FALSE), { test_that("NONMEM dsl, individual lines", { + one.cmt <- function() { ini({ tka <- 0.45 ; label("Ka") @@ -155,6 +156,8 @@ withr::with_tempdir({ regexp="only exported NONMEM" ) + ui <- one.cmt() + expect_s3_class(ui, "rxUi") expect_type(ui$nonmemModel, "character") From 39ccad26e618d65441e6d308b15eb5c664b2886b Mon Sep 17 00:00:00 2001 From: Matthew Fidler Date: Thu, 5 Sep 2024 18:36:58 -0500 Subject: [PATCH 7/7] Fix pkgdown vignette --- vignettes/articles/PopED.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/articles/PopED.Rmd b/vignettes/articles/PopED.Rmd index 6ba4d594..70dacd60 100644 --- a/vignettes/articles/PopED.Rmd +++ b/vignettes/articles/PopED.Rmd @@ -256,7 +256,7 @@ poped_db_ode_babelmixr2 <- nlmixr(f, e, ``` ## Linear compartment solution -```r +```{r lincmt} f2 <- function() { ini({ tV <- 72.8