Merge pull request #748 from nlmixr2/743-length-of-parameters-in-icov…

…-affects-speed-of-rxsolve

iCov is now treated in etTrans

NEWS.md

@@ -4,6 +4,11 @@
 
 - Error when specifying `wd` without `modName`
 
+## Possible breaking changes (though unlikely)
+
+- `iCov` is no longer merged to the event dataset.  This makes solving
+  with `iCov` slightly faster (#743)
+
 ## New features
 
 - Empty arguments to `rxRename()` give a warning (#688)

R/RcppExports.R

@@ -187,13 +187,15 @@ etTransEvidIsObs <- function(isObsSexp) {
 #'   steady concentration at the actual time of dose, otherwise when
 #'   `FALSE` the doses are shifted
 #'
+#' @inheritParams rxSolve::rxSolve
+#'
 #' @return Object for solving in rxode2
 #'
 #' @keywords internal
 #'
 #' @export
-etTrans <- function(inData, obj, addCmt = FALSE, dropUnits = FALSE, allTimeVar = FALSE, keepDosingOnly = FALSE, combineDvid = NULL, keep = character(0), addlKeepsCov = FALSE, addlDropSs = TRUE, ssAtDoseTime = TRUE) {
-    .Call(`_rxode2_etTrans`, inData, obj, addCmt, dropUnits, allTimeVar, keepDosingOnly, combineDvid, keep, addlKeepsCov, addlDropSs, ssAtDoseTime)
+etTrans <- function(inData, obj, addCmt = FALSE, dropUnits = FALSE, allTimeVar = FALSE, keepDosingOnly = FALSE, combineDvid = NULL, keep = character(0), addlKeepsCov = FALSE, addlDropSs = TRUE, ssAtDoseTime = TRUE, iCov = NULL) {
+    .Call(`_rxode2_etTrans`, inData, obj, addCmt, dropUnits, allTimeVar, keepDosingOnly, combineDvid, keep, addlKeepsCov, addlDropSs, ssAtDoseTime, iCov)
 }
 
 rxEtTransAsDataFrame_ <- function(inData1) {

R/etTran.R

@@ -1,6 +1,27 @@
 .isIntegerish <- function(v) {
   checkmate::testIntegerish(v)
 }
+#' This gives the iCov index when generating keep from iCov
+#'
+#'
+#' @param fullData Full data index information
+#'
+#'  This dataset has an "id" from the input event table and idx0 a
+#'  0-based index of the full dataset
+#'
+#' @param iCovData This dataset has an "id" from the input `iCov`
+#'   dataset and "idxi" which is a zero based `iCov` index
+#'
+#' @return An C-based index of where each item from the `iCov`
+#'   data-frame to create the keep data-est as if the `iCov` came from
+#'   the first dataset
+#' @author Matthew L. Fidler
+#' @noRd
+.getIcovIdx <- function(fullData, iCovData) {
+  .m <- merge(fullData, iCovData, by="id", all.x=TRUE)
+  .m <- .m[order(.m$idx0),]
+  .m$idxi
+}
 
 .DTEnv <- NULL
 .getDTEnv <- function() {

R/rxsolve.R

@@ -216,7 +216,8 @@
 #'   are the same components as `linDiff`
 #'
 #' @param iCov A data frame of individual non-time varying covariates
-#'     to combine with the `events` dataset by merge.
+#'   to combine with the `events` dataset.  The `iCov` dataset has one
+#'   covariate per ID and should match the event table
 #'
 #' @param covsInterpolation specifies the interpolation method for
 #'     time-varying covariates. When solving ODEs it often samples
@@ -1640,14 +1641,14 @@ rxSolve.default <- function(object, params = NULL, events = NULL, inits = NULL,
         stop("iCov has duplicate IDs, cannot continue")
       }
       names(.ctl$iCov)[.icovId] <- .by
-      .lEvents <- length(.events[, 1])
-      .events <- merge(.events, .ctl$iCov, by = .by)
-      if (.lEvents != length(.events[, 1])) {
-        warning("combining iCov and events dropped some event information")
-      }
-      if (length(unique(.events[[.by]])) != length(.ctl$iCov[, 1])) {
-        warning("combining iCov and events dropped some iCov information")
-      }
+      ## .lEvents <- length(.events[, 1])
+      ## .events <- merge(.events, .ctl$iCov, by = .by)
+      ## if (.lEvents != length(.events[, 1])) {
+      ##   warning("combining iCov and events dropped some event information")
+      ## }
+      ## if (length(unique(.events[[.by]])) != length(.ctl$iCov[, 1])) {
+      ##   warning("combining iCov and events dropped some iCov information")
+      ## }
       if (.useEvents) {
         events <- .events
       } else {

src/RcppExports.cpp

@@ -285,8 +285,8 @@ BEGIN_RCPP
 END_RCPP
 }
 // etTrans
-List etTrans(List inData, const RObject& obj, bool addCmt, bool dropUnits, bool allTimeVar, bool keepDosingOnly, Nullable<LogicalVector> combineDvid, CharacterVector keep, bool addlKeepsCov, bool addlDropSs, bool ssAtDoseTime);
-RcppExport SEXP _rxode2_etTrans(SEXP inDataSEXP, SEXP objSEXP, SEXP addCmtSEXP, SEXP dropUnitsSEXP, SEXP allTimeVarSEXP, SEXP keepDosingOnlySEXP, SEXP combineDvidSEXP, SEXP keepSEXP, SEXP addlKeepsCovSEXP, SEXP addlDropSsSEXP, SEXP ssAtDoseTimeSEXP) {
+List etTrans(List inData, const RObject& obj, bool addCmt, bool dropUnits, bool allTimeVar, bool keepDosingOnly, Nullable<LogicalVector> combineDvid, CharacterVector keep, bool addlKeepsCov, bool addlDropSs, bool ssAtDoseTime, Nullable<List> iCov);
+RcppExport SEXP _rxode2_etTrans(SEXP inDataSEXP, SEXP objSEXP, SEXP addCmtSEXP, SEXP dropUnitsSEXP, SEXP allTimeVarSEXP, SEXP keepDosingOnlySEXP, SEXP combineDvidSEXP, SEXP keepSEXP, SEXP addlKeepsCovSEXP, SEXP addlDropSsSEXP, SEXP ssAtDoseTimeSEXP, SEXP iCovSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
@@ -301,7 +301,8 @@ BEGIN_RCPP
     Rcpp::traits::input_parameter< bool >::type addlKeepsCov(addlKeepsCovSEXP);
     Rcpp::traits::input_parameter< bool >::type addlDropSs(addlDropSsSEXP);
     Rcpp::traits::input_parameter< bool >::type ssAtDoseTime(ssAtDoseTimeSEXP);
-    rcpp_result_gen = Rcpp::wrap(etTrans(inData, obj, addCmt, dropUnits, allTimeVar, keepDosingOnly, combineDvid, keep, addlKeepsCov, addlDropSs, ssAtDoseTime));
+    Rcpp::traits::input_parameter< Nullable<List> >::type iCov(iCovSEXP);
+    rcpp_result_gen = Rcpp::wrap(etTrans(inData, obj, addCmt, dropUnits, allTimeVar, keepDosingOnly, combineDvid, keep, addlKeepsCov, addlDropSs, ssAtDoseTime, iCov));
     return rcpp_result_gen;
 END_RCPP
 }

src/cvPost.cpp

@@ -35,7 +35,8 @@ List etTrans(List inData, const RObject &mv, bool addCmt,
              CharacterVector keep,
              bool addlKeepsCov,
              bool addlDropSs,
-             bool ssAtDoseTime);
+             bool ssAtDoseTime,
+             Nullable<List> iCovIn);
 SEXP nestingInfo_(SEXP omega, List data);
 
 List rxExpandNesting(const RObject& obj, List& nestingInfo,
@@ -831,7 +832,8 @@ SEXP expandPars_(SEXP objectS, SEXP paramsS, SEXP eventsS, SEXP controlS) {
                                control[Rxc_keepF],
                                control[Rxc_addlKeepsCov],
                                control[Rxc_addlDropSs],
-                               control[Rxc_ssAtDoseTime])); pro++;
+                               control[Rxc_ssAtDoseTime],
+                               control[Rxc_iCov])); pro++;
       rxModelsAssign(".nestEvents", events);
       RObject cls = Rf_getAttrib(events, R_ClassSymbol);
       List rxLst = cls.attr(".rxode2.lst");
@@ -1013,7 +1015,8 @@ SEXP expandPars_(SEXP objectS, SEXP paramsS, SEXP eventsS, SEXP controlS) {
                                control[Rxc_keepF],
                                control[Rxc_addlKeepsCov],
                                control[Rxc_addlDropSs],
-                               control[Rxc_ssAtDoseTime])); pro++;
+                               control[Rxc_ssAtDoseTime],
+                               control[Rxc_iCov])); pro++;
       rxModelsAssign(".nestEvents", events);
     } else if (!Rf_inherits(events, "rxEtTrans")){
       events = PROTECT(etTrans(as<List>(events), nestObj,
@@ -1022,7 +1025,8 @@ SEXP expandPars_(SEXP objectS, SEXP paramsS, SEXP eventsS, SEXP controlS) {
                                control[Rxc_keepF],
                                control[Rxc_addlKeepsCov],
                                control[Rxc_addlDropSs],
-                               control[Rxc_ssAtDoseTime])); pro++;
+                               control[Rxc_ssAtDoseTime],
+                               control[Rxc_iCov])); pro++;
       rxModelsAssign(".nestEvents", events);
     }
     int nobs =  Rf_length(VECTOR_ELT(events, 0));