Flex stacking

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rxode2et
 Title: Event Table Functions for 'rxode2'
-Version: 2.0.10.9000
+Version: 2.0.11
 Authors@R: c(
     person("Matthew L.", "Fidler", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-8538-6691")),
@@ -42,7 +42,7 @@ Suggests:
     nlmixr2data,
     qs
 LinkingTo:
-    rxode2random,   
+    rxode2random,
     rxode2parse,
     Rcpp
 Biarch: true

NAMESPACE

@@ -65,6 +65,7 @@ export(etSeq)
 export(eventTable)
 export(forderForceBase)
 export(is.rxEt)
+export(is.rxStackData)
 export(lotri)
 export(rxCbindStudyIndividual)
 export(rxEtDispatchSolve)

NEWS.md

@@ -1,4 +1,8 @@
-# rxode2et (development version)
+# rxode2et 2.0.11
+
+* Make the stacking more flexible to help rxode2 have more types of plots
+
+* Add `toTrialDuration` by Omar Elashkar to convert event data to trial duration data
 
 # rxode2et 2.0.10
 

R/RcppExports.R

@@ -44,3 +44,7 @@ rxStack_ <- function(Data, vars = NULL) {
     .Call(`_rxode2et_rxStack_`, Data, vars)
 }
 
+rxModelVarsStack <- function(x) {
+    .Call(`_rxode2et_rxModelVarsStack`, x)
+}
+

R/rxStack.R

@@ -1,3 +1,21 @@
+#' Return if the object can be stacked
+#'
+#' @param object object to test if it can be stacked
+#' @return boolean to tell if an object can be stacked using rxode2
+#' @export
+#' @author Matthew L. Fidler
+#' @examples
+#'
+#' is.rxStackData(NULL)
+is.rxStackData <- function(object) {
+  if (!inherits(object, "data.frame")) return(FALSE)
+  .mv <- try(.Call(`_rxode2et_rxModelVarsStack`, object), silent=TRUE)
+  if (!inherits(.mv, "rxModelVars")) return(FALSE)
+  .mv <- try(object$rxModelVars, silent=TRUE)
+  if (!inherits(.mv, "rxModelVars")) return(FALSE)
+  TRUE
+}
+
 #' Stack a solved object for things like default ggplot2 plot
 #'
 #' @param data is a rxode2 object to be stacked.
@@ -24,11 +42,11 @@
 #'
 #' @return Stacked data with \code{value} and \code{trt}, where value is the values
 #'   and \code{trt} is the state and \code{lhs} variables.
-#' 
+#'
 #' @author Matthew Fidler
 #' @export
 rxStack <- function(data, vars = NULL, doSim=TRUE) {
-  checkmate::assertClass(data, "rxSolve")
+  if (!is.rxStackData(data)) stop("this data cannot be used with `rxStack`", call.=FALSE)
   .nd <- names(data)
   checkmate::assertCharacter(vars, pattern="^[.]*[a-zA-Z]+[a-zA-Z0-9._]*$", null.ok=TRUE)
   if (doSim) {
@@ -74,7 +92,7 @@ rxStack <- function(data, vars = NULL, doSim=TRUE) {
       if (length(.vars) > 0L) {
         .ret <- .ret[.ret$trt %in% .vars,]
       }
-      return(.ret)      
+      return(.ret)
     }
   }
   rxStack_(data, vars)

src/RcppExports.cpp

@@ -108,3 +108,14 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// rxModelVarsStack
+RObject rxModelVarsStack(RObject x);
+RcppExport SEXP _rxode2et_rxModelVarsStack(SEXP xSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< RObject >::type x(xSEXP);
+    rcpp_result_gen = Rcpp::wrap(rxModelVarsStack(x));
+    return rcpp_result_gen;
+END_RCPP
+}

src/init.c

@@ -36,8 +36,11 @@ SEXP _rxode2et_rxStack_(SEXP Data, SEXP vars);
 SEXP _rxode2et_rxCbindStudyIndividual(SEXP inputParameters, SEXP individualParameters);
 SEXP _rxode2et_cbindThetaOmega(SEXP inputParameters, SEXP individualParameters);
 
+SEXP _rxode2et_rxModelVarsStack(SEXP);
+
 void R_init_rxode2et(DllInfo *info){
   R_CallMethodDef callMethods[]  = {
+    {"_rxode2et_rxModelVarsStack", (DL_FUNC) &_rxode2et_rxModelVarsStack, 1},
     {"_rxode2et_cbindThetaOmega", (DL_FUNC) &_rxode2et_cbindThetaOmega, 2},
     {"_rxode2et_rxCbindStudyIndividual", (DL_FUNC) &_rxode2et_rxCbindStudyIndividual, 2},
     {"_rxode2et_rxStack_", (DL_FUNC) &_rxode2et_rxStack_, 2},
@@ -53,7 +56,7 @@ void R_init_rxode2et(DllInfo *info){
     {"_rxode2et_etDollarNames", (DL_FUNC) &_rxode2et_etDollarNames, 1},
     {"_rxode2et_et_", (DL_FUNC) &_rxode2et_et_, 2},
     {"_rxode2et_etUpdate", (DL_FUNC) &_rxode2et_etUpdate, 4},
-    {NULL, NULL, 0} 
+    {NULL, NULL, 0}
   };
   // C callable to assign environments.
   // log likelihoods used in calculations

src/rxStack.cpp

@@ -66,7 +66,7 @@ List rxStack_(List Data, Nullable<CharacterVector> vars=R_NilValue){
   bool bAmt=Data.containsElementNamed("amt");
   if (bAmt) ncols++;
   List ret;
-  
+
   IntegerVector inSimId;
   IntegerVector outSimId;
   if (bSimId){
@@ -161,3 +161,12 @@ List rxStack_(List Data, Nullable<CharacterVector> vars=R_NilValue){
   ret.attr("row.names") = IntegerVector::create(NA_INTEGER, -inTime.size()*nfactor);
   return ret;
 }
+
+
+Function getRxFn(std::string name, const char* err);
+
+//[[Rcpp::export]]
+RObject rxModelVarsStack(RObject x) {
+  Function fn = getRxFn("rxModelVars", "need 'rxode2' loaded for 'is.rxStackData'");
+  return fn(x);
+}