add popedPostSolveMat() for use in script

NAMESPACE

@@ -175,6 +175,7 @@ export(popedGetMultipleEndpointModelingTimes)
 export(popedMultipleEndpointIndexDataFrame)
 export(popedMultipleEndpointParam)
 export(popedMultipleEndpointResetTimeIndex)
+export(popedPostSolveMat)
 export(rxModelVars)
 export(rxToMonolix)
 export(rxToNonmem)

R/RcppExports.R

@@ -149,6 +149,53 @@ popedSetup <- function(e, full) {
     .Call(`_babelmixr2_popedSetup`, e, full)
 }
 
+#' @title Get Solved f based on matched solving times
+#' @description
+#'
+#' This function takes the solved matrix and matches it to the order
+#'   of the input times and model_switch from `PopED`.  It assumes
+#'   the global time indexer has been setup with something like
+#'   `babelmixr2::popedMultipleEndpointParam()`
+#'
+#'
+#'
+#' @param matMT This is the solved matrix that with the following columns (in order):
+#'
+#' - `time`
+#'
+#' - For each endpoint it needs the following (repeated for each endpoint):
+#'
+#'   - endpoint prediction (f)
+#'   - endpoint prediction variance (w)
+#'
+#' @param env This is an R environment where the boolean indexes of
+#'   which item is a which modeling switch is saved (as well as the
+#'   last data frame solved created by this method)
+#'
+#' @return A data.frame with the following output items:
+#'
+#' - `t` The time points
+#'
+#' - `ms` The model switch
+#'
+#' - `rx_pred_` The predicted value
+#'
+#' - `w` The variance of the predicted value
+#'
+#' This also has a side effect of saving the data.frame in the
+#' environment as `s` and the boolean indexes of which item is a
+#' which modeling switch is saved in the environment as `we`
+#'
+#' (i.e. env$we[[1]] is a boolean vector of which items are model switch 1,
+#' env$we[[2]] is a boolean vector of which items are model switch 2, etc.)
+#'
+#' @keywords internal
+#'
+#' @export
+popedPostSolveMat <- function(matMT, env) {
+    .Call(`_babelmixr2_popedPostSolveMat`, matMT, env)
+}
+
 popedSolveIdME <- function(theta, id) {
     .Call(`_babelmixr2_popedSolveIdME`, theta, id)
 }

src/RcppExports.cpp

