From 822f1da237acdeb68b97c5d5bb2c6f170d5e68fb Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Thu, 5 Oct 2023 22:30:44 -0500 Subject: [PATCH 1/5] Be more flexible with stacking --- NAMESPACE | 1 + R/rxStack.R | 24 +++++++++++++++++++++--- man/is.rxStackData.Rd | 24 ++++++++++++++++++++++++ 3 files changed, 46 insertions(+), 3 deletions(-) create mode 100644 man/is.rxStackData.Rd diff --git a/NAMESPACE b/NAMESPACE index 5be6751..ce22f0b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -65,6 +65,7 @@ export(etSeq) export(eventTable) export(forderForceBase) export(is.rxEt) +export(is.rxStackData) export(lotri) export(rxCbindStudyIndividual) export(rxEtDispatchSolve) diff --git a/R/rxStack.R b/R/rxStack.R index 510a1f8..bddebf0 100644 --- a/R/rxStack.R +++ b/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(data) { + if (!inherits(data, "data.frame")) return(FALSE) + .mv <- try(rxModelVars(data), silent=TRUE) + if (!inherits(.mv, "rxModelVars")) return(FALSE) + .mv <- try(data$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) diff --git a/man/is.rxStackData.Rd b/man/is.rxStackData.Rd new file mode 100644 index 0000000..2e8e647 --- /dev/null +++ b/man/is.rxStackData.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rxStack.R +\name{is.rxStackData} +\alias{is.rxStackData} +\title{Return if the object can be stacked} +\usage{ +is.rxStackData(data) +} +\arguments{ +\item{object}{object to test if it can be stacked} +} +\value{ +boolean to tell if an object can be stacked using rxode2 +} +\description{ +Return if the object can be stacked +} +\examples{ + +is.rxStackData(NULL) +} +\author{ +Matthew L. Fidler +} From c6a47e061c55b97ee1a11e926d8ad3afa9d9627f Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Thu, 5 Oct 2023 22:33:44 -0500 Subject: [PATCH 2/5] Fix stack data --- R/rxStack.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/rxStack.R b/R/rxStack.R index bddebf0..02b930a 100644 --- a/R/rxStack.R +++ b/R/rxStack.R @@ -46,7 +46,7 @@ is.rxStackData <- function(data) { #' @author Matthew Fidler #' @export rxStack <- function(data, vars = NULL, doSim=TRUE) { - if (is.rxStackData(data)) stop("this data cannot be used with `rxStack`", call.=FALSE) + 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) { From 6cc17b1af81961e349b437fc7e7ebec3e5d27292 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Wed, 29 Nov 2023 12:12:25 -0600 Subject: [PATCH 3/5] Add work-around for upstream rxModelVars --- DESCRIPTION | 4 ++-- R/RcppExports.R | 4 ++++ R/rxStack.R | 2 +- src/RcppExports.cpp | 11 +++++++++++ src/init.c | 5 ++++- src/rxStack.cpp | 11 ++++++++++- 6 files changed, 32 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2648868..2af1642 100644 --- a/DESCRIPTION +++ b/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", , "matthew.fidler@gmail.com", 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 diff --git a/R/RcppExports.R b/R/RcppExports.R index 4ce189e..10f3513 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -44,3 +44,7 @@ rxStack_ <- function(Data, vars = NULL) { .Call(`_rxode2et_rxStack_`, Data, vars) } +rxModelVarsStack <- function(x) { + .Call(`_rxode2et_rxModelVarsStack`, x) +} + diff --git a/R/rxStack.R b/R/rxStack.R index 02b930a..5ab11d1 100644 --- a/R/rxStack.R +++ b/R/rxStack.R @@ -9,7 +9,7 @@ #' is.rxStackData(NULL) is.rxStackData <- function(data) { if (!inherits(data, "data.frame")) return(FALSE) - .mv <- try(rxModelVars(data), silent=TRUE) + .mv <- try(.Call(`_rxode2et_rxModelVarsStack`, data), silent=TRUE) if (!inherits(.mv, "rxModelVars")) return(FALSE) .mv <- try(data$rxModelVars, silent=TRUE) if (!inherits(.mv, "rxModelVars")) return(FALSE) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index b003c4b..5840ea3 100644 --- a/src/RcppExports.cpp +++ b/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 +} diff --git a/src/init.c b/src/init.c index 0c510bc..f19a6d0 100644 --- a/src/init.c +++ b/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 diff --git a/src/rxStack.cpp b/src/rxStack.cpp index 8ee8be4..63f28d5 100644 --- a/src/rxStack.cpp +++ b/src/rxStack.cpp @@ -66,7 +66,7 @@ List rxStack_(List Data, Nullable 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 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); +} From 5dd1a2763117d4385889339813d2a3582ec62072 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Wed, 29 Nov 2023 12:14:26 -0600 Subject: [PATCH 4/5] ::doc() fixes --- R/rxStack.R | 8 ++++---- man/is.rxStackData.Rd | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/rxStack.R b/R/rxStack.R index 5ab11d1..4f4617e 100644 --- a/R/rxStack.R +++ b/R/rxStack.R @@ -7,11 +7,11 @@ #' @examples #' #' is.rxStackData(NULL) -is.rxStackData <- function(data) { - if (!inherits(data, "data.frame")) return(FALSE) - .mv <- try(.Call(`_rxode2et_rxModelVarsStack`, data), silent=TRUE) +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(data$rxModelVars, silent=TRUE) + .mv <- try(object$rxModelVars, silent=TRUE) if (!inherits(.mv, "rxModelVars")) return(FALSE) TRUE } diff --git a/man/is.rxStackData.Rd b/man/is.rxStackData.Rd index 2e8e647..7e16f5d 100644 --- a/man/is.rxStackData.Rd +++ b/man/is.rxStackData.Rd @@ -4,7 +4,7 @@ \alias{is.rxStackData} \title{Return if the object can be stacked} \usage{ -is.rxStackData(data) +is.rxStackData(object) } \arguments{ \item{object}{object to test if it can be stacked} From a5c157b6305d3eb8ac615eb8c58ce92398b17904 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Wed, 29 Nov 2023 12:35:04 -0600 Subject: [PATCH 5/5] Update news --- NEWS.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index cbcbcef..f6fb00b 100644 --- a/NEWS.md +++ b/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