From c7007dbe867d87c9ae2fd84feb7177422fa2a3b7 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Tue, 3 Oct 2023 15:02:13 -0500 Subject: [PATCH 1/6] Add binomProbs for a drop-in replacement for quantile --- NAMESPACE | 2 + R/RcppExports.R | 8 ++- R/utils.R | 98 ++++++++++++++++++++++++++++--- inst/include/rxode2_RcppExports.h | 29 +++++++-- man/binomProbs.Rd | 70 ++++++++++++++++++++++ man/meanProbs.Rd | 44 +++++++++++--- man/rxode2.Rd | 4 +- src/RcppExports.cpp | 51 ++++++++++++++-- src/init.c | 14 +++-- src/utilcpp.cpp | 95 +++++++++++++++++++++++++++++- 10 files changed, 375 insertions(+), 40 deletions(-) create mode 100644 man/binomProbs.Rd diff --git a/NAMESPACE b/NAMESPACE index a56557c2d..06bd81d78 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,6 +41,7 @@ S3method(as.rxUi,rxModelVars) S3method(as.rxUi,rxUi) S3method(as.rxUi,rxode2) S3method(as.rxUi,rxode2tos) +S3method(binomProbs,default) S3method(coef,rxode2) S3method(confint,rxSolve) S3method(dimnames,rxSolve) @@ -246,6 +247,7 @@ export(assertRxUiPrediction) export(assertRxUiRandomOnIdOnly) export(assertRxUiSingleEndpoint) export(assertRxUiTransformNormal) +export(binomProbs) export(cvPost) export(erf) export(et) diff --git a/R/RcppExports.R b/R/RcppExports.R index 30cc3e92f..e10f937d5 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -589,7 +589,11 @@ rxErf <- function(v) { .Call(`_rxode2_rxErf`, v) } -meanProbs_ <- function(x, probs, naRm, useT) { - .Call(`_rxode2_meanProbs_`, x, probs, naRm, useT) +binomProbs_ <- function(x, probs, naRm) { + .Call(`_rxode2_binomProbs_`, x, probs, naRm) +} + +meanProbs_ <- function(x, probs, naRm, useT, useBinom) { + .Call(`_rxode2_meanProbs_`, x, probs, naRm, useT, useBinom) } diff --git a/R/utils.R b/R/utils.R index b7694a96c..bcc64268c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -747,7 +747,7 @@ is.latex <- function() { ret } #' Print out a table in the documentation -#' +#' #' @param table data frame #' @param caption a character vector representing the caption for the latex table #' @return based on the `knitr` context: @@ -755,7 +755,7 @@ is.latex <- function() { #' - output a `DT::datatable` for html output #' - otherwise output a `knitr::kable` #' @keywords internal -#' @export +#' @export #' @author Matthew L. Fidler #' @examples #' .rxDocTable(rxReservedKeywords) @@ -773,11 +773,12 @@ is.latex <- function() { } } -#' Calculate expected quantiles with normal or t sampling distribution +#' Calculate expected confidence bands with normal or t sampling distribution #' -#' The generic function `meanProbs` produces expected quantiles under -#' either the t distribution or the normal sampling distribution. This -#' uses `qnorm()` or `qt()` with the mean and standard deviation. +#' The generic function `meanProbs` produces expected confidence bands +#' under either the t distribution or the normal sampling +#' distribution. This uses `qnorm()` or `qt()` with the mean and +#' standard deviation. #' #' For a single probability, p, it uses either: #' @@ -796,7 +797,7 @@ is.latex <- function() { #' This is meant to perform in the same way as `quantile()` so it can #' be a drop in replacement for code using `quantile()` but using #' distributional assumptions. -#' +#' #' @param x numeric vector whose mean and probability based confidence #' values are wanted, NA and NaN values are not allowed in numeric #' vectors unless ‘na.rm’ is ‘TRUE’. @@ -831,9 +832,9 @@ is.latex <- function() { #' quantile(x<- rnorm(42)) #' #' meanProbs(x) -#' +#' #' meanProbs(x, useT=FALSE) -#' +#' meanProbs <- function(x, ...) { UseMethod("meanProbs") } @@ -864,3 +865,82 @@ meanProbs.default <- function(x, probs=seq(0, 1, 0.25), na.rm=FALSE, .ret } +#' Calculate expected confidence bands with binomial sampling distribution +#' +#' The generic function `binomProbs` produces expected confidence bands +#' using the +#' +#' This is meant to perform in the same way as `quantile()` so it can +#' be a drop in replacement for code using `quantile()` but using +#' distributional assumptions. +#' +#' It is used for confidence intervals with rxode2 solved objects using +#' `confint(mean="prob")` or `confint(mean="binom") +#' +#' @param x numeric vector whose mean and probability based confidence +#' values are wanted, NA and NaN values are not allowed in numeric +#' vectors unless ‘na.rm’ is ‘TRUE’. +#' @param probs numeric vector of probabilities with values in +#' [0,1]. When 0, it represents the maximum observed, when 1, it +#' represents the maximum observed. When 0.5 it represents the +#' expected probability (mean) +#' @param na.rm logical; if true, any NA and NaN's are removed from +#' `x` before the quantiles are computed. +#' @param names logical; if true, the result has a names attribute. +#' @param onlyProbs logical; if true, only return the probability +#' based confidence interval estimates, otherwise return +#' @return By default the return has the probabilities as names (if +#' named) with the points where the expected distribution are +#' located given the sampling mean and standard deviation. If +#' `onlyProbs=FALSE` then it would prepend mean, variance, standard +#' deviation, minimum, maximum and number of non-NA observations. +#' @export +#' @author Matthew L. Fidler +#' @references - Newcombe, +#' R. G. (1998). "Two-sided confidence intervals for the single proportion: comparison of seven methods". Statistics +#' in Medicine. 17 (8): +#' 857–872. doi:10.1002/(SICI)1097-0258(19980430)17:8<857::AID-SIM777>3.0.CO;2-E. PMID +#' 9595616. +#' @examples +#' +#' quantile(x<- rbinom(7001, p=0.375, size=1)) +#' binomProbs(x) +#' +#' # Can get some extra statistics if you request onlyProbs=FALSE +#' binomProbs(x, onlyProbs=FALSE) +#' +#' x[2] <- NA_real_ +#' +#' binomProbs(x, onlyProbs=FALSE) +#' +#' binomProbs(x, na.rm=TRUE) +#' +binomProbs <- function(x, ...) { + UseMethod("binomProbs") +} + +#' @rdname binomProbs +#' @export +binomProbs.default <- function(x, probs=c(0.025, 0.05, 0.5, 0.95, 0.975), na.rm=FALSE, + names=TRUE, onlyProbs=TRUE) { + checkmate::assertIntegerish(x, min.len=1, lower=0.0, upper=1.0) + x <- as.double(x) + checkmate::assertNumeric(probs, min.len=1, any.missing = FALSE, lower=0.0, upper=1.0) + checkmate::assertLogical(na.rm, any.missing=FALSE, len=1) + checkmate::assertLogical(names, any.missing=FALSE, len=1) + checkmate::assertLogical(onlyProbs, any.missing=FALSE, len=1) + .ret <- .Call(`_rxode2_binomProbs_`, x, probs, na.rm) + .names <- NULL + if (names) { + .names <- paste0(probs*100, "%") + } + if (onlyProbs) { + .ret <- .ret[-1L:-6L] + if (names) { + names(.ret) <- .names + } + } else if (names) { + names(.ret) <- c("mean","var", "sd", "min", "max", "n", .names) + } + .ret +} diff --git a/inst/include/rxode2_RcppExports.h b/inst/include/rxode2_RcppExports.h index cc821793b..c4495dfd6 100644 --- a/inst/include/rxode2_RcppExports.h +++ b/inst/include/rxode2_RcppExports.h @@ -1073,17 +1073,38 @@ namespace rxode2 { return Rcpp::as(rcpp_result_gen); } - inline NumericVector meanProbs_(NumericVector x, NumericVector probs, bool naRm, bool useT) { - typedef SEXP(*Ptr_meanProbs_)(SEXP,SEXP,SEXP,SEXP); + inline NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { + typedef SEXP(*Ptr_binomProbs_)(SEXP,SEXP,SEXP); + static Ptr_binomProbs_ p_binomProbs_ = NULL; + if (p_binomProbs_ == NULL) { + validateSignature("NumericVector(*binomProbs_)(NumericVector,NumericVector,bool)"); + p_binomProbs_ = (Ptr_binomProbs_)R_GetCCallable("rxode2", "_rxode2_binomProbs_"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_binomProbs_(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(probs)), Shield(Rcpp::wrap(naRm))); + } + if (rcpp_result_gen.inherits("interrupted-error")) + throw Rcpp::internal::InterruptedException(); + if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) + throw Rcpp::LongjumpException(rcpp_result_gen); + if (rcpp_result_gen.inherits("try-error")) + throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); + return Rcpp::as(rcpp_result_gen); + } + + inline NumericVector meanProbs_(NumericVector x, NumericVector probs, bool naRm, bool useT, bool useBinom) { + typedef SEXP(*Ptr_meanProbs_)(SEXP,SEXP,SEXP,SEXP,SEXP); static Ptr_meanProbs_ p_meanProbs_ = NULL; if (p_meanProbs_ == NULL) { - validateSignature("NumericVector(*meanProbs_)(NumericVector,NumericVector,bool,bool)"); + validateSignature("NumericVector(*meanProbs_)(NumericVector,NumericVector,bool,bool,bool)"); p_meanProbs_ = (Ptr_meanProbs_)R_GetCCallable("rxode2", "_rxode2_meanProbs_"); } RObject rcpp_result_gen; { RNGScope RCPP_rngScope_gen; - rcpp_result_gen = p_meanProbs_(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(probs)), Shield(Rcpp::wrap(naRm)), Shield(Rcpp::wrap(useT))); + rcpp_result_gen = p_meanProbs_(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(probs)), Shield(Rcpp::wrap(naRm)), Shield(Rcpp::wrap(useT)), Shield(Rcpp::wrap(useBinom))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); diff --git a/man/binomProbs.Rd b/man/binomProbs.Rd new file mode 100644 index 000000000..823fdcb7b --- /dev/null +++ b/man/binomProbs.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{binomProbs} +\alias{binomProbs} +\alias{binomProbs.default} +\title{Calculate expected confidence bands with binomial sampling distribution} +\usage{ +binomProbs(x, ...) + +\method{binomProbs}{default}(x, ...) +} +\arguments{ +\item{x}{numeric vector whose mean and probability based confidence +values are wanted, NA and NaN values are not allowed in numeric +vectors unless ‘na.rm’ is ‘TRUE’.} + +\item{probs}{numeric vector of probabilities with values in \link{0,1}.} + +\item{na.rm}{logical; if true, any NA and NaN's are removed from +\code{x} before the quantiles are computed.} + +\item{names}{logical; if true, the result has a names attribute.} + +\item{onlyProbs}{logical; if true, only return the probability based +confidence interval estimates, otherwise return} +} +\value{ +By default the return has the probabilities as names (if +named) with the points where the expected distribution are +located given the sampling mean and standard deviation. If +\code{onlyProbs=FALSE} then it would prepend mean, variance, standard +deviation, minimum, maximum and number of non-NA observations. +} +\description{ +The generic function \code{binomProbs} produces expected confidence bands +using the +} +\details{ +The mean, or observed probability is calculated based on Welford's +method for means. + +This is meant to perform in the same way as \code{quantile()} so it can +be a drop in replacement for code using \code{quantile()} but using +distributional assumptions. +} +\examples{ + +quantile(x<- rbinom(1001)) +binomProbs(x) + +# Can get some extra statistics if you request onlyProbs=FALSE +binomProbs(x, onlyProbs=FALSE) + +x[2] <- NA_real_ + +binomProbs(x, onlyProbs=FALSE) + + +} +\references{ +\itemize{ +\item Newcombe, R. G. (1998). "Two-sided confidence intervals for +the single proportion: comparison of seven methods". Statistics +in Medicine. 17 (8): 857–872. doi:10.1002/(SICI)1097-0258(19980430)17:8<857::AID-SIM777>3.0.CO;2-E. PMID +9595616. +} +} +\author{ +Matthew L. Fidler +} diff --git a/man/meanProbs.Rd b/man/meanProbs.Rd index 0dcec476a..c0df7bd63 100644 --- a/man/meanProbs.Rd +++ b/man/meanProbs.Rd @@ -3,7 +3,7 @@ \name{meanProbs} \alias{meanProbs} \alias{meanProbs.default} -\title{Calculate expected quantiles with normal or t sampling distribution} +\title{Calculate expected confidence bands with normal or t sampling distribution} \usage{ meanProbs(x, ...) @@ -13,7 +13,7 @@ meanProbs(x, ...) na.rm = FALSE, names = TRUE, useT = TRUE, - useProbs = FALSE + onlyProbs = TRUE ) } \arguments{ @@ -32,13 +32,21 @@ vectors unless ‘na.rm’ is ‘TRUE’.} the confidence-based estimates. If false use the normal distribution to calculate the confidence based estimates.} -\item{useProbs}{logical; if true, only return the probability -based confidence interval estimates, otherwise return} +\item{onlyProbs}{logical; if true, only return the probability based +confidence interval estimates, otherwise return} +} +\value{ +By default the return has the probabilities as names (if +named) with the points where the expected distribution are +located given the sampling mean and standard deviation. If +\code{onlyProbs=FALSE} then it would prepend mean, variance, standard +deviation, minimum, maximum and number of non-NA observations. } \description{ -The generic function \code{meanProbs} produces expected quantiles under -either the t distribution or the normal sampling distribution. This -uses \code{qnorm()} or \code{qt()} with the mean and standard deviation. +The generic function \code{meanProbs} produces expected confidence bands +under either the t distribution or the normal sampling +distribution. This uses \code{qnorm()} or \code{qt()} with the mean and +standard deviation. } \details{ For a single probability, p, it uses either: @@ -53,11 +61,29 @@ The smallest observation corresponds to a probability of 0 and the largest to a probability of 1 and the mean corresponds to 0.5. The mean and standard deviation of the sample is calculated based -on Welford's method for a single pass +on Welford's method for a single pass. + +This is meant to perform in the same way as \code{quantile()} so it can +be a drop in replacement for code using \code{quantile()} but using +distributional assumptions. } \examples{ -meanProbs(x <- rnorm(1001)) +quantile(x<- rnorm(1001)) +meanProbs(x) + +# Can get some extra statistics if you request onlyProbs=FALSE +meanProbs(x, onlyProbs=FALSE) + +x[2] <- NA_real_ + +meanProbs(x, onlyProbs=FALSE) + +quantile(x<- rnorm(42)) + +meanProbs(x) + +meanProbs(x, useT=FALSE) } \author{ diff --git a/man/rxode2.Rd b/man/rxode2.Rd index 2d8108f38..32a23629e 100644 --- a/man/rxode2.Rd +++ b/man/rxode2.Rd @@ -327,7 +327,7 @@ compilation model. \if{html}{\out{
}}\preformatted{## using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -## rxode2 2.0.13.9000 model named rx_a80a19966fa254e55fa958b934a783f9 model (ready). +## rxode2 2.0.13.9000 model named rx_1d8a358106bc128f5627b9b12d793312 model (ready). ## x$state: depot, center ## x$stateExtra: cp ## x$params: tka, tcl, tv, add.sd, eta.ka, eta.cl, eta.v, rxerr.cp @@ -340,7 +340,7 @@ mod$simulationIniModel \if{html}{\out{
}}\preformatted{## using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -## rxode2 2.0.13.9000 model named rx_efba4df1b26a5a9e54ae25cd8fe7247f model (ready). +## rxode2 2.0.13.9000 model named rx_433cc7bab35ab4f7adadd0c295cccdb3 model (ready). ## x$state: depot, center ## x$stateExtra: cp ## x$params: tka, tcl, tv, add.sd, eta.ka, eta.cl, eta.v, rxerr.cp diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 00a4ac6d5..2b40a16b8 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -1824,24 +1824,61 @@ RcppExport SEXP _rxode2_rxErf(SEXP vSEXP) { UNPROTECT(1); return rcpp_result_gen; } +// binomProbs_ +NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm); +static SEXP _rxode2_binomProbs__try(SEXP xSEXP, SEXP probsSEXP, SEXP naRmSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); + Rcpp::traits::input_parameter< NumericVector >::type probs(probsSEXP); + Rcpp::traits::input_parameter< bool >::type naRm(naRmSEXP); + rcpp_result_gen = Rcpp::wrap(binomProbs_(x, probs, naRm)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _rxode2_binomProbs_(SEXP xSEXP, SEXP probsSEXP, SEXP naRmSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_rxode2_binomProbs__try(xSEXP, probsSEXP, naRmSEXP)); + } + Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); + if (rcpp_isInterrupt_gen) { + UNPROTECT(1); + Rf_onintr(); + } + bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); + if (rcpp_isLongjump_gen) { + Rcpp::internal::resumeJump(rcpp_result_gen); + } + Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); + if (rcpp_isError_gen) { + SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); + UNPROTECT(1); + Rf_error(CHAR(rcpp_msgSEXP_gen)); + } + UNPROTECT(1); + return rcpp_result_gen; +} // meanProbs_ -NumericVector meanProbs_(NumericVector x, NumericVector probs, bool naRm, bool useT); -static SEXP _rxode2_meanProbs__try(SEXP xSEXP, SEXP probsSEXP, SEXP naRmSEXP, SEXP useTSEXP) { +NumericVector meanProbs_(NumericVector x, NumericVector probs, bool naRm, bool useT, bool useBinom); +static SEXP _rxode2_meanProbs__try(SEXP xSEXP, SEXP probsSEXP, SEXP naRmSEXP, SEXP useTSEXP, SEXP useBinomSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); Rcpp::traits::input_parameter< NumericVector >::type probs(probsSEXP); Rcpp::traits::input_parameter< bool >::type naRm(naRmSEXP); Rcpp::traits::input_parameter< bool >::type useT(useTSEXP); - rcpp_result_gen = Rcpp::wrap(meanProbs_(x, probs, naRm, useT)); + Rcpp::traits::input_parameter< bool >::type useBinom(useBinomSEXP); + rcpp_result_gen = Rcpp::wrap(meanProbs_(x, probs, naRm, useT, useBinom)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } -RcppExport SEXP _rxode2_meanProbs_(SEXP xSEXP, SEXP probsSEXP, SEXP naRmSEXP, SEXP useTSEXP) { +RcppExport SEXP _rxode2_meanProbs_(SEXP xSEXP, SEXP probsSEXP, SEXP naRmSEXP, SEXP useTSEXP, SEXP useBinomSEXP) { SEXP rcpp_result_gen; { Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = PROTECT(_rxode2_meanProbs__try(xSEXP, probsSEXP, naRmSEXP, useTSEXP)); + rcpp_result_gen = PROTECT(_rxode2_meanProbs__try(xSEXP, probsSEXP, naRmSEXP, useTSEXP, useBinomSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { @@ -1916,7 +1953,8 @@ static int _rxode2_RcppExport_validate(const char* sig) { signatures.insert("RObject(*rxSymInvCholEnvCalculate)(List,std::string,Nullable)"); signatures.insert("LogicalVector(*isNullZero)(RObject)"); signatures.insert("NumericVector(*rxErf)(NumericVector)"); - signatures.insert("NumericVector(*meanProbs_)(NumericVector,NumericVector,bool,bool)"); + signatures.insert("NumericVector(*binomProbs_)(NumericVector,NumericVector,bool)"); + signatures.insert("NumericVector(*meanProbs_)(NumericVector,NumericVector,bool,bool,bool)"); } return signatures.find(sig) != signatures.end(); } @@ -1973,6 +2011,7 @@ RcppExport SEXP _rxode2_RcppExport_registerCCallable() { R_RegisterCCallable("rxode2", "_rxode2_rxSymInvCholEnvCalculate", (DL_FUNC)_rxode2_rxSymInvCholEnvCalculate_try); R_RegisterCCallable("rxode2", "_rxode2_isNullZero", (DL_FUNC)_rxode2_isNullZero_try); R_RegisterCCallable("rxode2", "_rxode2_rxErf", (DL_FUNC)_rxode2_rxErf_try); + R_RegisterCCallable("rxode2", "_rxode2_binomProbs_", (DL_FUNC)_rxode2_binomProbs__try); R_RegisterCCallable("rxode2", "_rxode2_meanProbs_", (DL_FUNC)_rxode2_meanProbs__try); R_RegisterCCallable("rxode2", "_rxode2_RcppExport_validate", (DL_FUNC)_rxode2_RcppExport_validate); return R_NilValue; diff --git a/src/init.c b/src/init.c index 5ecee8f32..f6ca9af96 100644 --- a/src/init.c +++ b/src/init.c @@ -224,7 +224,7 @@ void _update_par_ptr(double t, unsigned int id, rx_solve *rx, int idx); double _getParCov(unsigned int id, rx_solve *rx, int parNo, int idx); int par_progress(int c, int n, int d, int cores, clock_t t0, int stop); -void ind_solve(rx_solve *rx, unsigned int cid, t_dydt_liblsoda dydt_lls, +void ind_solve(rx_solve *rx, unsigned int cid, t_dydt_liblsoda dydt_lls, t_dydt_lsoda_dum dydt_lsoda, t_jdum_lsoda jdum, t_dydt c_dydt, t_update_inis u_inis, int jt); void par_solve(rx_solve *rx); @@ -283,6 +283,7 @@ SEXP _rxode2_trans(SEXP parse_file, SEXP prefix, SEXP model_md5, SEXP parseStr, SEXP _rxode2_assignSeedInfo(void); SEXP _rxSetSeed(SEXP); SEXP _rxode2_meanProbs_(SEXP x, SEXP probs, SEXP naRm, SEXP useT); +SEXP _rxode2_binomProbs_(SEXP x, SEXP probs, SEXP naRm); typedef SEXP (*lotriMat_type) (SEXP, SEXP, SEXP); typedef SEXP (*asLotriMat_type) (SEXP, SEXP, SEXP); @@ -360,6 +361,7 @@ extern SEXP chin(SEXP x, SEXP table); SEXP _rxode2_RcppExport_registerCCallable(void); void R_init_rxode2(DllInfo *info){ R_CallMethodDef callMethods[] = { + {"_rxode2_binomProbs_", (DL_FUNC) &_rxode2_binomProbs_, 3}, {"_rxode2_meanProbs_", (DL_FUNC) &_rxode2_meanProbs_, 4}, {"_rxode2_getEtRxsolve", (DL_FUNC) &_rxode2_getEtRxsolve, 1}, {"_rxode2_assignSeedInfo", (DL_FUNC) &_rxode2_assignSeedInfo, 0}, @@ -494,14 +496,14 @@ void R_init_rxode2(DllInfo *info){ {"_rxSetSeed", (DL_FUNC) _rxSetSeed, 1}, {"_rxode2_rxordSelect", (DL_FUNC) _rxode2_rxordSelect, 2}, {"_rxode2_rxErf", (DL_FUNC) &_rxode2_rxErf, 1}, - {NULL, NULL, 0} + {NULL, NULL, 0} }; // C callable to assign environments. R_RegisterCCallable("rxode2", "_rxode2_rxModelVars_", (DL_FUNC) &_rxode2_rxModelVars_); R_RegisterCCallable("rxode2", "getSilentErr", (DL_FUNC) &getSilentErr); R_RegisterCCallable("rxode2", "logit", (DL_FUNC) &logit); R_RegisterCCallable("rxode2", "expit", (DL_FUNC) &expit); - + R_RegisterCCallable("rxode2", "powerDi", (DL_FUNC) &powerDi); R_RegisterCCallable("rxode2", "powerD", (DL_FUNC) &powerD); R_RegisterCCallable("rxode2", "powerDD", (DL_FUNC) &powerDD); @@ -516,10 +518,10 @@ void R_init_rxode2(DllInfo *info){ R_RegisterCCallable("rxode2", "_getParCov", (DL_FUNC) &_getParCov); R_RegisterCCallable("rxode2","rxRmModelLib", (DL_FUNC) &rxRmModelLib); R_RegisterCCallable("rxode2","rxGetModelLib", (DL_FUNC) &rxGetModelLib); - + R_RegisterCCallable("rxode2","rxode2_ode_free", (DL_FUNC) &rxode2_ode_free); - - //Functions + + //Functions R_RegisterCCallable("rxode2","rxode2_sum", (DL_FUNC) &rxode2_sum); R_RegisterCCallable("rxode2","rxode2_prod", (DL_FUNC) &rxode2_prod); diff --git a/src/utilcpp.cpp b/src/utilcpp.cpp index af77f7f9c..53aaf5d61 100644 --- a/src/utilcpp.cpp +++ b/src/utilcpp.cpp @@ -15,7 +15,7 @@ using namespace Rcpp; using namespace arma; -extern "C" SEXP _rxode2_isNullZero(SEXP); +extern "C" SEXP _rxode2_isNullZero(SEXP); //[[Rcpp::export]] LogicalVector isNullZero(RObject obj) { @@ -132,7 +132,98 @@ NumericVector rxErf(NumericVector v) { #define max2( a , b ) ( (a) > (b) ? (a) : (b) ) //[[Rcpp::export]] -NumericVector meanProbs_(NumericVector x, NumericVector probs, bool naRm, bool useT) { +NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { + double oldM = 0.0, newM = 0.0, mx=R_NegInf, mn=R_PosInf; + int n = 0; + // Use Newcombe, R. G. (1998). "Two-sided confidence intervals for + // the single proportion: comparison of seven methods". Statistics + // in Medicine. 17 (8): + // 857–872. doi:10.1002/(SICI)1097-0258(19980430)17:8<857::AID-SIM777>3.0.CO;2-E. PMID + // 9595616. + for (int i = 0; i < x.size(); ++i) { + double cur = x[i]; + if (ISNA(cur)) { + if (naRm) { + continue; + } else { + NumericVector ret(6+probs.size()); + for (int j = 0; j < ret.size(); ++j) { + ret[j] = NA_REAL; + } + return ret; + } + } + n++; + mn = min2(cur, mn); + mx = max2(cur, mx); + if (n == 1) { + oldM = newM = cur; + } else { + newM = oldM + (cur - oldM)/n; + oldM = newM; + } + } + + double var=0; + double sd=0; + if (n > 1) { + var = oldM*(1.0-oldM); + sd = sqrt(var); + } else { + var = 0.0; + sd = 0.0; + } + // mean, var, sd, min, max + NumericVector ret(6+probs.size()); + ret[0] = oldM; + ret[1] = var; + ret[2] = sd; + ret[3] = mn; + ret[4] = mx; + ret[5] = (double)n; + + double c = sd/sqrt((double)(n)); + for (int i = 0; i < probs.size(); ++i) { + double p = probs[i]; + std::string str = std::to_string(p*100) + "%"; + if (p == 0) { + ret[i+6] = mn; + } else if (p == 1) { + ret[i+6] = mx; + } else if (p == 0.5) { + ret[i+6] = oldM; + } else { + double z; + if (p > 0.5) { + z = Rf_qnorm5(p, 0.0, 1.0, 1, 0); + } else { + z = Rf_qnorm5(1.0-p, 0.0, 1.0, 1, 0); + } + double z2 = z*z; + double coef1 = 2*n*oldM + z2; + double coef2 = z*sqrt(z2 - 1.0/n + 4*n*var + (4*oldM-2))+1.0; + double coef3 = 2*(n+z2); + if (p < 0.5) { + if (p == 0.0) { + ret[i+6] = 0.0; + } else { + ret[i+6] = max2(0, (coef1-coef2)/coef3); + } + } else { + if (p == 1.0) { + ret[i+6] = 1.0; + } else { + ret[i+6] = min2(1, (coef1+coef2)/coef3); + } + } + } + } + return ret; +} + +//[[Rcpp::export]] +NumericVector meanProbs_(NumericVector x, NumericVector probs, bool naRm, bool useT, + bool useBinom) { double oldM = 0.0, newM = 0.0, oldS = 0.0, newS = 0.0, mx=R_NegInf, mn=R_PosInf; int n = 0; From e0fe17f107333a9e4f4a1231593e9d51c76baddb Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Tue, 3 Oct 2023 15:13:44 -0500 Subject: [PATCH 2/6] Add to NEWS and add ability to use binomProbs() for confint() --- NEWS.md | 11 ++++++++++- R/confint.R | 27 +++++++++++++++++++++++---- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index 825e20cb9..a9c14beaa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -90,13 +90,22 @@ mu-referencing style to run the optimization. your own `ci=0.99` for instance - A new function was introduced `meanProbs()` which calculates the - mean and expected quantiles under either the normal or t + mean and expected confidence bands under either the normal or t distribution +- A related new function was introduced that calculates the mean and + confidence bands under the binomial/Bernoulli distribution + (`binomProbs()`) + - When calculating the intervals for `rxode2` simulated objects you can also use `mean=TRUE` to use the mean for the first level of confidence using `meanProbs()` +- Also when calculating the intervals for `rxode2` simulated object + you can also use `mean="prob"` to use the binomial distributional + information (and ci) for the first level of confidence using + `binomProbs()` + - When plotting the `confint` derived intervals from an `rxode2` simulation, you can now subset based on a simulated value like `plot(ci, Cc)` which will only plot the variable `Cc` that you diff --git a/R/confint.R b/R/confint.R index 8094f9d58..e6abb00ee 100644 --- a/R/confint.R +++ b/R/confint.R @@ -32,9 +32,16 @@ confint.rxSolve <- function(object, parm = NULL, level = 0.95, ...) { } } .mean <- FALSE + .prob <- FALSE if (any(names(.args) == "mean")) { .mean <- .args$mean - checkmate::assertLogical(.mean, len=1, any.missing=FALSE, .var.name="mean") + if (inherits(.mean, "character") && + any(.mean == c("binom", "prob"))) { + .prob <- TRUE + .mean <- FALSE + } else { + checkmate::assertLogical(.mean, len=1, any.missing=FALSE, .var.name="mean") + } } .stk <- rxStack(object, parm, doSim=.doSim) for(.v in .by) { @@ -50,7 +57,8 @@ confint.rxSolve <- function(object, parm = NULL, level = 0.95, ...) { ci = paste0("p", .p2 * 100), parm = levels(.stk$trt), by = .by, - mean = .mean + mean = .mean, + prob=.prob ) class(.lst) <- "rxHidden" if (.ci ==0 || !any(names(.stk) == "sim.id")) { @@ -75,7 +83,14 @@ confint.rxSolve <- function(object, parm = NULL, level = 0.95, ...) { Percentile = sprintf("%s%%", .p * 100) ), by = c("time", "trt", .by) - ] + ] + } else if (.prob) { + .stk <- .stk[, list( + p1 = .p, eff = rxode2::binomProbs(.SD$value, probs = .p, na.rm = TRUE), + Percentile = sprintf("%s%%", .p * 100) + ), + by = c("time", "trt", .by) + ] } else { .stk <- .stk[, list( p1 = .p, eff = stats::quantile(.SD$value, probs = .p, na.rm = TRUE), @@ -107,10 +122,14 @@ confint.rxSolve <- function(object, parm = NULL, level = 0.95, ...) { .ret <- .ret[, list(p1 = .p, eff = rxode2::meanProbs(.SD$value, probs = .p, na.rm = TRUE)), by = c("id", "time", "trt", .by)] + } else if (.prob) { + .ret <- .ret[, list(p1 = .p, + eff = rxode2::binomProbs(.SD$value, probs = .p, na.rm = TRUE)), + by = c("id", "time", "trt", .by)] } else { .ret <- .ret[, list(p1 = .p, eff = stats::quantile(.SD$value, probs = .p, na.rm = TRUE)), by = c("id", "time", "trt", .by)] - + } .ret <- .ret[, setNames(as.list(stats::quantile(.SD$eff, probs = .p2, na.rm = TRUE)), sprintf("p%s", .p2 * 100)), From 17c77e83f53f6a74df99abf7ffda1409c1e3113d Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Tue, 3 Oct 2023 16:24:27 -0500 Subject: [PATCH 3/6] Remove min/max from output; add testing --- R/utils.R | 4 +-- src/utilcpp.cpp | 28 +++++++++------------ tests/testthat/test-binomProb.R | 44 +++++++++++++++++++++++++++++++++ 3 files changed, 58 insertions(+), 18 deletions(-) create mode 100644 tests/testthat/test-binomProb.R diff --git a/R/utils.R b/R/utils.R index bcc64268c..e522e5487 100644 --- a/R/utils.R +++ b/R/utils.R @@ -935,12 +935,12 @@ binomProbs.default <- function(x, probs=c(0.025, 0.05, 0.5, 0.95, 0.975), na.rm= .names <- paste0(probs*100, "%") } if (onlyProbs) { - .ret <- .ret[-1L:-6L] + .ret <- .ret[-1L:-4L] if (names) { names(.ret) <- .names } } else if (names) { - names(.ret) <- c("mean","var", "sd", "min", "max", "n", .names) + names(.ret) <- c("mean","var", "sd", "n", .names) } .ret } diff --git a/src/utilcpp.cpp b/src/utilcpp.cpp index 53aaf5d61..465f57a87 100644 --- a/src/utilcpp.cpp +++ b/src/utilcpp.cpp @@ -133,7 +133,7 @@ NumericVector rxErf(NumericVector v) { //[[Rcpp::export]] NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { - double oldM = 0.0, newM = 0.0, mx=R_NegInf, mn=R_PosInf; + double oldM = 0.0, newM = 0.0; int n = 0; // Use Newcombe, R. G. (1998). "Two-sided confidence intervals for // the single proportion: comparison of seven methods". Statistics @@ -146,7 +146,7 @@ NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { if (naRm) { continue; } else { - NumericVector ret(6+probs.size()); + NumericVector ret(4+probs.size()); for (int j = 0; j < ret.size(); ++j) { ret[j] = NA_REAL; } @@ -154,8 +154,6 @@ NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { } } n++; - mn = min2(cur, mn); - mx = max2(cur, mx); if (n == 1) { oldM = newM = cur; } else { @@ -173,25 +171,23 @@ NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { var = 0.0; sd = 0.0; } - // mean, var, sd, min, max - NumericVector ret(6+probs.size()); + // mean, var, sd + NumericVector ret(4+probs.size()); ret[0] = oldM; ret[1] = var; ret[2] = sd; - ret[3] = mn; - ret[4] = mx; - ret[5] = (double)n; + ret[3] = (double)n; double c = sd/sqrt((double)(n)); for (int i = 0; i < probs.size(); ++i) { double p = probs[i]; std::string str = std::to_string(p*100) + "%"; if (p == 0) { - ret[i+6] = mn; + ret[i+4] = 0; } else if (p == 1) { - ret[i+6] = mx; + ret[i+4] = 1; } else if (p == 0.5) { - ret[i+6] = oldM; + ret[i+4] = oldM; } else { double z; if (p > 0.5) { @@ -205,15 +201,15 @@ NumericVector binomProbs_(NumericVector x, NumericVector probs, bool naRm) { double coef3 = 2*(n+z2); if (p < 0.5) { if (p == 0.0) { - ret[i+6] = 0.0; + ret[i+4] = 0.0; } else { - ret[i+6] = max2(0, (coef1-coef2)/coef3); + ret[i+4] = max2(0, (coef1-coef2)/coef3); } } else { if (p == 1.0) { - ret[i+6] = 1.0; + ret[i+4] = 1.0; } else { - ret[i+6] = min2(1, (coef1+coef2)/coef3); + ret[i+4] = min2(1, (coef1+coef2)/coef3); } } } diff --git a/tests/testthat/test-binomProb.R b/tests/testthat/test-binomProb.R new file mode 100644 index 000000000..2c4529d7c --- /dev/null +++ b/tests/testthat/test-binomProb.R @@ -0,0 +1,44 @@ +test_that("test binomProb()", { + + x <- rbinom(1001, 1, prob = 0.05) + m <- mean(x) + v <- m * (1 - m) + s <- sqrt(v) + + n <- 1001 + z <- qnorm(1 - 0.025) + z2 <- z * z + c1 <- 2*n*m + z2; + c2 <- z*sqrt(z2 - 1.0/n + 4*n*v + (4.0*m-2.0))+1.0; + c3 <- 2*(n+z2) + z2.5 <- (c1 + c(-1, 1) * c2) / c3 + + n <- 1001 + z <- qnorm(1 - 0.05) + z2 <- z * z + c1 <- 2*n*m + z2; + c2 <- z*sqrt(z2 - 1.0/n + 4*n*v + (4.0*m-2.0))+1.0; + c3 <- 2*(n+z2) + z5 <- (c1 + c(-1, 1) * c2) / c3 + + + t1 <- c("2.5%"=z2.5[1], + "5%"=z5[1], + "50%"=m, + "95%"=z5[2], + "97.5%"=z2.5[2]) + expect_equal(binomProbs(x), t1) + + t2 <- c(c("mean"=m, "var"=v, "sd"=s, "n"=n), t1) + expect_equal(binomProbs(x, onlyProbs=FALSE), t2) + + x2 <- c(x, NA_real_) + setNames(rep(NA_real_, length(t1)),names(t1)) + expect_equal(binomProbs(x2), setNames(rep(NA_real_, length(t1)),names(t1))) + + expect_equal(binomProbs(x2, onlyProbs=FALSE), + setNames(rep(NA_real_, length(t2)),names(t2))) + expect_equal(binomProbs(x2,na.rm=TRUE), t1) + expect_equal(binomProbs(x2, onlyProbs=FALSE, na.rm=TRUE), t2) + +}) From e097e469bbae5defa32390458f1d2174bb41f0c2 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Tue, 3 Oct 2023 16:28:24 -0500 Subject: [PATCH 4/6] Remove binomProb semicolons --- tests/testthat/test-binomProb.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-binomProb.R b/tests/testthat/test-binomProb.R index 2c4529d7c..465ef2541 100644 --- a/tests/testthat/test-binomProb.R +++ b/tests/testthat/test-binomProb.R @@ -8,16 +8,16 @@ test_that("test binomProb()", { n <- 1001 z <- qnorm(1 - 0.025) z2 <- z * z - c1 <- 2*n*m + z2; - c2 <- z*sqrt(z2 - 1.0/n + 4*n*v + (4.0*m-2.0))+1.0; + c1 <- 2*n*m + z2 + c2 <- z*sqrt(z2 - 1.0/n + 4*n*v + (4.0*m-2.0))+1.0 c3 <- 2*(n+z2) z2.5 <- (c1 + c(-1, 1) * c2) / c3 n <- 1001 z <- qnorm(1 - 0.05) z2 <- z * z - c1 <- 2*n*m + z2; - c2 <- z*sqrt(z2 - 1.0/n + 4*n*v + (4.0*m-2.0))+1.0; + c1 <- 2*n*m + z2 + c2 <- z*sqrt(z2 - 1.0/n + 4*n*v + (4.0*m-2.0))+1.0 c3 <- 2*(n+z2) z5 <- (c1 + c(-1, 1) * c2) / c3 From 78111566ded22e43425a466af73b04d042ae0cc4 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Tue, 3 Oct 2023 18:05:34 -0500 Subject: [PATCH 5/6] ::document() update --- R/utils.R | 14 +++++++++----- man/binomProbs.Rd | 36 +++++++++++++++++++++++++----------- man/meanProbs.Rd | 5 ++++- man/reexports.Rd | 1 - man/rxode2.Rd | 4 ++-- 5 files changed, 40 insertions(+), 20 deletions(-) diff --git a/R/utils.R b/R/utils.R index e522e5487..c1281ffb3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -801,7 +801,7 @@ is.latex <- function() { #' @param x numeric vector whose mean and probability based confidence #' values are wanted, NA and NaN values are not allowed in numeric #' vectors unless ‘na.rm’ is ‘TRUE’. -#' @param probs numeric vector of probabilities with values in [0,1]. +#' @param probs numeric vector of probabilities with values in the interval from 0 to 1 . #' @param na.rm logical; if true, any NA and NaN's are removed from #' `x` before the quantiles are computed. #' @param names logical; if true, the result has a names attribute. @@ -810,6 +810,8 @@ is.latex <- function() { #' distribution to calculate the confidence based estimates. #' @param onlyProbs logical; if true, only return the probability based #' confidence interval estimates, otherwise return +#' @param ... Arguments passed to default method, allows many +#' different methods to be applied. #' @return By default the return has the probabilities as names (if #' named) with the points where the expected distribution are #' located given the sampling mean and standard deviation. If @@ -880,15 +882,17 @@ meanProbs.default <- function(x, probs=seq(0, 1, 0.25), na.rm=FALSE, #' @param x numeric vector whose mean and probability based confidence #' values are wanted, NA and NaN values are not allowed in numeric #' vectors unless ‘na.rm’ is ‘TRUE’. -#' @param probs numeric vector of probabilities with values in -#' [0,1]. When 0, it represents the maximum observed, when 1, it -#' represents the maximum observed. When 0.5 it represents the -#' expected probability (mean) +#' @param probs numeric vector of probabilities with values in the +#' interval 0 to 1, inclusive. When 0, it represents the maximum +#' observed, when 1, it represents the maximum observed. When 0.5 it +#' represents the expected probability (mean) #' @param na.rm logical; if true, any NA and NaN's are removed from #' `x` before the quantiles are computed. #' @param names logical; if true, the result has a names attribute. #' @param onlyProbs logical; if true, only return the probability #' based confidence interval estimates, otherwise return +#' @param ... Arguments passed to default method, allows many +#' different methods to be applied. #' @return By default the return has the probabilities as names (if #' named) with the points where the expected distribution are #' located given the sampling mean and standard deviation. If diff --git a/man/binomProbs.Rd b/man/binomProbs.Rd index 823fdcb7b..a0a3a0045 100644 --- a/man/binomProbs.Rd +++ b/man/binomProbs.Rd @@ -7,22 +7,34 @@ \usage{ binomProbs(x, ...) -\method{binomProbs}{default}(x, ...) +\method{binomProbs}{default}( + x, + probs = c(0.025, 0.05, 0.5, 0.95, 0.975), + na.rm = FALSE, + names = TRUE, + onlyProbs = TRUE +) } \arguments{ \item{x}{numeric vector whose mean and probability based confidence values are wanted, NA and NaN values are not allowed in numeric vectors unless ‘na.rm’ is ‘TRUE’.} -\item{probs}{numeric vector of probabilities with values in \link{0,1}.} +\item{...}{Arguments passed to default method, allows many +different methods to be applied.} + +\item{probs}{numeric vector of probabilities with values in the +interval 0 to 1, inclusive. When 0, it represents the maximum +observed, when 1, it represents the maximum observed. When 0.5 it +represents the expected probability (mean)} \item{na.rm}{logical; if true, any NA and NaN's are removed from \code{x} before the quantiles are computed.} \item{names}{logical; if true, the result has a names attribute.} -\item{onlyProbs}{logical; if true, only return the probability based -confidence interval estimates, otherwise return} +\item{onlyProbs}{logical; if true, only return the probability +based confidence interval estimates, otherwise return} } \value{ By default the return has the probabilities as names (if @@ -36,16 +48,16 @@ The generic function \code{binomProbs} produces expected confidence bands using the } \details{ -The mean, or observed probability is calculated based on Welford's -method for means. - This is meant to perform in the same way as \code{quantile()} so it can be a drop in replacement for code using \code{quantile()} but using distributional assumptions. + +It is used for confidence intervals with rxode2 solved objects using +\code{confint(mean="prob")} or `confint(mean="binom") } \examples{ -quantile(x<- rbinom(1001)) +quantile(x<- rbinom(7001, p=0.375, size=1)) binomProbs(x) # Can get some extra statistics if you request onlyProbs=FALSE @@ -55,13 +67,15 @@ x[2] <- NA_real_ binomProbs(x, onlyProbs=FALSE) +binomProbs(x, na.rm=TRUE) } \references{ \itemize{ -\item Newcombe, R. G. (1998). "Two-sided confidence intervals for -the single proportion: comparison of seven methods". Statistics -in Medicine. 17 (8): 857–872. doi:10.1002/(SICI)1097-0258(19980430)17:8<857::AID-SIM777>3.0.CO;2-E. PMID +\item Newcombe, +R. G. (1998). "Two-sided confidence intervals for the single proportion: comparison of seven methods". Statistics +in Medicine. 17 (8): +857–872. doi:10.1002/(SICI)1097-0258(19980430)17:8<857::AID-SIM777>3.0.CO;2-E. PMID 9595616. } } diff --git a/man/meanProbs.Rd b/man/meanProbs.Rd index c0df7bd63..e2de9dbb2 100644 --- a/man/meanProbs.Rd +++ b/man/meanProbs.Rd @@ -21,7 +21,10 @@ meanProbs(x, ...) values are wanted, NA and NaN values are not allowed in numeric vectors unless ‘na.rm’ is ‘TRUE’.} -\item{probs}{numeric vector of probabilities with values in \link{0,1}.} +\item{...}{Arguments passed to default method, allows many +different methods to be applied.} + +\item{probs}{numeric vector of probabilities with values in the interval from 0 to 1 .} \item{na.rm}{logical; if true, any NA and NaN's are removed from \code{x} before the quantiles are computed.} diff --git a/man/reexports.Rd b/man/reexports.Rd index 365c14ab7..f1310e9e9 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -82,4 +82,3 @@ below to see their documentation. \item{rxode2random}{\code{\link[rxode2random:dot-cbindOme]{.cbindOme}}, \code{\link[rxode2random:dot-expandPars]{.expandPars}}, \code{\link[rxode2random:dot-vecDf]{.vecDf}}, \code{\link[rxode2random]{cvPost}}, \code{\link[rxode2random]{invWR1d}}, \code{\link[rxode2random]{phi}}, \code{\link[rxode2random]{rinvchisq}}, \code{\link[rxode2random]{rLKJ1}}, \code{\link[rxode2random]{rxGetSeed}}, \code{\link[rxode2random]{rxGetSeed}}, \code{\link[rxode2random]{rxRmvn}}, \code{\link[rxode2random]{rxSeedEng}}, \code{\link[rxode2random]{rxSetSeed}}, \code{\link[rxode2random]{rxSetSeed}}, \code{\link[rxode2random]{rxSetSeed}}, \code{\link[rxode2random:rxWithSeed]{rxWithPreserveSeed}}, \code{\link[rxode2random]{rxWithSeed}}, \code{\link[rxode2random]{rxWithSeed}}} }} -\value{ Inherited from parent routine } diff --git a/man/rxode2.Rd b/man/rxode2.Rd index 32a23629e..89885498c 100644 --- a/man/rxode2.Rd +++ b/man/rxode2.Rd @@ -327,7 +327,7 @@ compilation model. \if{html}{\out{
}}\preformatted{## using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -## rxode2 2.0.13.9000 model named rx_1d8a358106bc128f5627b9b12d793312 model (ready). +## rxode2 2.0.13.9000 model named rx_484e55d026917829133db387c66e858f model (ready). ## x$state: depot, center ## x$stateExtra: cp ## x$params: tka, tcl, tv, add.sd, eta.ka, eta.cl, eta.v, rxerr.cp @@ -340,7 +340,7 @@ mod$simulationIniModel \if{html}{\out{
}}\preformatted{## using C compiler: ‘gcc (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0’ -## rxode2 2.0.13.9000 model named rx_433cc7bab35ab4f7adadd0c295cccdb3 model (ready). +## rxode2 2.0.13.9000 model named rx_2cf216702914aa504d82db35b93ea215 model (ready). ## x$state: depot, center ## x$stateExtra: cp ## x$params: tka, tcl, tv, add.sd, eta.ka, eta.cl, eta.v, rxerr.cp From 007f2f6e7b69487d384a209a23b6e392457d89e9 Mon Sep 17 00:00:00 2001 From: "Matthew L. Fidler" Date: Tue, 3 Oct 2023 18:12:25 -0500 Subject: [PATCH 6/6] Add meanProbs and binomProbs --- _pkgdown.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 7e52e5c23..532ceaf32 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -65,7 +65,9 @@ reference: - rxPkg - title: Specialized Simulation functions contents: + - binomProbs - cvPost + - meanProbs - rinvchisq - rxGetSeed - rxPp