@@ -105,6 +105,18 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// popedPostSolveMat
+Rcpp::DataFrame popedPostSolveMat(Rcpp::NumericMatrix& matMT, Rcpp::Environment& env);
+RcppExport SEXP _babelmixr2_popedPostSolveMat(SEXP matMTSEXP, SEXP envSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< Rcpp::NumericMatrix& >::type matMT(matMTSEXP);
+    Rcpp::traits::input_parameter< Rcpp::Environment& >::type env(envSEXP);
+    rcpp_result_gen = Rcpp::wrap(popedPostSolveMat(matMT, env));
+    return rcpp_result_gen;
+END_RCPP
+}
 // popedSolveIdME
 Rcpp::DataFrame popedSolveIdME(NumericVector& theta, int id);
 RcppExport SEXP _babelmixr2_popedSolveIdME(SEXP thetaSEXP, SEXP idSEXP) {

src/init.c

@@ -20,8 +20,10 @@ SEXP _babelmixr2_popedGetMultipleEndpointModelingTimes(SEXP, SEXP, SEXP);
 SEXP _babelmixr2_popedMultipleEndpointResetTimeIndex(void);
 SEXP _babelmixr2_popedMultipleEndpointIndexDataFrame(SEXP);
 SEXP _babelmixr2_popedMultipleEndpointParam(SEXP, SEXP, SEXP, SEXP, SEXP);
+SEXP _babelmixr2_popedPostSolveMat(SEXP, SEXP);
 
 static const R_CallMethodDef CallEntries[] = {
+  {"_babelmixr2_popedPostSolveMat", (DL_FUNC) &_babelmixr2_popedPostSolveMat, 2},
   {"_babelmixr2_popedMultipleEndpointParam",
    (DL_FUNC) &_babelmixr2_popedMultipleEndpointParam, 5},
   {"_babelmixr2_popedMultipleEndpointIndexDataFrame", (DL_FUNC) &_babelmixr2_popedMultipleEndpointIndexDataFrame, 1},

src/poped.cpp

@@ -490,16 +490,15 @@ void popedSolveFidMat(arma::mat &matMT, NumericVector &theta, int id, int nrow,
   }
 }
 
-//[[Rcpp::export]]
-Rcpp::DataFrame popedSolveIdME(NumericVector &theta, int id) {
-  if (solveCached(theta, id)) return(as<Rcpp::DataFrame>(_popedE["s"]));
-  size_t totn = globalTimeIndexer.getTimes().size();
+Rcpp::DataFrame popedPostSolveMat(arma::mat& matMT, Rcpp::Environment& env) {
+  if (!globalTimeIndexer.isInitialized()) {
+     Rcpp::stop("time indexer has not been initialized");
+  }
+  size_t nrow = globalTimeIndexer.getUniqueTimes().size();//umt.size();
   size_t nend = globalTimeIndexer.getNid();
-  NumericVector t(totn);
+  size_t totn = globalTimeIndexer.getTimes().size();
   arma::vec f(totn);
   arma::vec w(totn);
-  size_t nrow = globalTimeIndexer.getUniqueTimes().size();//umt.size();
-  arma::mat matMT(nrow, nend*2+1);
   List we(nend);
   for (int i = 0; i < nend; i++) {
     LogicalVector curLV = LogicalVector(totn);
@@ -508,7 +507,7 @@ Rcpp::DataFrame popedSolveIdME(NumericVector &theta, int id) {
     we[i] = curLV;
   }
 
-  popedSolveFidMat(matMT, theta, id, nrow, nend);
+
   // this gets the information from:
   // - the model time
   // - the model_switch
@@ -545,12 +544,72 @@ Rcpp::DataFrame popedSolveIdME(NumericVector &theta, int id) {
                                     Rcpp::wrap(globalTimeIndexer.getModelSwitch()),
                                     _["rx_pred_"]=f, // match rxode2/nlmixr2 to simplify code of mtime models
                                     _["w"]=w); // w = sqrt(rx_r_)
-  _popedE["s"] = ret;
-  _popedE["we"] = we;
+  env["s"] = ret;
+  env["we"] = we;
   return ret;
 }
 
 
+//' @title Get Solved f based on matched solving times
+//' @description
+//'
+//' This function takes the solved matrix and matches it to the order
+//'   of the input times and model_switch from `PopED`.  It assumes
+//'   the global time indexer has been setup with something like
+//'   `babelmixr2::popedMultipleEndpointParam()`
+//'
+//'
+//'
+//' @param matMT This is the solved matrix that with the following columns (in order):
+//'
+//' - `time`
+//'
+//' - For each endpoint it needs the following (repeated for each endpoint):
+//'
+//'   - endpoint prediction (f)
+//'   - endpoint prediction variance (w)
+//'
+//' @param env This is an R environment where the boolean indexes of
+//'   which item is a which modeling switch is saved (as well as the
+//'   last data frame solved created by this method)
+//'
+//' @return A data.frame with the following output items:
+//'
+//' - `t` The time points
+//'
+//' - `ms` The model switch
+//'
+//' - `rx_pred_` The predicted value
+//'
+//' - `w` The variance of the predicted value
+//'
+//' This also has a side effect of saving the data.frame in the
+//' environment as `s` and the boolean indexes of which item is a
+//' which modeling switch is saved in the environment as `we`
+//'
+//' (i.e. env$we[[1]] is a boolean vector of which items are model switch 1,
+//' env$we[[2]] is a boolean vector of which items are model switch 2, etc.)
+//'
+//' @keywords internal
+//'
+//' @export
+//[[Rcpp::export]]
+Rcpp::DataFrame popedPostSolveMat(Rcpp::NumericMatrix& matMT, Rcpp::Environment& env) {
+  arma::mat matMT2 = as<arma::mat>(matMT);
+  return popedPostSolveMat(matMT2, env);
+}
+
+//[[Rcpp::export]]
+Rcpp::DataFrame popedSolveIdME(NumericVector &theta, int id) {
+  if (solveCached(theta, id)) return(as<Rcpp::DataFrame>(_popedE["s"]));
+  size_t nrow = globalTimeIndexer.getUniqueTimes().size();//umt.size();
+  size_t nend = globalTimeIndexer.getNid();
+  arma::mat matMT(nrow, nend*2+1);
+  popedSolveFidMat(matMT, theta, id, nrow, nend);
+  return popedPostSolveMat(matMT, _popedE);
+}
+
+
 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);