diff --git a/DESCRIPTION b/DESCRIPTION index 07f02a3..3c90256 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,18 @@ Package: extraDistr Type: Package Title: Additional Univariate and Multivariate Distributions -Version: 1.9.1 -Date: 2020-08-20 -Author: Tymoteusz Wolodzko -Maintainer: Tymoteusz Wolodzko +Version: 1.9.2 +Date: 2022-06-25 +Authors@R: + c(person(given = "Tymoteusz", + family = "Wolodzko", + role = c("aut", "cre"), + email = "twolodzko+extraDistr@gmail.com"), + person(given = "Mervin", + family = "Fansler", + role = c("aut"), + email = "mef3005@med.cornell.edu", + comment = c(ORCID = "0000-0002-4108-4218"))) Description: Density, distribution function, quantile function and random generation for a number of univariate and multivariate distributions. This package implements the @@ -20,9 +28,10 @@ Description: Density, distribution function, quantile function hypergeometric, multinomial, negative hypergeometric, non-standard beta, normal mixture, Poisson mixture, Pareto, power, reparametrized beta, Rayleigh, shifted Gompertz, Skellam, - slash, triangular, truncated binomial, truncated normal, - truncated Poisson, Tukey lambda, Wald, zero-inflated binomial, - zero-inflated negative binomial, zero-inflated Poisson. + slash, triangular, truncated binomial, truncated negative binomial, + truncated normal, truncated Poisson, Tukey lambda, Wald, + zero-inflated binomial, zero-inflated negative binomial, + zero-inflated Poisson. License: GPL-2 URL: https://github.com/twolodzko/extraDistr BugReports: https://github.com/twolodzko/extraDistr/issues @@ -33,4 +42,4 @@ LinkingTo: Rcpp Imports: Rcpp Suggests: testthat, LaplacesDemon, VGAM, evd, hoa, skellam, triangle, actuar SystemRequirements: C++11 -RoxygenNote: 7.1.1 +RoxygenNote: 7.2.0 diff --git a/NAMESPACE b/NAMESPACE index 6516cb9..7e33e5c 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -47,6 +47,7 @@ export(dsgomp) export(dskellam) export(dslash) export(dtbinom) +export(dtnbinom) export(dtnorm) export(dtpois) export(dtriang) @@ -94,6 +95,7 @@ export(prayleigh) export(psgomp) export(pslash) export(ptbinom) +export(ptnbinom) export(ptnorm) export(ptpois) export(ptriang) @@ -131,6 +133,7 @@ export(qprop) export(qrayleigh) export(qtbinom) export(qtlambda) +export(qtnbinom) export(qtnorm) export(qtpois) export(qtriang) @@ -187,6 +190,7 @@ export(rskellam) export(rslash) export(rtbinom) export(rtlambda) +export(rtnbinom) export(rtnorm) export(rtpois) export(rtriang) diff --git a/NEWS.md b/NEWS.md index c016b07..f489262 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +### 1.9.2 + +* Adds truncated negative binomial distribution. + ### 1.9.1 * Generated header file, `inst/include/extraDistr.h`, to make C++ code callable diff --git a/R/RcppExports.R b/R/RcppExports.R index 8e0e4ff..848be06 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -637,6 +637,38 @@ cpp_rtbinom <- function(n, size, prob, lower, upper) { .Call(`_extraDistr_cpp_rtbinom`, n, size, prob, lower, upper) } +cpp_dtnbinom <- function(x, size, prob, lower, upper, log_prob = FALSE) { + .Call(`_extraDistr_cpp_dtnbinom`, x, size, prob, lower, upper, log_prob) +} + +cpp_dtnbinom_mu <- function(x, size, mu, lower, upper, log_prob = FALSE) { + .Call(`_extraDistr_cpp_dtnbinom_mu`, x, size, mu, lower, upper, log_prob) +} + +cpp_ptnbinom <- function(x, size, prob, lower, upper, lower_tail = TRUE, log_prob = FALSE) { + .Call(`_extraDistr_cpp_ptnbinom`, x, size, prob, lower, upper, lower_tail, log_prob) +} + +cpp_ptnbinom_mu <- function(x, size, mu, lower, upper, lower_tail = TRUE, log_prob = FALSE) { + .Call(`_extraDistr_cpp_ptnbinom_mu`, x, size, mu, lower, upper, lower_tail, log_prob) +} + +cpp_qtnbinom <- function(p, size, prob, lower, upper, lower_tail = TRUE, log_prob = FALSE) { + .Call(`_extraDistr_cpp_qtnbinom`, p, size, prob, lower, upper, lower_tail, log_prob) +} + +cpp_qtnbinom_mu <- function(p, size, mu, lower, upper, lower_tail = TRUE, log_prob = FALSE) { + .Call(`_extraDistr_cpp_qtnbinom_mu`, p, size, mu, lower, upper, lower_tail, log_prob) +} + +cpp_rtnbinom <- function(n, size, prob, lower, upper) { + .Call(`_extraDistr_cpp_rtnbinom`, n, size, prob, lower, upper) +} + +cpp_rtnbinom_mu <- function(n, size, mu, lower, upper) { + .Call(`_extraDistr_cpp_rtnbinom_mu`, n, size, mu, lower, upper) +} + cpp_dtnorm <- function(x, mu, sigma, lower, upper, log_prob = FALSE) { .Call(`_extraDistr_cpp_dtnorm`, x, mu, sigma, lower, upper, log_prob) } diff --git a/R/truncated-negative-binomial-distribution.R b/R/truncated-negative-binomial-distribution.R new file mode 100644 index 0000000..673d403 --- /dev/null +++ b/R/truncated-negative-binomial-distribution.R @@ -0,0 +1,123 @@ + + +#' Truncated negative binomial distribution +#' +#' Density, distribution function, quantile function and random generation +#' for the truncated negative binomial distribution. +#' +#' @param x,q vector of quantiles. +#' @param p vector of probabilities. +#' @param n number of observations. If \code{length(n) > 1}, +#' the length is taken to be the number required. +#' @param size target for number of successful trials, or dispersion +#' parameter (the shape parameter of the gamma mixing +#' distribution). Must be strictly positive, need not be +#' integer. +#' @param prob probability of success in each trial. \code{0 < prob <= 1}. +#' @param mu alternative parameterization via mean +#' @param a,b lower and upper truncation points (\code{a < x <= b}). +#' @param log,log.p logical; if TRUE, probabilities p are given as log(p). +#' @param lower.tail logical; if TRUE (default), probabilities are \eqn{P[X \le x]} +#' otherwise, \eqn{P[X > x]}. +#' +#' @references +#' Hilbe, J. (2011). Censored and truncated count models. In +#' *Negative Binomial Regression* (pp. 387-406). Cambridge: Cambridge University +#' Press. \url{https://doi.org/10.1017/CBO9780511973420.013} +#' +#' @seealso \code{\link[stats]{NegBinomial}} +#' +#' @examples +#' +#' # Right-truncated negative binomial +#' ## random sample +#' x <- rtnbinom(1e5, size = 2, prob = 0.1, b = 25) +#' plot(prop.table(table(x))) +#' +#' ## distribution +#' xx <- seq(-1, 30) +#' lines(xx, dtnbinom(xx, size = 2, prob = 0.1, b = 25), col = "red") +#' +#' hist(ptnbinom(x, size = 2, prob = 0.1, b = 25), breaks = 35) +#' +#' xx <- seq(0, 30, by = 0.01) +#' plot(ecdf(x)) +#' lines(xx, ptnbinom(xx, size = 2, prob = 0.1, b = 25), col = "red", lwd = 2) +#' +#' uu <- seq(0, 1, by = 0.001) +#' lines(qtnbinom(uu, size = 2, prob = 0.1, b = 25), uu, col = "blue", lty = 2) +#' +#' # Zero-truncated negative binomial (mu parameterization) +#' ## random sample +#' x <- rtnbinom(1e5, size = 2, mu = 5, a = 0) +#' plot(prop.table(table(x))) +#' +#' ## distribution +#' xx <- seq(-1, 50) +#' lines(xx, dtnbinom(xx, size = 2, mu = 5, a = 0), col = "red") +#' hist(ptnbinom(x, size = 2, mu = 5, a = 0)) +#' +#' xx <- seq(0, 50, by = 0.01) +#' plot(ecdf(x)) +#' lines(xx, ptnbinom(xx, size = 2, mu = 5, a = 0), col = "red", lwd = 2) +#' lines(qtnbinom(uu, size = 2, mu = 5, a = 0), uu, col = "blue", lty = 2) +#' +#' @name TruncNegBinom +#' @aliases TruncNegBinom +#' @aliases TruncNB +#' @aliases dtnbinom +#' +#' @keywords distribution +#' @concept Univariate +#' @concept Discrete +#' +#' @export + +dtnbinom <- function(x, size, prob, mu, a = -Inf, b = Inf, log = FALSE) { + if (!missing(mu)) { + if(!missing(prob)) + stop("'prob' and 'mu' both specified") + cpp_dtnbinom_mu(x, size, mu, a, b, log) + } + else cpp_dtnbinom(x, size, prob, a, b, log) +} + + +#' @rdname TruncNegBinom +#' @export + +ptnbinom <- function(q, size, prob, mu, a = -Inf, b = Inf, lower.tail = TRUE, log.p = FALSE) { + if (!missing(mu)) { + if(!missing(prob)) + stop("'prob' and 'mu' both specified") + cpp_ptnbinom_mu(q, size, mu, a, b, lower.tail[1L], log.p[1L]) + } + else cpp_ptnbinom(q, size, prob, a, b, lower.tail[1L], log.p[1L]) +} + + +#' @rdname TruncNegBinom +#' @export + +qtnbinom <- function(p, size, prob, mu, a = -Inf, b = Inf, lower.tail = TRUE, log.p = FALSE) { + if (!missing(mu)) { + if (!missing(prob)) + stop("'prob' and 'mu' both specified") + cpp_qtnbinom_mu(p, size, mu, a, b, lower.tail[1L], log.p[1L]) + } + else cpp_qtnbinom(p, size, prob, a, b, lower.tail[1L], log.p[1L]) +} + + +#' @rdname TruncNegBinom +#' @export + +rtnbinom <- function(n, size, prob, mu, a = -Inf, b = Inf) { + if (length(n) > 1) n <- length(n) + if (!missing(mu)) { + if (!missing(prob)) + stop("'prob' and 'mu' both specified") + cpp_rtnbinom_mu(n, size, mu, a, b) + } + else cpp_rtnbinom(n, size, prob, a, b) +} diff --git a/R/truncated-poisson-distributtion.R b/R/truncated-poisson-distribution.R similarity index 100% rename from R/truncated-poisson-distributtion.R rename to R/truncated-poisson-distribution.R diff --git a/inst/include/extraDistr_RcppExports.h b/inst/include/extraDistr_RcppExports.h index aaca3ca..69bc21f 100644 --- a/inst/include/extraDistr_RcppExports.h +++ b/inst/include/extraDistr_RcppExports.h @@ -3363,6 +3363,174 @@ namespace extraDistr { return Rcpp::as(rcpp_result_gen); } + inline NumericVector cpp_dtnbinom(const NumericVector& x, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper, const bool& log_prob = false) { + typedef SEXP(*Ptr_cpp_dtnbinom)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_dtnbinom p_cpp_dtnbinom = NULL; + if (p_cpp_dtnbinom == NULL) { + validateSignature("NumericVector(*cpp_dtnbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&)"); + p_cpp_dtnbinom = (Ptr_cpp_dtnbinom)R_GetCCallable("extraDistr", "_extraDistr_cpp_dtnbinom"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_dtnbinom(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(prob)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper)), Shield(Rcpp::wrap(log_prob))); + } + 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 cpp_dtnbinom_mu(const NumericVector& x, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper, const bool& log_prob = false) { + typedef SEXP(*Ptr_cpp_dtnbinom_mu)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_dtnbinom_mu p_cpp_dtnbinom_mu = NULL; + if (p_cpp_dtnbinom_mu == NULL) { + validateSignature("NumericVector(*cpp_dtnbinom_mu)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&)"); + p_cpp_dtnbinom_mu = (Ptr_cpp_dtnbinom_mu)R_GetCCallable("extraDistr", "_extraDistr_cpp_dtnbinom_mu"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_dtnbinom_mu(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(mu)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper)), Shield(Rcpp::wrap(log_prob))); + } + 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 cpp_ptnbinom(const NumericVector& x, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail = true, const bool& log_prob = false) { + typedef SEXP(*Ptr_cpp_ptnbinom)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_ptnbinom p_cpp_ptnbinom = NULL; + if (p_cpp_ptnbinom == NULL) { + validateSignature("NumericVector(*cpp_ptnbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + p_cpp_ptnbinom = (Ptr_cpp_ptnbinom)R_GetCCallable("extraDistr", "_extraDistr_cpp_ptnbinom"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_ptnbinom(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(prob)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper)), Shield(Rcpp::wrap(lower_tail)), Shield(Rcpp::wrap(log_prob))); + } + 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 cpp_ptnbinom_mu(const NumericVector& x, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail = true, const bool& log_prob = false) { + typedef SEXP(*Ptr_cpp_ptnbinom_mu)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_ptnbinom_mu p_cpp_ptnbinom_mu = NULL; + if (p_cpp_ptnbinom_mu == NULL) { + validateSignature("NumericVector(*cpp_ptnbinom_mu)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + p_cpp_ptnbinom_mu = (Ptr_cpp_ptnbinom_mu)R_GetCCallable("extraDistr", "_extraDistr_cpp_ptnbinom_mu"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_ptnbinom_mu(Shield(Rcpp::wrap(x)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(mu)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper)), Shield(Rcpp::wrap(lower_tail)), Shield(Rcpp::wrap(log_prob))); + } + 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 cpp_qtnbinom(const NumericVector& p, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail = true, const bool& log_prob = false) { + typedef SEXP(*Ptr_cpp_qtnbinom)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_qtnbinom p_cpp_qtnbinom = NULL; + if (p_cpp_qtnbinom == NULL) { + validateSignature("NumericVector(*cpp_qtnbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + p_cpp_qtnbinom = (Ptr_cpp_qtnbinom)R_GetCCallable("extraDistr", "_extraDistr_cpp_qtnbinom"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_qtnbinom(Shield(Rcpp::wrap(p)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(prob)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper)), Shield(Rcpp::wrap(lower_tail)), Shield(Rcpp::wrap(log_prob))); + } + 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 cpp_qtnbinom_mu(const NumericVector& p, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail = true, const bool& log_prob = false) { + typedef SEXP(*Ptr_cpp_qtnbinom_mu)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_qtnbinom_mu p_cpp_qtnbinom_mu = NULL; + if (p_cpp_qtnbinom_mu == NULL) { + validateSignature("NumericVector(*cpp_qtnbinom_mu)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + p_cpp_qtnbinom_mu = (Ptr_cpp_qtnbinom_mu)R_GetCCallable("extraDistr", "_extraDistr_cpp_qtnbinom_mu"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_qtnbinom_mu(Shield(Rcpp::wrap(p)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(mu)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper)), Shield(Rcpp::wrap(lower_tail)), Shield(Rcpp::wrap(log_prob))); + } + 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 cpp_rtnbinom(const int& n, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper) { + typedef SEXP(*Ptr_cpp_rtnbinom)(SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_rtnbinom p_cpp_rtnbinom = NULL; + if (p_cpp_rtnbinom == NULL) { + validateSignature("NumericVector(*cpp_rtnbinom)(const int&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&)"); + p_cpp_rtnbinom = (Ptr_cpp_rtnbinom)R_GetCCallable("extraDistr", "_extraDistr_cpp_rtnbinom"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_rtnbinom(Shield(Rcpp::wrap(n)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(prob)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper))); + } + 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 cpp_rtnbinom_mu(const int& n, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper) { + typedef SEXP(*Ptr_cpp_rtnbinom_mu)(SEXP,SEXP,SEXP,SEXP,SEXP); + static Ptr_cpp_rtnbinom_mu p_cpp_rtnbinom_mu = NULL; + if (p_cpp_rtnbinom_mu == NULL) { + validateSignature("NumericVector(*cpp_rtnbinom_mu)(const int&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&)"); + p_cpp_rtnbinom_mu = (Ptr_cpp_rtnbinom_mu)R_GetCCallable("extraDistr", "_extraDistr_cpp_rtnbinom_mu"); + } + RObject rcpp_result_gen; + { + RNGScope RCPP_rngScope_gen; + rcpp_result_gen = p_cpp_rtnbinom_mu(Shield(Rcpp::wrap(n)), Shield(Rcpp::wrap(size)), Shield(Rcpp::wrap(mu)), Shield(Rcpp::wrap(lower)), Shield(Rcpp::wrap(upper))); + } + 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 cpp_dtnorm(const NumericVector& x, const NumericVector& mu, const NumericVector& sigma, const NumericVector& lower, const NumericVector& upper, const bool& log_prob = false) { typedef SEXP(*Ptr_cpp_dtnorm)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); static Ptr_cpp_dtnorm p_cpp_dtnorm = NULL; diff --git a/man/TruncNegBinom.Rd b/man/TruncNegBinom.Rd new file mode 100644 index 0000000..f62481d --- /dev/null +++ b/man/TruncNegBinom.Rd @@ -0,0 +1,112 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/truncated-negative-binomial-distribution.R +\name{TruncNegBinom} +\alias{TruncNegBinom} +\alias{dtnbinom} +\alias{TruncNB} +\alias{ptnbinom} +\alias{qtnbinom} +\alias{rtnbinom} +\title{Truncated negative binomial distribution} +\usage{ +dtnbinom(x, size, prob, mu, a = -Inf, b = Inf, log = FALSE) + +ptnbinom( + q, + size, + prob, + mu, + a = -Inf, + b = Inf, + lower.tail = TRUE, + log.p = FALSE +) + +qtnbinom( + p, + size, + prob, + mu, + a = -Inf, + b = Inf, + lower.tail = TRUE, + log.p = FALSE +) + +rtnbinom(n, size, prob, mu, a = -Inf, b = Inf) +} +\arguments{ +\item{x, q}{vector of quantiles.} + +\item{size}{target for number of successful trials, or dispersion +parameter (the shape parameter of the gamma mixing +distribution). Must be strictly positive, need not be +integer.} + +\item{prob}{probability of success in each trial. \code{0 < prob <= 1}.} + +\item{mu}{alternative parameterization via mean} + +\item{a, b}{lower and upper truncation points (\code{a < x <= b}).} + +\item{log, log.p}{logical; if TRUE, probabilities p are given as log(p).} + +\item{lower.tail}{logical; if TRUE (default), probabilities are \eqn{P[X \le x]} +otherwise, \eqn{P[X > x]}.} + +\item{p}{vector of probabilities.} + +\item{n}{number of observations. If \code{length(n) > 1}, +the length is taken to be the number required.} +} +\description{ +Density, distribution function, quantile function and random generation +for the truncated negative binomial distribution. +} +\examples{ + +# Right-truncated negative binomial +## random sample +x <- rtnbinom(1e5, size = 2, prob = 0.1, b = 25) +plot(prop.table(table(x))) + +## distribution +xx <- seq(-1, 30) +lines(xx, dtnbinom(xx, size = 2, prob = 0.1, b = 25), col = "red") + +hist(ptnbinom(x, size = 2, prob = 0.1, b = 25), breaks = 35) + +xx <- seq(0, 30, by = 0.01) +plot(ecdf(x)) +lines(xx, ptnbinom(xx, size = 2, prob = 0.1, b = 25), col = "red", lwd = 2) + +uu <- seq(0, 1, by = 0.001) +lines(qtnbinom(uu, size = 2, prob = 0.1, b = 25), uu, col = "blue", lty = 2) + +# Zero-truncated negative binomial (mu parameterization) +## random sample +x <- rtnbinom(1e5, size = 2, mu = 5, a = 0) +plot(prop.table(table(x))) + +## distribution +xx <- seq(-1, 50) +lines(xx, dtnbinom(xx, size = 2, mu = 5, a = 0), col = "red") +hist(ptnbinom(x, size = 2, mu = 5, a = 0)) + +xx <- seq(0, 50, by = 0.01) +plot(ecdf(x)) +lines(xx, ptnbinom(xx, size = 2, mu = 5, a = 0), col = "red", lwd = 2) +lines(qtnbinom(uu, size = 2, mu = 5, a = 0), uu, col = "blue", lty = 2) + +} +\references{ +Hilbe, J. (2011). Censored and truncated count models. In +*Negative Binomial Regression* (pp. 387-406). Cambridge: Cambridge University +Press. \url{https://doi.org/10.1017/CBO9780511973420.013} +} +\seealso{ +\code{\link[stats]{NegBinomial}} +} +\concept{Discrete} +\concept{Univariate} +\keyword{distribution} diff --git a/man/TruncPoisson.Rd b/man/TruncPoisson.Rd index 05d6fc9..6434156 100755 --- a/man/TruncPoisson.Rd +++ b/man/TruncPoisson.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/truncated-poisson-distributtion.R +% Please edit documentation in R/truncated-poisson-distribution.R \name{TruncPoisson} \alias{TruncPoisson} \alias{dtpois} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 5245e2c..664e434 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -8,6 +8,11 @@ using namespace Rcpp; +#ifdef RCPP_USE_GLOBAL_ROSTREAM +Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); +Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); +#endif + // cpp_dbern NumericVector cpp_dbern(const NumericVector& x, const NumericVector& prob, const bool& log_prob); static SEXP _extraDistr_cpp_dbern_try(SEXP xSEXP, SEXP probSEXP, SEXP log_probSEXP) { @@ -5960,6 +5965,320 @@ RcppExport SEXP _extraDistr_cpp_rtbinom(SEXP nSEXP, SEXP sizeSEXP, SEXP probSEXP UNPROTECT(1); return rcpp_result_gen; } +// cpp_dtnbinom +NumericVector cpp_dtnbinom(const NumericVector& x, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper, const bool& log_prob); +static SEXP _extraDistr_cpp_dtnbinom_try(SEXP xSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP log_probSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const NumericVector& >::type x(xSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type prob(probSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const bool& >::type log_prob(log_probSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_dtnbinom(x, size, prob, lower, upper, log_prob)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_dtnbinom(SEXP xSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP log_probSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_dtnbinom_try(xSEXP, sizeSEXP, probSEXP, lowerSEXP, upperSEXP, log_probSEXP)); + } + 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; +} +// cpp_dtnbinom_mu +NumericVector cpp_dtnbinom_mu(const NumericVector& x, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper, const bool& log_prob); +static SEXP _extraDistr_cpp_dtnbinom_mu_try(SEXP xSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP log_probSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const NumericVector& >::type x(xSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type mu(muSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const bool& >::type log_prob(log_probSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_dtnbinom_mu(x, size, mu, lower, upper, log_prob)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_dtnbinom_mu(SEXP xSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP log_probSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_dtnbinom_mu_try(xSEXP, sizeSEXP, muSEXP, lowerSEXP, upperSEXP, log_probSEXP)); + } + 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; +} +// cpp_ptnbinom +NumericVector cpp_ptnbinom(const NumericVector& x, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail, const bool& log_prob); +static SEXP _extraDistr_cpp_ptnbinom_try(SEXP xSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const NumericVector& >::type x(xSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type prob(probSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const bool& >::type lower_tail(lower_tailSEXP); + Rcpp::traits::input_parameter< const bool& >::type log_prob(log_probSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_ptnbinom(x, size, prob, lower, upper, lower_tail, log_prob)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_ptnbinom(SEXP xSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_ptnbinom_try(xSEXP, sizeSEXP, probSEXP, lowerSEXP, upperSEXP, lower_tailSEXP, log_probSEXP)); + } + 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; +} +// cpp_ptnbinom_mu +NumericVector cpp_ptnbinom_mu(const NumericVector& x, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail, const bool& log_prob); +static SEXP _extraDistr_cpp_ptnbinom_mu_try(SEXP xSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const NumericVector& >::type x(xSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type mu(muSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const bool& >::type lower_tail(lower_tailSEXP); + Rcpp::traits::input_parameter< const bool& >::type log_prob(log_probSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_ptnbinom_mu(x, size, mu, lower, upper, lower_tail, log_prob)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_ptnbinom_mu(SEXP xSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_ptnbinom_mu_try(xSEXP, sizeSEXP, muSEXP, lowerSEXP, upperSEXP, lower_tailSEXP, log_probSEXP)); + } + 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; +} +// cpp_qtnbinom +NumericVector cpp_qtnbinom(const NumericVector& p, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail, const bool& log_prob); +static SEXP _extraDistr_cpp_qtnbinom_try(SEXP pSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const NumericVector& >::type p(pSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type prob(probSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const bool& >::type lower_tail(lower_tailSEXP); + Rcpp::traits::input_parameter< const bool& >::type log_prob(log_probSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_qtnbinom(p, size, prob, lower, upper, lower_tail, log_prob)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_qtnbinom(SEXP pSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_qtnbinom_try(pSEXP, sizeSEXP, probSEXP, lowerSEXP, upperSEXP, lower_tailSEXP, log_probSEXP)); + } + 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; +} +// cpp_qtnbinom_mu +NumericVector cpp_qtnbinom_mu(const NumericVector& p, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper, const bool& lower_tail, const bool& log_prob); +static SEXP _extraDistr_cpp_qtnbinom_mu_try(SEXP pSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const NumericVector& >::type p(pSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type mu(muSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + Rcpp::traits::input_parameter< const bool& >::type lower_tail(lower_tailSEXP); + Rcpp::traits::input_parameter< const bool& >::type log_prob(log_probSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_qtnbinom_mu(p, size, mu, lower, upper, lower_tail, log_prob)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_qtnbinom_mu(SEXP pSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP lower_tailSEXP, SEXP log_probSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_qtnbinom_mu_try(pSEXP, sizeSEXP, muSEXP, lowerSEXP, upperSEXP, lower_tailSEXP, log_probSEXP)); + } + 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; +} +// cpp_rtnbinom +NumericVector cpp_rtnbinom(const int& n, const NumericVector& size, const NumericVector& prob, const NumericVector& lower, const NumericVector& upper); +static SEXP _extraDistr_cpp_rtnbinom_try(SEXP nSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const int& >::type n(nSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type prob(probSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_rtnbinom(n, size, prob, lower, upper)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_rtnbinom(SEXP nSEXP, SEXP sizeSEXP, SEXP probSEXP, SEXP lowerSEXP, SEXP upperSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_rtnbinom_try(nSEXP, sizeSEXP, probSEXP, lowerSEXP, upperSEXP)); + } + 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; +} +// cpp_rtnbinom_mu +NumericVector cpp_rtnbinom_mu(const int& n, const NumericVector& size, const NumericVector& mu, const NumericVector& lower, const NumericVector& upper); +static SEXP _extraDistr_cpp_rtnbinom_mu_try(SEXP nSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::traits::input_parameter< const int& >::type n(nSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type size(sizeSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type mu(muSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type lower(lowerSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type upper(upperSEXP); + rcpp_result_gen = Rcpp::wrap(cpp_rtnbinom_mu(n, size, mu, lower, upper)); + return rcpp_result_gen; +END_RCPP_RETURN_ERROR +} +RcppExport SEXP _extraDistr_cpp_rtnbinom_mu(SEXP nSEXP, SEXP sizeSEXP, SEXP muSEXP, SEXP lowerSEXP, SEXP upperSEXP) { + SEXP rcpp_result_gen; + { + Rcpp::RNGScope rcpp_rngScope_gen; + rcpp_result_gen = PROTECT(_extraDistr_cpp_rtnbinom_mu_try(nSEXP, sizeSEXP, muSEXP, lowerSEXP, upperSEXP)); + } + 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; +} // cpp_dtnorm NumericVector cpp_dtnorm(const NumericVector& x, const NumericVector& mu, const NumericVector& sigma, const NumericVector& lower, const NumericVector& upper, const bool& log_prob); static SEXP _extraDistr_cpp_dtnorm_try(SEXP xSEXP, SEXP muSEXP, SEXP sigmaSEXP, SEXP lowerSEXP, SEXP upperSEXP, SEXP log_probSEXP) { @@ -7072,6 +7391,14 @@ static int _extraDistr_RcppExport_validate(const char* sig) { signatures.insert("NumericVector(*cpp_ptbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); signatures.insert("NumericVector(*cpp_qtbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); signatures.insert("NumericVector(*cpp_rtbinom)(const int&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&)"); + signatures.insert("NumericVector(*cpp_dtnbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&)"); + signatures.insert("NumericVector(*cpp_dtnbinom_mu)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&)"); + signatures.insert("NumericVector(*cpp_ptnbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + signatures.insert("NumericVector(*cpp_ptnbinom_mu)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + signatures.insert("NumericVector(*cpp_qtnbinom)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + signatures.insert("NumericVector(*cpp_qtnbinom_mu)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); + signatures.insert("NumericVector(*cpp_rtnbinom)(const int&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&)"); + signatures.insert("NumericVector(*cpp_rtnbinom_mu)(const int&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&)"); signatures.insert("NumericVector(*cpp_dtnorm)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&)"); signatures.insert("NumericVector(*cpp_ptnorm)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); signatures.insert("NumericVector(*cpp_qtnorm)(const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const NumericVector&,const bool&,const bool&)"); @@ -7262,6 +7589,14 @@ RcppExport SEXP _extraDistr_RcppExport_registerCCallable() { R_RegisterCCallable("extraDistr", "_extraDistr_cpp_ptbinom", (DL_FUNC)_extraDistr_cpp_ptbinom_try); R_RegisterCCallable("extraDistr", "_extraDistr_cpp_qtbinom", (DL_FUNC)_extraDistr_cpp_qtbinom_try); R_RegisterCCallable("extraDistr", "_extraDistr_cpp_rtbinom", (DL_FUNC)_extraDistr_cpp_rtbinom_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_dtnbinom", (DL_FUNC)_extraDistr_cpp_dtnbinom_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_dtnbinom_mu", (DL_FUNC)_extraDistr_cpp_dtnbinom_mu_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_ptnbinom", (DL_FUNC)_extraDistr_cpp_ptnbinom_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_ptnbinom_mu", (DL_FUNC)_extraDistr_cpp_ptnbinom_mu_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_qtnbinom", (DL_FUNC)_extraDistr_cpp_qtnbinom_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_qtnbinom_mu", (DL_FUNC)_extraDistr_cpp_qtnbinom_mu_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_rtnbinom", (DL_FUNC)_extraDistr_cpp_rtnbinom_try); + R_RegisterCCallable("extraDistr", "_extraDistr_cpp_rtnbinom_mu", (DL_FUNC)_extraDistr_cpp_rtnbinom_mu_try); R_RegisterCCallable("extraDistr", "_extraDistr_cpp_dtnorm", (DL_FUNC)_extraDistr_cpp_dtnorm_try); R_RegisterCCallable("extraDistr", "_extraDistr_cpp_ptnorm", (DL_FUNC)_extraDistr_cpp_ptnorm_try); R_RegisterCCallable("extraDistr", "_extraDistr_cpp_qtnorm", (DL_FUNC)_extraDistr_cpp_qtnorm_try); @@ -7451,6 +7786,14 @@ static const R_CallMethodDef CallEntries[] = { {"_extraDistr_cpp_ptbinom", (DL_FUNC) &_extraDistr_cpp_ptbinom, 7}, {"_extraDistr_cpp_qtbinom", (DL_FUNC) &_extraDistr_cpp_qtbinom, 7}, {"_extraDistr_cpp_rtbinom", (DL_FUNC) &_extraDistr_cpp_rtbinom, 5}, + {"_extraDistr_cpp_dtnbinom", (DL_FUNC) &_extraDistr_cpp_dtnbinom, 6}, + {"_extraDistr_cpp_dtnbinom_mu", (DL_FUNC) &_extraDistr_cpp_dtnbinom_mu, 6}, + {"_extraDistr_cpp_ptnbinom", (DL_FUNC) &_extraDistr_cpp_ptnbinom, 7}, + {"_extraDistr_cpp_ptnbinom_mu", (DL_FUNC) &_extraDistr_cpp_ptnbinom_mu, 7}, + {"_extraDistr_cpp_qtnbinom", (DL_FUNC) &_extraDistr_cpp_qtnbinom, 7}, + {"_extraDistr_cpp_qtnbinom_mu", (DL_FUNC) &_extraDistr_cpp_qtnbinom_mu, 7}, + {"_extraDistr_cpp_rtnbinom", (DL_FUNC) &_extraDistr_cpp_rtnbinom, 5}, + {"_extraDistr_cpp_rtnbinom_mu", (DL_FUNC) &_extraDistr_cpp_rtnbinom_mu, 5}, {"_extraDistr_cpp_dtnorm", (DL_FUNC) &_extraDistr_cpp_dtnorm, 6}, {"_extraDistr_cpp_ptnorm", (DL_FUNC) &_extraDistr_cpp_ptnorm, 7}, {"_extraDistr_cpp_qtnorm", (DL_FUNC) &_extraDistr_cpp_qtnorm, 7}, diff --git a/src/truncated-negative-binomial-distribution.cpp b/src/truncated-negative-binomial-distribution.cpp new file mode 100644 index 0000000..d18dfe6 --- /dev/null +++ b/src/truncated-negative-binomial-distribution.cpp @@ -0,0 +1,505 @@ +#include +#include "shared.h" +// [[Rcpp::interfaces(r, cpp)]] +// [[Rcpp::plugins(cpp11)]] + +using std::pow; +using std::sqrt; +using std::abs; +using std::exp; +using std::log; +using std::floor; +using std::ceil; +using Rcpp::NumericVector; + + +inline double logpdf_tnbinom(double x, double size, double prob, + double a, double b, bool& throw_warning) { +#ifdef IEEE_754 + if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(a) || ISNAN(b)) + return x+size+prob+a+b; +#endif + if (size <= 0.0 || !VALID_PROB(prob) || b < a) { + throw_warning = true; + return NAN; + } + + if (!isInteger(x) || x < 0.0 || x <= a || x > b || !R_FINITE(x)) + return R_NegInf; + + double pa, pb; + pa = R::pnbinom(a, size, prob, true, false); + pb = R::pnbinom(b, size, prob, true, false); + + return R::dnbinom(x, size, prob, true) - log(pb-pa); +} + +inline double logpdf_tnbinom_mu(double x, double size, double mu, + double a, double b, bool& throw_warning) { +#ifdef IEEE_754 + if (ISNAN(x) || ISNAN(size) || ISNAN(mu) || ISNAN(a) || ISNAN(b)) + return x+size+mu+a+b; +#endif + if (size <= 0.0 || mu < 0.0 || b < a) { + throw_warning = true; + return NAN; + } + + if (!isInteger(x) || x < 0.0 || x <= a || x > b || !R_FINITE(x)) + return R_NegInf; + + double pa, pb; + pa = R::pnbinom_mu(a, size, mu, true, false); + pb = R::pnbinom_mu(b, size, mu, true, false); + + return R::dnbinom_mu(x, size, mu, true) - log(pb-pa); +} + +inline double cdf_tnbinom(double x, double size, double prob, + double a, double b, bool& throw_warning) { +#ifdef IEEE_754 + if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(a) || ISNAN(b)) + return x+size+prob+a+b; +#endif + if (size <= 0.0 || !VALID_PROB(prob) || b < a) { + throw_warning = true; + return NAN; + } + + if (x < 0.0 || x <= a) + return 0.0; + if (x > b || !R_FINITE(x)) + return 1.0; + + double pa, pb; + pa = R::pnbinom(a, size, prob, true, false); + pb = R::pnbinom(b, size, prob, true, false); + + return (R::pnbinom(x, size, prob, true, false) - pa) / (pb-pa); +} + +inline double cdf_tnbinom_mu(double x, double size, double mu, + double a, double b, bool& throw_warning) { +#ifdef IEEE_754 + if (ISNAN(x) || ISNAN(size) || ISNAN(mu) || ISNAN(a) || ISNAN(b)) + return x+size+mu+a+b; +#endif + if (size <= 0.0 || mu < 0.0 || b < a) { + throw_warning = true; + return NAN; + } + + if (x < 0.0 || x <= a) + return 0.0; + if (x > b || !R_FINITE(x)) + return 1.0; + + double pa, pb; + pa = R::pnbinom_mu(a, size, mu, true, false); + pb = R::pnbinom_mu(b, size, mu, true, false); + + return (R::pnbinom_mu(x, size, mu, true, false) - pa) / (pb-pa); +} + +inline double invcdf_tnbinom(double p, double size, double prob, + double a, double b, bool& throw_warning) { +#ifdef IEEE_754 + if (ISNAN(p) || ISNAN(size) || ISNAN(prob) || ISNAN(a) || ISNAN(b)) + return p+size+prob+a+b; +#endif + if (size <= 0.0 || !VALID_PROB(prob) || b < a || !VALID_PROB(p)) { + throw_warning = true; + return NAN; + } + + if (p == 0.0) + return std::max(a, 0.0); + if (p == 1.0) + return b; + + double pa, pb; + pa = R::pnbinom(a, size, prob, true, false); + pb = R::pnbinom(b, size, prob, true, false); + + return R::qnbinom(pa + p*(pb-pa), size, prob, true, false); +} + +inline double invcdf_tnbinom_mu(double p, double size, double mu, + double a, double b, bool& throw_warning) { +#ifdef IEEE_754 + if (ISNAN(p) || ISNAN(size) || ISNAN(mu) || ISNAN(a) || ISNAN(b)) + return p+size+mu+a+b; +#endif + if (size <= 0.0 || mu < 0.0 || b < a || !VALID_PROB(p)) { + throw_warning = true; + return NAN; + } + + if (p == 0.0) + return std::max(a, 0.0); + if (p == 1.0) + return b; + + double pa, pb; + pa = R::pnbinom_mu(a, size, mu, true, false); + pb = R::pnbinom_mu(b, size, mu, true, false); + + return R::qnbinom_mu(pa + p*(pb-pa), size, mu, true, false); +} + +inline double rng_tnbinom(double size, double prob, double a, double b, + bool& throw_warning) { + if (ISNAN(size) || ISNAN(prob) || ISNAN(a) || ISNAN(b) || + size <= 0.0 || !VALID_PROB(prob) || b < a) { + throw_warning = true; + return NA_REAL; + } + + double u, pa, pb; + pa = R::pnbinom(a, size, prob, true, false); + pb = R::pnbinom(b, size, prob, true, false); + + u = R::runif(pa, pb); + return R::qnbinom(u, size, prob, true, false); +} + + +inline double rng_tnbinom_mu(double size, double mu, double a, double b, + bool& throw_warning) { + if (ISNAN(size) || ISNAN(mu) || ISNAN(a) || ISNAN(b) || + size <= 0.0 || mu < 0.0 || b < a) { + throw_warning = true; + return NA_REAL; + } + + double u, pa, pb; + pa = R::pnbinom_mu(a, size, mu, true, false); + pb = R::pnbinom_mu(b, size, mu, true, false); + + u = R::runif(pa, pb); + return R::qnbinom_mu(u, size, mu, true, false); +} + + +// [[Rcpp::export]] +NumericVector cpp_dtnbinom( + const NumericVector& x, + const NumericVector& size, + const NumericVector& prob, + const NumericVector& lower, + const NumericVector& upper, + const bool& log_prob = false +) { + + if (std::min({x.length(), size.length(), prob.length(), + lower.length(), upper.length()}) < 1) { + return NumericVector(0); + } + + int Nmax = std::max({ + x.length(), + size.length(), + prob.length(), + lower.length(), + upper.length() + }); + NumericVector p(Nmax); + + bool throw_warning = false; + + for (int i = 0; i < Nmax; i++) + p[i] = logpdf_tnbinom(GETV(x, i), GETV(size, i), GETV(prob, i), + GETV(lower, i), GETV(upper, i), + throw_warning); + + if (!log_prob) + p = Rcpp::exp(p); + + if (throw_warning) + Rcpp::warning("NaNs produced"); + + return p; +} + + +// [[Rcpp::export]] +NumericVector cpp_dtnbinom_mu( + const NumericVector& x, + const NumericVector& size, + const NumericVector& mu, + const NumericVector& lower, + const NumericVector& upper, + const bool& log_prob = false +) { + + if (std::min({x.length(), size.length(), mu.length(), + lower.length(), upper.length()}) < 1) { + return NumericVector(0); + } + + int Nmax = std::max({ + x.length(), + size.length(), + mu.length(), + lower.length(), + upper.length() + }); + NumericVector p(Nmax); + + bool throw_warning = false; + + for (int i = 0; i < Nmax; i++) + p[i] = logpdf_tnbinom_mu(GETV(x, i), GETV(size, i), GETV(mu, i), + GETV(lower, i), GETV(upper, i), + throw_warning); + + if (!log_prob) + p = Rcpp::exp(p); + + if (throw_warning) + Rcpp::warning("NaNs produced"); + + return p; +} + + +// [[Rcpp::export]] +NumericVector cpp_ptnbinom( + const NumericVector& x, + const NumericVector& size, + const NumericVector& prob, + const NumericVector& lower, + const NumericVector& upper, + const bool& lower_tail = true, + const bool& log_prob = false +) { + + if (std::min({x.length(), size.length(), prob.length(), + lower.length(), upper.length()}) < 1) { + return NumericVector(0); + } + + int Nmax = std::max({ + x.length(), + size.length(), + prob.length(), + lower.length(), + upper.length() + }); + NumericVector p(Nmax); + + bool throw_warning = false; + + for (int i = 0; i < Nmax; i++) + p[i] = cdf_tnbinom(GETV(x, i), GETV(size, i), GETV(prob, i), + GETV(lower, i), GETV(upper, i), + throw_warning); + + if (!lower_tail) + p = 1.0 - p; + + if (log_prob) + p = Rcpp::log(p); + + if (throw_warning) + Rcpp::warning("NaNs produced"); + + return p; +} + + +// [[Rcpp::export]] +NumericVector cpp_ptnbinom_mu( + const NumericVector& x, + const NumericVector& size, + const NumericVector& mu, + const NumericVector& lower, + const NumericVector& upper, + const bool& lower_tail = true, + const bool& log_prob = false +) { + + if (std::min({x.length(), size.length(), mu.length(), + lower.length(), upper.length()}) < 1) { + return NumericVector(0); + } + + int Nmax = std::max({ + x.length(), + size.length(), + mu.length(), + lower.length(), + upper.length() + }); + NumericVector p(Nmax); + + bool throw_warning = false; + + for (int i = 0; i < Nmax; i++) + p[i] = cdf_tnbinom_mu(GETV(x, i), GETV(size, i), GETV(mu, i), + GETV(lower, i), GETV(upper, i), + throw_warning); + + if (!lower_tail) + p = 1.0 - p; + + if (log_prob) + p = Rcpp::log(p); + + if (throw_warning) + Rcpp::warning("NaNs produced"); + + return p; +} + + +// [[Rcpp::export]] +NumericVector cpp_qtnbinom( + const NumericVector& p, + const NumericVector& size, + const NumericVector& prob, + const NumericVector& lower, + const NumericVector& upper, + const bool& lower_tail = true, + const bool& log_prob = false +) { + + if (std::min({p.length(), size.length(), prob.length(), + lower.length(), upper.length()}) < 1) { + return NumericVector(0); + } + + int Nmax = std::max({ + p.length(), + size.length(), + prob.length(), + lower.length(), + upper.length() + }); + NumericVector x(Nmax); + NumericVector pp = Rcpp::clone(p); + + bool throw_warning = false; + + if (log_prob) + pp = Rcpp::exp(pp); + + if (!lower_tail) + pp = 1.0 - pp; + + for (int i = 0; i < Nmax; i++) + x[i] = invcdf_tnbinom(GETV(pp, i), GETV(size, i), GETV(prob, i), + GETV(lower, i), GETV(upper, i), + throw_warning); + + if (throw_warning) + Rcpp::warning("NaNs produced"); + + return x; +} + + +// [[Rcpp::export]] +NumericVector cpp_qtnbinom_mu( + const NumericVector& p, + const NumericVector& size, + const NumericVector& mu, + const NumericVector& lower, + const NumericVector& upper, + const bool& lower_tail = true, + const bool& log_prob = false +) { + + if (std::min({p.length(), size.length(), mu.length(), + lower.length(), upper.length()}) < 1) { + return NumericVector(0); + } + + int Nmax = std::max({ + p.length(), + size.length(), + mu.length(), + lower.length(), + upper.length() + }); + NumericVector x(Nmax); + NumericVector pp = Rcpp::clone(p); + + bool throw_warning = false; + + if (log_prob) + pp = Rcpp::exp(pp); + + if (!lower_tail) + pp = 1.0 - pp; + + for (int i = 0; i < Nmax; i++) + x[i] = invcdf_tnbinom_mu(GETV(pp, i), GETV(size, i), GETV(mu, i), + GETV(lower, i), GETV(upper, i), + throw_warning); + + if (throw_warning) + Rcpp::warning("NaNs produced"); + + return x; +} + + +// [[Rcpp::export]] +NumericVector cpp_rtnbinom( + const int& n, + const NumericVector& size, + const NumericVector& prob, + const NumericVector& lower, + const NumericVector& upper +) { + + if (std::min({size.length(), prob.length(), + lower.length(), upper.length()}) < 1) { + Rcpp::warning("NAs produced"); + return NumericVector(n, NA_REAL); + } + + NumericVector x(n); + + bool throw_warning = false; + + for (int i = 0; i < n; i++) + x[i] = rng_tnbinom(GETV(size, i), GETV(prob, i), GETV(lower, i), + GETV(upper, i), throw_warning); + + if (throw_warning) + Rcpp::warning("NAs produced"); + + return x; +} + +// [[Rcpp::export]] +NumericVector cpp_rtnbinom_mu( + const int& n, + const NumericVector& size, + const NumericVector& mu, + const NumericVector& lower, + const NumericVector& upper +) { + + if (std::min({size.length(), mu.length(), + lower.length(), upper.length()}) < 1) { + Rcpp::warning("NAs produced"); + return NumericVector(n, NA_REAL); + } + + NumericVector x(n); + + bool throw_warning = false; + + for (int i = 0; i < n; i++) + x[i] = rng_tnbinom_mu(GETV(size, i), GETV(mu, i), GETV(lower, i), + GETV(upper, i), throw_warning); + + if (throw_warning) + Rcpp::warning("NAs produced"); + + return x; +} + diff --git a/tests/testthat/test-NAs.R b/tests/testthat/test-NAs.R index b64a35e..8fdcf8a 100755 --- a/tests/testthat/test-NAs.R +++ b/tests/testthat/test-NAs.R @@ -227,10 +227,17 @@ test_that("Missing values in PDF and PMF functions", { expect_true(is.na(dtnorm(1, 0, NA, -2, 2))) expect_true(is.na(dtnorm(1, 0, 1, NA, 2))) expect_true(is.na(dtnorm(1, 0, 1, -2, NA))) - + expect_true(is.na(dtpois(NA, 5, 0))) expect_true(is.na(dtpois(1, NA, 0))) expect_true(is.na(dtpois(1, 5, NA))) + + expect_true(is.na(dtnbinom(NA, 5, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(dtnbinom(1, NA, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(dtnbinom(1, 5, prob = NA, a = 0, b = 10))) + expect_true(is.na(dtnbinom(1, 5, mu = NA, a = 0, b = 10))) + expect_true(is.na(dtnbinom(1, 5, prob = 0.5, a = NA, b = 10))) + expect_true(is.na(dtnbinom(1, 5, prob = 0.5, a = 0, b = NA))) expect_true(is.na(dtriang(NA, 0, 1, 0.5))) expect_true(is.na(dtriang(0.5, NA, 1, 0.5))) @@ -446,6 +453,13 @@ test_that("Wrong parameter values in CDF functions", { expect_true(is.na(ptpois(1, NA, 0))) expect_true(is.na(ptpois(1, 5, NA))) + expect_true(is.na(ptnbinom(NA, 5, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, NA, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, 5, prob = NA, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, 5, mu = NA, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, 5, prob = 0.5, a = NA, b = 10))) + expect_true(is.na(ptnbinom(1, 5, prob = 0.5, a = 0, b = NA))) + expect_true(is.na(ptriang(NA, 0, 1, 0.5))) expect_true(is.na(ptriang(0.5, NA, 1, 0.5))) expect_true(is.na(ptriang(0.5, 0, NA, 0.5))) @@ -605,6 +619,13 @@ test_that("Wrong parameter values in inverse CDF functions", { expect_true(is.na(qtpois(0.5, NA, 0))) expect_true(is.na(qtpois(0.5, 5, NA))) + expect_true(is.na(qtnbinom(NA, 5, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(qtnbinom(0.5, NA, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(qtnbinom(0.5, 5, prob = NA, a = 0, b = 10))) + expect_true(is.na(qtnbinom(0.5, 5, mu = NA, a = 0, b = 10))) + expect_true(is.na(qtnbinom(0.5, 5, prob = 0.5, a = NA, b = 10))) + expect_true(is.na(qtnbinom(0.5, 5, prob = 0.5, a = 0, b = NA))) + expect_true(is.na(qtriang(NA, 0, 1, 0.5))) expect_true(is.na(qtriang(0.5, NA, 1, 0.5))) expect_true(is.na(qtriang(0.5, 0, NA, 0.5))) @@ -809,6 +830,12 @@ test_that("Wrong parameter values in RNG functions", { expect_warning(expect_true(is.na(rtpois(1, NA, 0)))) expect_warning(expect_true(is.na(rtpois(1, 5, NA)))) + expect_true(is.na(ptnbinom(1, NA, prob = 0.5, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, 5, prob = NA, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, 5, mu = NA, a = 0, b = 10))) + expect_true(is.na(ptnbinom(1, 5, prob = 0.5, a = NA, b = 10))) + expect_true(is.na(ptnbinom(1, 5, prob = 0.5, a = 0, b = NA))) + expect_warning(expect_true(is.na(rtriang(1, NA, 1, 0.5)))) expect_warning(expect_true(is.na(rtriang(1, 0, NA, 0.5)))) expect_warning(expect_true(is.na(rtriang(1, 0, 1, NA)))) diff --git a/tests/testthat/test-discrete-sum-to-unity.R b/tests/testthat/test-discrete-sum-to-unity.R index c86d9b7..29daf63 100755 --- a/tests/testthat/test-discrete-sum-to-unity.R +++ b/tests/testthat/test-discrete-sum-to-unity.R @@ -55,6 +55,12 @@ test_that("Discrete probabilities sum to unity", { expect_equal(sum(dtbinom(0:100, 100, 0.5, a = -Inf, b = 32)), 1) expect_equal(sum(dtbinom(0:100, 100, 0.5, a = 25, b = 32)), 1) + expect_equal(sum(dtnbinom(0:100, size = 10, mu = 10, a = -Inf, b = Inf)), 1) + expect_equal(sum(dtnbinom(0:100, size = 10, mu = 10, a = 0, b = Inf)), 1) + expect_equal(sum(dtnbinom(0:100, size = 10, mu = 10, a = 5, b = Inf)), 1) + expect_equal(sum(dtnbinom(0:100, size = 10, mu = 10, a = -Inf, b = 25)), 1) + expect_equal(sum(dtnbinom(0:100, size = 10, mu = 10, a = 5, b = 25)), 1) + expect_equal(sum(dlgser(0:100, 0.6)), 1) expect_equal(sum(dlgser(0:100, 0.1)), 1) expect_equal(sum(dlgser(0:100, 0.8)), 1) diff --git a/tests/testthat/test-discrete.R b/tests/testthat/test-discrete.R index b197f30..94b9106 100755 --- a/tests/testthat/test-discrete.R +++ b/tests/testthat/test-discrete.R @@ -18,6 +18,7 @@ test_that("Zero probabilities for non-integers", { expect_warning(expect_equal(0, dskellam(0.5, 1, 1))) expect_warning(expect_equal(0, dtpois(0.5, lambda = 25, a = 0))) expect_warning(expect_equal(0, dtbinom(0.5, 100, 0.56, a = 0))) + expect_warning(expect_equal(0, dtnbinom(0.5, 100, prob = 0.56, a = 0))) expect_warning(expect_equal(0, dzip(0.5, 1, 0.5))) expect_warning(expect_equal(0, dzib(0.5, 1, 0.5, 0.5))) expect_warning(expect_equal(0, dzinb(0.5, 1, 0.5, 0.5))) @@ -49,6 +50,9 @@ test_that("cdf vs cumsum(pdf)", { expect_equal(cumsum(dtbinom(xx, 200, 0.5, a = 100)), ptbinom(xx, 200, 0.5, a = 100), tolerance = epsilon) expect_equal(cumsum(dtbinom(xx, 200, 0.5, b = 100)), ptbinom(xx, 200, 0.5, b = 100), tolerance = epsilon) + expect_equal(cumsum(dtnbinom(xx, 200, 0.5, a = 100)), ptnbinom(xx, 200, 0.5, a = 100), tolerance = epsilon) + expect_equal(cumsum(dtnbinom(xx, 200, 0.5, b = 100)), ptnbinom(xx, 200, 0.5, b = 100), tolerance = epsilon) + expect_equal(cumsum(dbbinom(xx, 200, 5, 13)), pbbinom(xx, 200, 5, 13), tolerance = epsilon) expect_equal(cumsum(dbnbinom(xx, 70, 5, 13)), pbnbinom(xx, 70, 5, 13), tolerance = epsilon) expect_equal(cumsum(dgpois(xx, 500, 16)), pgpois(xx, 500, 16), tolerance = epsilon) diff --git a/tests/testthat/test-inappropriate-parameters.R b/tests/testthat/test-inappropriate-parameters.R index cea23ca..f9d9a3c 100755 --- a/tests/testthat/test-inappropriate-parameters.R +++ b/tests/testthat/test-inappropriate-parameters.R @@ -170,11 +170,16 @@ test_that("Wrong parameter values in PDF and PMF functions", { expect_warning(expect_true(is.nan(dtnorm(1, 0, -1, -2, 2)))) expect_warning(expect_true(is.nan(dtnorm(1, 0, 1, 2, -2)))) - expect_warning(expect_true(is.nan(dtnorm(1, 0, 1, 0, 0)))) + expect_warning(expect_true(is.nan(dtnorm(1, 0, 1, 0, 0)))) expect_warning(expect_true(is.nan(dtpois(1, lambda = -5, a = 0)))) expect_warning(expect_true(is.nan(dtpois(1, lambda = -5, a = 6)))) expect_warning(expect_true(is.nan(dtpois(1, lambda = -5, a = 6, b = 5)))) + + expect_warning(expect_true(is.nan(dtnbinom(1, size = -5, prob = 0.5, a = 0)))) + expect_warning(expect_true(is.nan(dtnbinom(1, size = 1, prob = -0.5, a = 6)))) + expect_warning(expect_true(is.nan(dtnbinom(1, size = 1, mu = 10, a = 6, b = 5)))) + expect_warning(expect_true(is.nan(dtnbinom(1, size = 1, mu = -10, a = 0, b = 5)))) expect_warning(expect_true(is.nan(dtriang(1, 0, 0, 0)))) expect_warning(expect_true(is.nan(dtriang(1, 1, -1, 0)))) @@ -348,6 +353,11 @@ test_that("Wrong parameter values in CDF functions", { expect_warning(expect_true(is.nan(ptpois(1, lambda = -5, a = 0)))) expect_warning(expect_true(is.nan(ptpois(1, lambda = -5, a = 6)))) expect_warning(expect_true(is.nan(ptpois(1, lambda = -5, a = 6, b = 5)))) + + expect_warning(expect_true(is.nan(ptnbinom(1, size = -5, prob = 0.5, a = 0)))) + expect_warning(expect_true(is.nan(ptnbinom(1, size = 1, prob = -0.5, a = 6)))) + expect_warning(expect_true(is.nan(ptnbinom(1, size = 1, mu = 10, a = 6, b = 5)))) + expect_warning(expect_true(is.nan(ptnbinom(1, size = 1, mu = -10, a = 0, b = 5)))) expect_warning(expect_true(is.nan(ptriang(1, 0, 0, 0)))) expect_warning(expect_true(is.nan(ptriang(1, 1, -1, 0)))) @@ -470,6 +480,11 @@ test_that("Wrong parameter values in quantile functions", { expect_warning(expect_true(is.nan(qtpois(0.5, lambda = -5, a = 0)))) expect_warning(expect_true(is.nan(qtpois(0.5, lambda = -5, a = 6)))) expect_warning(expect_true(is.nan(qtpois(0.5, lambda = -5, a = 6, b = 5)))) + + expect_warning(expect_true(is.nan(qtnbinom(0.5, size = -5, prob = 0.5, a = 0)))) + expect_warning(expect_true(is.nan(qtnbinom(0.5, size = 1, prob = -0.5, a = 6)))) + expect_warning(expect_true(is.nan(qtnbinom(0.5, size = 1, mu = 10, a = 6, b = 5)))) + expect_warning(expect_true(is.nan(qtnbinom(0.5, size = 1, mu = -10, a = 0, b = 5)))) expect_warning(expect_true(is.nan(qtriang(0.5, 0, 0, 0)))) expect_warning(expect_true(is.nan(qtriang(0.5, 1, -1, 0)))) @@ -663,6 +678,11 @@ test_that("Wrong parameter values in RNG functions", { expect_warning(expect_true(is.na(rtpois(1, lambda = -5, a = 0)))) expect_warning(expect_true(is.na(rtpois(1, lambda = -5, a = 6)))) expect_warning(expect_true(is.na(rtpois(1, lambda = -5, a = 6, b = 5)))) + + expect_warning(expect_true(is.na(rtnbinom(1, size = -5, prob = 0.5, a = 0)))) + expect_warning(expect_true(is.na(rtnbinom(1, size = 1, prob = -0.5, a = 6)))) + expect_warning(expect_true(is.na(rtnbinom(1, size = 1, mu = 10, a = 6, b = 5)))) + expect_warning(expect_true(is.na(rtnbinom(1, size = 1, mu = -10, a = 0, b = 5)))) expect_warning(expect_true(is.na(rtriang(1, 0, 0, 0)))) expect_warning(expect_true(is.na(rtriang(1, 1, -1, 0)))) diff --git a/tests/testthat/test-infinity.R b/tests/testthat/test-infinity.R index 57c9f42..c3dee23 100755 --- a/tests/testthat/test-infinity.R +++ b/tests/testthat/test-infinity.R @@ -38,6 +38,8 @@ test_that("Testing PDFs & PMFs against infinite values", { expect_true(!is.nan(dslash(Inf)) && is.finite(dslash(Inf))) expect_true(!is.nan(dtpois(Inf, lambda = 5)) && is.finite(dtpois(Inf, lambda = 5))) expect_true(!is.nan(dtpois(Inf, lambda = 5, a = 6)) && is.finite(dtpois(Inf, lambda = 5, a = 6))) + expect_true(!is.nan(dtnbinom(Inf, size = 5, prob = 0.5)) && is.finite(dtnbinom(Inf, size = 5, prob = 0.5))) + expect_true(!is.nan(dtnbinom(Inf, size = 5, mu = 10)) && is.finite(dtnbinom(Inf, size = 5, mu = 10))) expect_true(!is.nan(dwald(Inf, 1, 1)) && is.finite(dwald(Inf, 1, 1))) expect_true(!is.nan(dzip(Inf, 1, 0.5)) && is.finite(dzip(Inf, 1, 0.5))) expect_true(!is.nan(dzib(Inf, 1, 1, 0.5)) && is.finite(dzinb(Inf, 1, 1, 0.5))) @@ -84,6 +86,8 @@ test_that("Testing CDFs against infinite values", { expect_true(!is.nan(pslash(Inf)) && is.finite(pslash(Inf))) expect_true(!is.nan(ptpois(Inf, lambda = 5)) && is.finite(ptpois(Inf, lambda = 5))) expect_true(!is.nan(ptpois(Inf, lambda = 5, a = 6)) && is.finite(ptpois(Inf, lambda = 5, a = 6))) + expect_true(!is.nan(ptnbinom(Inf, size = 5, prob = 0.5)) && is.finite(ptnbinom(Inf, size = 5, prob = 0.5))) + expect_true(!is.nan(ptnbinom(Inf, size = 5, mu = 10)) && is.finite(ptnbinom(Inf, size = 5, mu = 10))) expect_true(!is.nan(pwald(Inf, 1, 1)) && is.finite(pwald(Inf, 1, 1))) expect_true(!is.nan(pzip(Inf, 1, 0.5)) && is.finite(pzip(Inf, 1, 0.5))) expect_true(!is.nan(pzib(Inf, 1, 1, 0.5)) && is.finite(pzinb(Inf, 1, 1, 0.5))) @@ -132,6 +136,8 @@ test_that("Testing PDFs & PMFs against negatively infinite values", { expect_true(!is.nan(dslash(-Inf)) && is.finite(dslash(-Inf))) expect_true(!is.nan(dtpois(-Inf, lambda = 5)) && is.finite(dtpois(-Inf, lambda = 5))) expect_true(!is.nan(dtpois(-Inf, lambda = 5, a = 6)) && is.finite(dtpois(-Inf, lambda = 5, a = 6))) + expect_true(!is.nan(dtnbinom(-Inf, size = 5, prob = 0.5)) && is.finite(dtnbinom(-Inf, size = 5, prob = 0.5))) + expect_true(!is.nan(dtnbinom(-Inf, size = 5, mu = 10)) && is.finite(dtnbinom(-Inf, size = 5, mu = 10))) expect_true(!is.nan(dwald(-Inf, 1, 1)) && is.finite(dwald(-Inf, 1, 1))) expect_true(!is.nan(dzip(-Inf, 1, 0.5)) && is.finite(dzip(-Inf, 1, 0.5))) expect_true(!is.nan(dzib(-Inf, 1, 1, 0.5)) && is.finite(dzinb(-Inf, 1, 1, 0.5))) @@ -178,6 +184,8 @@ test_that("Testing CDFs against negatively infinite values", { expect_true(!is.nan(pslash(-Inf)) && is.finite(pslash(-Inf))) expect_true(!is.nan(ptpois(-Inf, lambda = 5)) && is.finite(ptpois(-Inf, lambda = 5))) expect_true(!is.nan(ptpois(-Inf, lambda = 5, a = 6)) && is.finite(ptpois(-Inf, lambda = 5, a = 6))) + expect_true(!is.nan(ptnbinom(-Inf, size = 5, prob = 0.5)) && is.finite(ptnbinom(-Inf, size = 5, prob = 0.5))) + expect_true(!is.nan(ptnbinom(-Inf, size = 5, mu = 10)) && is.finite(ptnbinom(-Inf, size = 5, mu = 10))) expect_true(!is.nan(pwald(-Inf, 1, 1)) && is.finite(pwald(-Inf, 1, 1))) expect_true(!is.nan(pzip(-Inf, 1, 0.5)) && is.finite(pzip(-Inf, 1, 0.5))) expect_true(!is.nan(pzib(-Inf, 1, 1, 0.5)) && is.finite(pzinb(-Inf, 1, 1, 0.5))) diff --git a/tests/testthat/test-log-probs.R b/tests/testthat/test-log-probs.R index 04b5c03..8d911d0 100755 --- a/tests/testthat/test-log-probs.R +++ b/tests/testthat/test-log-probs.R @@ -198,6 +198,10 @@ test_that("Check if log-probabilities are logs of probabilities (CDF's)", { log(ptnorm(x, 0, 1, 1, 2))) expect_equal(suppressWarnings(ptpois(x, lambda = 25, a = 0, log.p = TRUE)), log(suppressWarnings(ptpois(x, lambda = 25, a = 0)))) + expect_equal(suppressWarnings(ptnbinom(x, size = 5, prob = 0.5, a = 0, log.p = TRUE)), + log(suppressWarnings(ptnbinom(x, size = 5, prob = 0.5, a = 0)))) + expect_equal(suppressWarnings(ptnbinom(x, size = 5, mu = 10, a = 0, log.p = TRUE)), + log(suppressWarnings(ptnbinom(x, size = 5, mu = 10, a = 0)))) expect_equal(suppressWarnings(ptbinom(x, 100, 0.67, a = 60, b = 70, log.p = TRUE)), log(suppressWarnings(ptbinom(x, 100, 0.67, a = 60, b = 70)))) expect_equal(ptriang(x, 1, 2, 1.5, log.p = TRUE), diff --git a/tests/testthat/test-misc.R b/tests/testthat/test-misc.R index f5fc1e9..b6b1065 100755 --- a/tests/testthat/test-misc.R +++ b/tests/testthat/test-misc.R @@ -36,4 +36,5 @@ test_that("other tests", { expect_equal(suppressWarnings(pmixpois(x, c(1,2,3), c(1/3,1/3,1/3), lower.tail = TRUE)), 1 - suppressWarnings(pmixpois(x, c(1,2,3), c(1/3,1/3,1/3), lower.tail = FALSE))) + expect_error(rtnbinom(1, 1, mu = 10, prob = 0.5)) }) diff --git a/tests/testthat/test-non-negative.R b/tests/testthat/test-non-negative.R index b272562..1b9e196 100755 --- a/tests/testthat/test-non-negative.R +++ b/tests/testthat/test-non-negative.R @@ -35,6 +35,8 @@ test_that("Zero probabilities for values <0", { expect_equal(0, dmixpois(-1, c(1,2,3), c(1/3,1/3,1/3))) expect_equal(0, dtpois(-1, lambda = 5, a = 6)) + expect_equal(0, dtnbinom(-1, size = 5, prob = 0.5, a = 6)) + expect_equal(0, dtnbinom(-1, size = 5, mu = 10, a = 6)) expect_equal(0, dnhyper(-1, 60, 35, 15)) @@ -55,6 +57,8 @@ test_that("Zero probabilities for values < 1", { expect_equal(c(0, 0), dlgser(c(-1, 0), 0.5)) expect_equal(c(0, 0), dpareto(c(-1, 0), 1, 1)) expect_equal(c(0, 0), dtpois(c(-1, 0), lambda = 5, a = 0)) + expect_equal(c(0, 0), dtnbinom(c(-1, 0), size = 5, prob = 0.5, a = 0)) + expect_equal(c(0, 0), dtnbinom(c(-1, 0), size = 5, mu = 10, a = 0)) }) diff --git a/tests/testthat/test-p-r-random-tests.R b/tests/testthat/test-p-r-random-tests.R index a506d3f..fdaa55b 100755 --- a/tests/testthat/test-p-r-random-tests.R +++ b/tests/testthat/test-p-r-random-tests.R @@ -167,6 +167,11 @@ test_that("p-r random tests", { expect_true(dkwtest("tpois", 5, 0)) expect_true(dkwtest("tpois", 50, 45, 55)) + expect_true(dkwtest("tnbinom", 5, prob = 0.5, a = 0)) + expect_true(dkwtest("tnbinom", 5, mu = 10, a = 0)) + expect_true(dkwtest("tnbinom", 5, prob = 0.5, a = 10, b = 50)) + expect_true(dkwtest("tnbinom", 5, mu = 10, a = 10, b = 50)) + expect_true(dkwtest("triang")) expect_true(dkwtest("triang", 0, 1, 0.5)) diff --git a/tests/testthat/test-probabilities.R b/tests/testthat/test-probabilities.R index bb2da70..9f548f5 100755 --- a/tests/testthat/test-probabilities.R +++ b/tests/testthat/test-probabilities.R @@ -50,6 +50,8 @@ test_that("All probabilities/densities >= 0", { expect_true(all(dslash(x, sigma = 1) >= 0)) expect_true(all(dtnorm(x, 0, 1, 1, 2) >= 0)) expect_true(suppressWarnings(all(dtpois(x, lambda = 25, a = 0) >= 0))) + expect_true(suppressWarnings(all(dtnbinom(x, size = 5, prob = 0.5, a = 0) >= 0))) + expect_true(suppressWarnings(all(dtnbinom(x, size = 5, mu = 10, a = 0) >= 0))) expect_true(suppressWarnings(all(dtbinom(x, 100, 0.67, a = 60, b = 70) >= 0))) expect_true(all(dtriang(x, 1, 2, 1.5) >= 0)) expect_true(all(dwald(x, 1, 1) >= 0)) @@ -113,6 +115,8 @@ test_that("All cumulative probabilities >= 0 and <= 1", { expect_true(all(pslash(x, sigma = 1) >= 0 & pslash(x, sigma = 1) <= 1)) expect_true(all(ptnorm(x, 0, 1, 1, 2) >= 0 & ptnorm(x, 0, 1, 1, 2) <= 1)) expect_true(all(ptpois(x, lambda = 25, a = 0) >= 0 & ptpois(x, lambda = 25, a = 0) <= 1)) + expect_true(all(ptnbinom(x, size = 5, prob = 0.5, a = 0) >= 0 & ptnbinom(x, size = 5, prob = 0.5, a = 0) <= 1)) + expect_true(all(ptnbinom(x, size = 5, mu = 10, a = 0) >= 0 & ptnbinom(x, size = 5, mu = 10, a = 0) <= 1)) expect_true(all(ptbinom(x, 100, 0.67, 60, 70) >= 0 & ptbinom(x, 100, 0.67, 60, 70) <= 1)) expect_true(all(ptbinom(x, 100, 0.67, a = 60, b = 70) >= 0 & ptbinom(x, 100, 0.67, a = 60, b = 70) <= 1)) expect_true(all(ptriang(x, 1, 2, 1.5) >= 0 & ptriang(x, 1, 2, 1.5) <= 1)) diff --git a/tests/testthat/test-quantile-functions.R b/tests/testthat/test-quantile-functions.R index e163c78..30fa2ae 100755 --- a/tests/testthat/test-quantile-functions.R +++ b/tests/testthat/test-quantile-functions.R @@ -33,6 +33,8 @@ test_that("Zeros in quantile functions", { expect_true(!is.nan(qtpois(0, lambda = 5, a = 0))) expect_true(!is.nan(qtpois(0, lambda = 5, a = 6))) + expect_true(!is.nan(qtnbinom(0, size = 5, prob = 0.5, a = 0))) + expect_true(!is.nan(qtnbinom(0, size = 5, mu = 10, a = 6))) expect_true(!is.nan(pdgamma(0, 9, 1))) expect_true(!is.nan(pdnorm(0, 1, 2))) @@ -72,6 +74,8 @@ test_that("Ones in quantile functions", { expect_true(!is.nan(qtpois(1, lambda = 5, a = 0))) expect_true(!is.nan(qtpois(1, lambda = 5, a = 6))) + expect_true(!is.nan(qtnbinom(1, size = 5, prob = 0.5, a = 0))) + expect_true(!is.nan(qtnbinom(1, size = 5, mu = 10, a = 6))) }) diff --git a/tests/testthat/test-zero-length.R b/tests/testthat/test-zero-length.R index 22a26ad..4fb58b8 100755 --- a/tests/testthat/test-zero-length.R +++ b/tests/testthat/test-zero-length.R @@ -207,6 +207,15 @@ test_that("Zero-length in PDF and PMF functions", { expect_true(is_zero_length(dtpois(1, numeric(0), 0))) expect_true(is_zero_length(dtpois(1, 5, numeric(0)))) + expect_true(is_zero_length(dtnbinom(numeric(0), 5, prob = 0.5, a = 0))) + expect_true(is_zero_length(dtnbinom(1, numeric(0), prob = 0.5, a = 0))) + expect_true(is_zero_length(dtnbinom(1, 5, prob = numeric(0), a = 0))) + expect_true(is_zero_length(dtnbinom(1, 5, prob = 0.5, a = numeric(0)))) + expect_true(is_zero_length(dtnbinom(numeric(0), 5, mu = 0.5, a = 0))) + expect_true(is_zero_length(dtnbinom(1, numeric(0), mu = 0.5, a = 0))) + expect_true(is_zero_length(dtnbinom(1, 5, mu = numeric(0), a = 0))) + expect_true(is_zero_length(dtnbinom(1, 5, mu = 10, a = numeric(0)))) + expect_true(is_zero_length(dtriang(numeric(0), 0, 1, 0.5))) expect_true(is_zero_length(dtriang(0.5, numeric(0), 1, 0.5))) expect_true(is_zero_length(dtriang(0.5, 0, numeric(0), 0.5)))