diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 6baac3bea..63df9aebf 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -50,7 +50,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - cache-version: 7 + cache-version: 8 pak-version: stable extra-packages: | any::rcmdcheck diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 0e295dccd..b2fbf41fb 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -38,7 +38,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - cache-version: 6 + cache-version: 7 extra-packages: | any::pkgdown nlmixr2/dparser-R diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 12aae2a2b..2d6ca3672 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -26,7 +26,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - cache-version: 6 + cache-version: 7 extra-packages: | any::covr nlmixr2/dparser-R diff --git a/DESCRIPTION b/DESCRIPTION index 4b2d7e8d6..5f00d370c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -82,7 +82,7 @@ Imports: checkmate, ggplot2 (>= 3.4.0), inline, - lotri (>= 0.4.0), + lotri (>= 0.5.0), magrittr, memoise, methods, @@ -116,6 +116,7 @@ RoxygenNote: 7.3.2 Biarch: true LinkingTo: sitmo, + lotri (>= 0.5.0), PreciseSums (>= 0.3), Rcpp, RcppArmadillo (>= 0.9.300.2.0), diff --git a/NEWS.md b/NEWS.md index b7d12c47c..3821bae1a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -70,6 +70,10 @@ break the solving (so can be used a bit more robustly with models like Weibull absorption). +- `rxode2` is has no more binary link to `lotri`, which means that + changes in the `lotri` package will not require `rxode2` to be + recompiled (in most cases) and will not crash the system. + ## Bug fixes - Fix `ui$props$endpoint` when the ui endpoint is defined in terms of the ode instead of lhs. See #754 diff --git a/R/rxode-options.R b/R/rxode-options.R index 866c93420..b48cb9c01 100644 --- a/R/rxode-options.R +++ b/R/rxode-options.R @@ -72,6 +72,10 @@ .ggplot2Fix() } ## nocov end +.iniLotriPtrs <- function() { + .Call(`_iniLotriPtr`, lotri::.lotriPointers()) +} + .onAttach <- function(libname, pkgname) { ## For some strange reason, mvnfast needs to be loaded before rxode2 to work correctly .Call(`_rxode2_setRstudio`, Sys.getenv("RSTUDIO") == "1") @@ -79,6 +83,8 @@ if (!interactive()) { setProgSupported(0) } + # Setup lotri C linkages using function pointers + .iniLotriPtrs() rxTempDir() .ggplot2Fix() v <- utils::packageVersion("rxode2") diff --git a/man/reexports.Rd b/man/reexports.Rd index 8cba3d62e..2857ff16d 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -38,3 +38,4 @@ below to see their documentation. \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} }} +\value{ Inherited from parent routine } diff --git a/src/cvPost.cpp b/src/cvPost.cpp index aee7ff44a..745f7a2b5 100644 --- a/src/cvPost.cpp +++ b/src/cvPost.cpp @@ -10,25 +10,13 @@ #include #include "../inst/include/rxode2parse.h" #include "../inst/include/rxode2_as.h" +#include -extern "C"{ +extern "C" SEXP chin(SEXP a, SEXP b); + +// place links here +iniLotri; - extern "C" SEXP chin(SEXP a, SEXP b); - typedef SEXP (*lotriMat_type) (SEXP, SEXP, SEXP); - lotriMat_type lotriMat; - typedef SEXP (*asLotriMat_type) (SEXP, SEXP, SEXP); - asLotriMat_type asLotriMat; - typedef SEXP (*lotriSep_type) (SEXP, SEXP, SEXP, SEXP, SEXP); - lotriSep_type lotriSep; - typedef SEXP (*lotriAllNames_type) (SEXP); - lotriAllNames_type lotriAllNames; - typedef SEXP (*lotriGetBounds_type) (SEXP, SEXP, SEXP); - lotriGetBounds_type lotriGetBounds; - typedef SEXP (*isLotri_type) (SEXP); - isLotri_type isLotri; - typedef SEXP (*lotriMaxNu_type) (SEXP); - lotriMaxNu_type lotriMaxNu; -} List etTrans(List inData, const RObject &mv, bool addCmt, bool dropUnits, bool allTimeVar, bool keepDosingOnly, Nullable combineDvid, @@ -62,19 +50,6 @@ LogicalVector rxSolveFree(); bool gotLotriMat=false; -static inline void setupLotri() { - if (!gotLotriMat) { - lotriMat = (lotriMat_type) R_GetCCallable("lotri","_lotriLstToMat"); - asLotriMat = (asLotriMat_type) R_GetCCallable("lotri","_asLotriMat"); - lotriSep = (lotriSep_type) R_GetCCallable("lotri","_lotriSep"); - lotriAllNames = (lotriAllNames_type) R_GetCCallable("lotri","_lotriAllNames"); - lotriGetBounds = (lotriGetBounds_type) R_GetCCallable("lotri", "_lotriGetBounds"); - isLotri = (isLotri_type) R_GetCCallable("lotri", "_isLotri"); - lotriMaxNu = (lotriMaxNu_type) R_GetCCallable("lotri", "_lotriMaxNu"); - gotLotriMat=true; - } -} - using namespace Rcpp; using namespace arma; @@ -411,7 +386,6 @@ SEXP cvPost_(SEXP nuS, SEXP omegaS, SEXP nS, SEXP omegaIsCholS, } else { stop(_("variable 'type': Can only use type string or integer[1,3]")); } - setupLotri(); if (n == 1 && type == 1){ if (qtest(omegaS, "M")) { double nu = getDbl(nuS, "nu"); @@ -485,8 +459,9 @@ SEXP cvPost_(SEXP nuS, SEXP omegaS, SEXP nS, SEXP omegaIsCholS, if (omega.hasAttribute("format")) { format = omega.attr("format"); } - setupLotri(); - return as(lotriMat(as(omegaLst), format, as(startAt))); + return as(lotriLstToMat(as(omegaLst), format, + as(startAt), + as(CharacterVector::create("matrix", "array")))); } } else { if (type == 1){ @@ -715,7 +690,6 @@ SEXP expandPars_(SEXP objectS, SEXP paramsS, SEXP eventsS, SEXP controlS) { // SEXP events = as(events); qassertS(controlS, "l+", "control"); List control = as(controlS); - setupLotri(); int pro = 0; SEXP nStudS = PROTECT(control[Rxc_nStud]); pro++; int nStud = as(nStudS); @@ -1167,7 +1141,6 @@ SEXP nestingInfo_(SEXP omega, List data) { if (Rf_isNewList(omega)){ lotriOmega = omega; } else if (Rf_isMatrix(omega)) { - setupLotri(); lotriOmega = PROTECT(asLotriMat(omega, R_NilValue, wrap(CharacterVector::create(idName)))); pro++; } else { diff --git a/src/init.c b/src/init.c index 1d1e3e348..47474df95 100644 --- a/src/init.c +++ b/src/init.c @@ -280,13 +280,6 @@ SEXP _rxode2_meanProbs_(SEXP x, SEXP probs, SEXP naRm, SEXP useT, SEXP pred, SEX SEXP _rxode2_binomProbs_(SEXP x, SEXP probs, SEXP naRm, SEXP inN, SEXP cont); SEXP _rxode2_binomProbsPredVec_(SEXP n, SEXP m, SEXP Y, SEXP M, SEXP doP, SEXP tol); -typedef SEXP (*lotriMat_type) (SEXP, SEXP, SEXP); -typedef SEXP (*asLotriMat_type) (SEXP, SEXP, SEXP); -typedef SEXP (*lotriSep_type) (SEXP, SEXP, SEXP, SEXP, SEXP); -typedef SEXP (*lotriAllNames_type) (SEXP); -typedef SEXP (*lotriGetBounds_type) (SEXP, SEXP, SEXP); -typedef SEXP (*isLotri_type) (SEXP); -typedef SEXP (*lotriMaxNu_type) (SEXP); typedef SEXP (*rxSolveFreeSexp_t)(void); extern void setZeroMatrix(int which); extern rx_solve rx_global; @@ -364,8 +357,11 @@ SEXP _rxode2_getClassicEvid(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP _rxode2_rxQs(SEXP); +SEXP iniLotriPtr(SEXP ptr); + void R_init_rxode2(DllInfo *info){ R_CallMethodDef callMethods[] = { + {"_iniLotriPtr", (DL_FUNC) &iniLotriPtr, 1}, {"_rxode2_rxode2parseSetRstudio", (DL_FUNC) &_rxode2_rxode2parseSetRstudio, 1}, {"_rxode2_rxQs", (DL_FUNC) &_rxode2_rxQs, 1}, {"_rxode2_rxQr", (DL_FUNC) &_rxode2_rxQr, 1}, diff --git a/tests/testthat/test-occ.R b/tests/testthat/test-occ.R index cda787ae6..261bdd8e3 100644 --- a/tests/testthat/test-occ.R +++ b/tests/testthat/test-occ.R @@ -1,8 +1,6 @@ rxTest({ test_that("occasions", { - .rxr <- loadNamespace("rxode2") - # Nesting tests mod <- rxode2({ @@ -87,7 +85,7 @@ rxTest({ ) | inv(nu = 10) ) - .ni <- .rxr$nestingInfo_(omega, ev) + .ni <- nestingInfo_(omega, ev) expect_equal(.ni$below, c(eye = 2L, occ = 2L)) expect_equal(.ni$above, c(inv = 2L)) @@ -125,9 +123,7 @@ rxTest({ .ep <- .expandPars(mod, theta, ev, control = rxControl( thetaMat = thetaMat, omega = omega, - nSub = 40, nStud = 3 - ) - ) + nSub = 40, nStud = 3)) expect_equal(length(.ep$KA), 120L) expect_equal(length(unique(.ep$KA)), 3L) @@ -276,7 +272,7 @@ rxTest({ ## Test edge case -- no between or above occasion variability - .ni <- .rxr$nestingInfo_( + .ni <- nestingInfo_( lotri(lotri(eta.Cl ~ 0.1, eta.Ka ~ 0.1) | id(nu = 100)), ev )