From ebff7873d39e9bf52957dec706c082a52e5f09a5 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 12 Aug 2024 16:00:46 -0500 Subject: [PATCH 1/6] Remove get C callable from lotri --- DESCRIPTION | 1 + R/rxode-options.R | 2 ++ man/reexports.Rd | 1 + src/cvPost.cpp | 39 +++++---------------------------------- src/init.c | 4 +++- 5 files changed, 12 insertions(+), 35 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4b2d7e8d6..173cd0639 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -116,6 +116,7 @@ RoxygenNote: 7.3.2 Biarch: true LinkingTo: sitmo, + lotri, PreciseSums (>= 0.3), Rcpp, RcppArmadillo (>= 0.9.300.2.0), diff --git a/R/rxode-options.R b/R/rxode-options.R index 866c93420..885d208d1 100644 --- a/R/rxode-options.R +++ b/R/rxode-options.R @@ -79,6 +79,8 @@ if (!interactive()) { setProgSupported(0) } + # Setup lotri C linkages using calculated function pointers + .Call(`_iniLotriPtr`, lotri::.lotriPointers()) 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..6c25bbd62 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,7 +459,6 @@ 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))); } } else { @@ -715,7 +688,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 +1139,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..da1c4f2de 100644 --- a/src/init.c +++ b/src/init.c @@ -286,7 +286,6 @@ 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 +363,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}, From cea1c2011b09a4984ed45060303b818089b68d5f Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 12 Aug 2024 18:35:38 -0500 Subject: [PATCH 2/6] Send the default matrix class and the lotri pointers --- R/rxode-options.R | 2 +- src/init.c | 11 ++--------- tests/testthat/test-occ.R | 10 +++------- 3 files changed, 6 insertions(+), 17 deletions(-) diff --git a/R/rxode-options.R b/R/rxode-options.R index 885d208d1..c658cfc9a 100644 --- a/R/rxode-options.R +++ b/R/rxode-options.R @@ -80,7 +80,7 @@ setProgSupported(0) } # Setup lotri C linkages using calculated function pointers - .Call(`_iniLotriPtr`, lotri::.lotriPointers()) + .Call(`_iniLotriPtr`, lotri::.lotriPointers(), class(matrix(0))) rxTempDir() .ggplot2Fix() v <- utils::packageVersion("rxode2") diff --git a/src/init.c b/src/init.c index da1c4f2de..ca035cdfa 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 (*rxSolveFreeSexp_t)(void); extern void setZeroMatrix(int which); extern rx_solve rx_global; extern rx_solving_options op_global; @@ -363,11 +356,11 @@ SEXP _rxode2_getClassicEvid(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP _rxode2_rxQs(SEXP); -SEXP iniLotriPtr(SEXP ptr); +SEXP iniLotriPtr(SEXP ptr, SEXP matCls); void R_init_rxode2(DllInfo *info){ R_CallMethodDef callMethods[] = { - {"_iniLotriPtr", (DL_FUNC) &iniLotriPtr, 1}, + {"_iniLotriPtr", (DL_FUNC) &iniLotriPtr, 2}, {"_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 ) From 7b21f4f8800f9f2d4cec40df2244f50ec182ae0e Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 12 Aug 2024 18:41:58 -0500 Subject: [PATCH 3/6] Update news --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) 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 From 57037b3315bd500bcaeca1124c5653c911478cea Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 12 Aug 2024 18:54:26 -0500 Subject: [PATCH 4/6] Request a newer lotri for building --- DESCRIPTION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 173cd0639..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,7 +116,7 @@ RoxygenNote: 7.3.2 Biarch: true LinkingTo: sitmo, - lotri, + lotri (>= 0.5.0), PreciseSums (>= 0.3), Rcpp, RcppArmadillo (>= 0.9.300.2.0), From 716f5fcd2c5cacccaa95b79d02864025345426b7 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 12 Aug 2024 18:55:45 -0500 Subject: [PATCH 5/6] Reset cache --- .github/workflows/R-CMD-check.yaml | 2 +- .github/workflows/pkgdown.yaml | 2 +- .github/workflows/test-coverage.yaml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) 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 From 876b60545569526e39856c151c91b2ed6a60cab7 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Mon, 12 Aug 2024 20:36:46 -0500 Subject: [PATCH 6/6] Follow new lotri headers (and hopefully don't crash) --- R/rxode-options.R | 8 ++++++-- src/cvPost.cpp | 4 +++- src/init.c | 5 +++-- 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/R/rxode-options.R b/R/rxode-options.R index c658cfc9a..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,8 +83,8 @@ if (!interactive()) { setProgSupported(0) } - # Setup lotri C linkages using calculated function pointers - .Call(`_iniLotriPtr`, lotri::.lotriPointers(), class(matrix(0))) + # Setup lotri C linkages using function pointers + .iniLotriPtrs() rxTempDir() .ggplot2Fix() v <- utils::packageVersion("rxode2") diff --git a/src/cvPost.cpp b/src/cvPost.cpp index 6c25bbd62..745f7a2b5 100644 --- a/src/cvPost.cpp +++ b/src/cvPost.cpp @@ -459,7 +459,9 @@ SEXP cvPost_(SEXP nuS, SEXP omegaS, SEXP nS, SEXP omegaIsCholS, if (omega.hasAttribute("format")) { format = omega.attr("format"); } - 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){ diff --git a/src/init.c b/src/init.c index ca035cdfa..47474df95 100644 --- a/src/init.c +++ b/src/init.c @@ -280,6 +280,7 @@ 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 (*rxSolveFreeSexp_t)(void); extern void setZeroMatrix(int which); extern rx_solve rx_global; extern rx_solving_options op_global; @@ -356,11 +357,11 @@ SEXP _rxode2_getClassicEvid(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP _rxode2_rxQs(SEXP); -SEXP iniLotriPtr(SEXP ptr, SEXP matCls); +SEXP iniLotriPtr(SEXP ptr); void R_init_rxode2(DllInfo *info){ R_CallMethodDef callMethods[] = { - {"_iniLotriPtr", (DL_FUNC) &iniLotriPtr, 2}, + {"_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},