From 72a53af505582eb7d4c75982a8bc72b3e78bff97 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <w.l.netto@medisin.uio.no>
Date: Wed, 21 Aug 2024 07:03:16 +0200
Subject: [PATCH 1/5] Added aliases for #54

---
 NAMESPACE  | 12 +++++++++++
 R/ptrunc.R | 58 +++++++++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 59 insertions(+), 11 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 71c0968..2243881 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -95,6 +95,18 @@ export(natural2parameters)
 export(parameters2natural)
 export(probdist)
 export(ptrunc)
+export(ptruncbeta)
+export(ptruncbinom)
+export(ptruncchisq)
+export(ptrunccontbern)
+export(ptruncexp)
+export(ptruncgamma)
+export(ptruncinvgamma)
+export(ptruncinvgauss)
+export(ptrunclnorm)
+export(ptruncnbinom)
+export(ptruncnorm)
+export(ptruncpois)
 export(qtrunc)
 export(rtrunc)
 export(rtrunc.beta)
diff --git a/R/ptrunc.R b/R/ptrunc.R
index f2ae7b3..b10396d 100644
--- a/R/ptrunc.R
+++ b/R/ptrunc.R
@@ -34,7 +34,7 @@ ptrunc.generic <- function(q, ..., lower.tail, log.p) {
 }
 
 ptrunc.normal <- function(
-  q, mean = 0, sd = 1, a = -Inf, b = Inf, ..., lower.tail, log.p
+  q, mean = 0, sd = 1, a = -Inf, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
   ) {
   validate_q_a_b(q, a, b)
   p_q <- pnorm(q, mean, sd, lower.tail = TRUE, log.p)
@@ -43,8 +43,11 @@ ptrunc.normal <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncnorm <- ptrunc.normal
+
 ptrunc.beta <- function(
-  q, shape1, shape2, a = 0, b = 1, ..., lower.tail, log.p
+  q, shape1, shape2, a = 0, b = 1, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   validate_q_a_b(q, a, b)
   p_q <- pbeta(q, shape1, shape2, ncp = 0, lower.tail = TRUE, log.p)
@@ -53,8 +56,11 @@ ptrunc.beta <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncbeta <- ptrunc.beta
+
 ptrunc.binomial <- function(
-  q, size, prob, a = 0, b = size, ..., lower.tail, log.p
+  q, size, prob, a = 0, b = size, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   validate_q_a_b(q, a, b)
   p_q <- pbinom(q, size, prob, lower.tail = TRUE, log.p)
@@ -63,8 +69,11 @@ ptrunc.binomial <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncbinom <- ptrunc.binomial
+
 ptrunc.poisson <- function(
-  q, lambda, a = 0, b = Inf, ..., lower.tail, log.p
+  q, lambda, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   validate_q_a_b(q, a, b)
   p_q <- ppois(q, lambda, lower.tail = TRUE, log.p)
@@ -73,7 +82,10 @@ ptrunc.poisson <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
-ptrunc.chisq <- function(q, df, a = 0, b = Inf, ..., lower.tail, log.p) {
+#' @export
+ptruncpois <- ptrunc.poisson
+
+ptrunc.chisq <- function(q, df, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
   validate_q_a_b(q, a, b)
   p_q <- pchisq(q, df, ncp = 0, lower.tail = TRUE, log.p)
   p_a <- pchisq(a - 1L, df, ncp = 0, lower.tail = TRUE, log.p)
@@ -81,6 +93,9 @@ ptrunc.chisq <- function(q, df, a = 0, b = Inf, ..., lower.tail, log.p) {
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncchisq <- ptrunc.chisq
+
 ptrunc.contbern <- function(q, lambda, a = 0, b = 1, ...) {
   validate_q_a_b(q, a, b)
   p_q <- pcontbern(q, lambda)
@@ -89,7 +104,10 @@ ptrunc.contbern <- function(q, lambda, a = 0, b = 1, ...) {
   return(truncated_p(p_q, p_a, p_b, lower.tail = TRUE, log.p = FALSE))
 }
 
-ptrunc.exp <- function(q, rate = 1, a = 0, b = Inf, ..., lower.tail, log.p) {
+#' @export
+ptrunccontbern <- ptrunc.contbern
+
+ptrunc.exp <- function(q, rate = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
   validate_q_a_b(q, a, b)
   p_q <- pexp(q, rate, lower.tail = TRUE, log.p)
   p_a <- pexp(a, rate, lower.tail = TRUE, log.p)
@@ -97,8 +115,11 @@ ptrunc.exp <- function(q, rate = 1, a = 0, b = Inf, ..., lower.tail, log.p) {
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncexp <- ptrunc.exp
+
 ptrunc.gamma <- function(
-  q, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail, log.p
+  q, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   validate_q_a_b(q, a, b)
   if (!missing(rate) && !missing(scale)) {
@@ -110,8 +131,11 @@ ptrunc.gamma <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncgamma <- ptrunc.gamma
+
 ptrunc.invgamma <- function(
-  q, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail, log.p
+  q, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   validate_q_a_b(q, a, b)
   if (!missing(rate) && !missing(scale)) {
@@ -123,6 +147,9 @@ ptrunc.invgamma <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptruncinvgamma <- ptrunc.invgamma
+
 ptrunc.invgauss <- function(q, m, s, a = 0, b = Inf, ...) {
   validate_q_a_b(q, a, b)
   p_q <- pinvgauss(q, m, s)
@@ -131,8 +158,11 @@ ptrunc.invgauss <- function(q, m, s, a = 0, b = Inf, ...) {
   return(truncated_p(p_q, p_a, p_b, lower.tail = TRUE, log.p = FALSE))
 }
 
+#' @export
+ptruncinvgauss <- ptrunc.invgauss
+
 ptrunc.lognormal <- function(
-  q, meanlog = 0, sdlog = 1, a = 0, b = Inf, ..., lower.tail, log.p
+  q, meanlog = 0, sdlog = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   validate_q_a_b(q, a, b)
   p_q <- plnorm(q, meanlog, sdlog, lower.tail = TRUE, log.p)
@@ -141,8 +171,11 @@ ptrunc.lognormal <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
+#' @export
+ptrunclnorm <- ptrunc.lognormal
+
 ptrunc.nbinom <- function(
-  q, size, prob, mu, a = 0, b = Inf, ..., lower.tail, log.p
+  q, size, prob, mu, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   if (missing(prob)) {
     prob <- size / (size + mu) # from help("pnbinom")
@@ -155,7 +188,10 @@ ptrunc.nbinom <- function(
   return(truncated_p(p_q, p_a, p_b, lower.tail, log.p))
 }
 
-truncated_p <- function(p_q, p_a, p_b, lower.tail, log.p) {
+#' @export
+ptruncnbinom <- ptrunc.nbinom
+
+truncated_p <- function(p_q, p_a, p_b, lower.tail = TRUE, log.p = FALSE) {
   # Usual cases --------------------------------------------------------------
   if (log.p) {
     p <- log((exp(p_q) - exp(p_a)) / (exp(p_b) - exp(p_a)))

From f3bd4e804775ebfabfc72f09692175963e9f3c09 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <w.l.netto@medisin.uio.no>
Date: Wed, 21 Aug 2024 08:41:29 +0200
Subject: [PATCH 2/5] Added unit tests for ptrunc aliases (#54)

---
 tests/testthat/test-aliases.R | 70 ++++++++++++++++++++++++++++++++++-
 1 file changed, 69 insertions(+), 1 deletion(-)

diff --git a/tests/testthat/test-aliases.R b/tests/testthat/test-aliases.R
index e244dda..9a523b4 100644
--- a/tests/testthat/test-aliases.R
+++ b/tests/testthat/test-aliases.R
@@ -2,7 +2,7 @@
 # rtrunc methods vs aliases                                #
 # ======================================================== #
 
-context("Matching output of rtrunc aliases")
+context("Matching output of rtrunc, ptrunc and qtrunc aliases")
 
 test_that("rtrunc works the same from generic and alias", {
   expect_identical(
@@ -133,6 +133,74 @@ test_that("rtrunc works the same from generic and alias", {
   )
 })
 
+test_that("ptrunc works the same from generic and alias", {
+  gen_args <- function(FUN, ...) {
+    pb <- sort(runif(3))
+    qt <- FUN(pb, ...)
+    list("a" = qt[1], "q" = qt[2], "b" = qt[3])
+  }
+  x <- gen_args(qbeta, shape1 = 1, shape2 = 2)
+  expect_identical(
+    ptrunc(x$q, 1, 2, x$a, x$b, family = "beta"),
+    ptruncbeta(x$q, 1, 2, x$a, x$b)
+  )
+  x <- gen_args(qbinom, size = 50, prob = 0.3)
+  expect_identical(
+    ptrunc(x$q, 50, .3, x$a, x$b, family = "binomial"),
+    ptruncbinom(x$q, 50, .3, x$a, x$b)
+  )
+  x <- gen_args(qchisq, df = 23)
+  expect_identical(
+    ptrunc(x$q, 23, x$a, x$b, family = "chisq"),
+    ptruncchisq(x$q, 23, x$a, x$b)
+  )
+  x <- gen_args(qcontbern, lambda = 0.5)
+  expect_identical(
+    ptrunc(x$q, 0.5, x$a, x$b, family = "contbern"),
+    ptrunccontbern(x$q, 0.5, x$a, x$b)
+  )
+  x <- gen_args(qexp, rate = 26)
+  expect_identical(
+    ptrunc(x$q, 26, x$a, x$b, family = "exp"),
+    ptruncexp(x$q, 26, x$a, x$b)
+  )
+  x <- gen_args(qgamma, shape = 4, rate = 5)
+  expect_identical(
+    ptrunc(x$q, 4, 5, a = x$a, b = x$b, family = "gamma"),
+    ptruncgamma(x$q, 4, 5, a = x$a, b = x$b)
+  )
+  x <- gen_args(qinvgamma, shape = 4, scale = 6)
+  expect_identical(
+    ptrunc(x$q, 4, 6, a = x$a, b = x$b, family = "invgamma"),
+    ptruncinvgamma(x$q, 4, 6, a = x$a, b = x$b)
+  )
+  x <- gen_args(qinvgauss, m = 1, s = 3)
+  expect_identical(
+    ptrunc(x$q, 1, 3, a = x$a, b = x$b, family = "invgauss"),
+    ptruncinvgauss(x$q, 1, 3, a = x$a, b = x$b)
+  )
+  x <- gen_args(qlnorm, meanlog = 7, sdlog = 2)
+  expect_identical(
+    ptrunc(x$q, 7, 2, a = x$a, b = x$b, family = "lognormal"),
+    ptrunclnorm(x$q, 7, 2, a = x$a, b = x$b)
+  )
+  x <- gen_args(qnbinom, size = 55, prob = .4)
+  expect_identical(
+    ptrunc(x$q, 55, .4, a = x$a, b = x$b, family = "nbinom"),
+    ptruncnbinom(x$q, 55, .4, a = x$a, b = x$b)
+  )
+  x <- gen_args(qnorm, mean = 1, sd = 3)
+  expect_identical(
+    ptrunc(x$q, mean = 1, sd = 3, a = x$a, b = x$b),
+    ptruncnorm(x$q, mean = 1, sd = 3, a = x$a, b = x$b)
+  )
+  x <- gen_args(qpois, lambda = 72)
+  expect_identical(
+    ptrunc(x$q, 72, a = x$a, b = x$b, family = "poisson"),
+    ptruncpois(x$q, 72, a = x$a, b = x$b)
+  )
+})
+
 # ======================================================== #
 # rtrunc functions vs stats functions                      #
 # ======================================================== #

From fadd7311c66f8a6e71d1e50d76ba4c6fe1a5adb4 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <w.l.netto@medisin.uio.no>
Date: Wed, 21 Aug 2024 08:47:49 +0200
Subject: [PATCH 3/5] Properly documented ptrunc aliases (#54)

---
 R/ptrunc.R    |  24 +++++++++
 man/ptrunc.Rd | 141 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 165 insertions(+)

diff --git a/R/ptrunc.R b/R/ptrunc.R
index b10396d..8f7643f 100644
--- a/R/ptrunc.R
+++ b/R/ptrunc.R
@@ -44,6 +44,8 @@ ptrunc.normal <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncnorm <- ptrunc.normal
 
 ptrunc.beta <- function(
@@ -57,6 +59,8 @@ ptrunc.beta <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncbeta <- ptrunc.beta
 
 ptrunc.binomial <- function(
@@ -70,6 +74,8 @@ ptrunc.binomial <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncbinom <- ptrunc.binomial
 
 ptrunc.poisson <- function(
@@ -83,6 +89,8 @@ ptrunc.poisson <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncpois <- ptrunc.poisson
 
 ptrunc.chisq <- function(q, df, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
@@ -94,6 +102,8 @@ ptrunc.chisq <- function(q, df, a = 0, b = Inf, ..., lower.tail = TRUE, log.p =
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncchisq <- ptrunc.chisq
 
 ptrunc.contbern <- function(q, lambda, a = 0, b = 1, ...) {
@@ -105,6 +115,8 @@ ptrunc.contbern <- function(q, lambda, a = 0, b = 1, ...) {
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptrunccontbern <- ptrunc.contbern
 
 ptrunc.exp <- function(q, rate = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
@@ -116,6 +128,8 @@ ptrunc.exp <- function(q, rate = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncexp <- ptrunc.exp
 
 ptrunc.gamma <- function(
@@ -132,6 +146,8 @@ ptrunc.gamma <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncgamma <- ptrunc.gamma
 
 ptrunc.invgamma <- function(
@@ -148,6 +164,8 @@ ptrunc.invgamma <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncinvgamma <- ptrunc.invgamma
 
 ptrunc.invgauss <- function(q, m, s, a = 0, b = Inf, ...) {
@@ -159,6 +177,8 @@ ptrunc.invgauss <- function(q, m, s, a = 0, b = Inf, ...) {
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncinvgauss <- ptrunc.invgauss
 
 ptrunc.lognormal <- function(
@@ -172,6 +192,8 @@ ptrunc.lognormal <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptrunclnorm <- ptrunc.lognormal
 
 ptrunc.nbinom <- function(
@@ -189,6 +211,8 @@ ptrunc.nbinom <- function(
 }
 
 #' @export
+#' @rdname ptrunc
+#' @inheritParams rtrunc
 ptruncnbinom <- ptrunc.nbinom
 
 truncated_p <- function(p_q, p_a, p_b, lower.tail = TRUE, log.p = FALSE) {
diff --git a/man/ptrunc.Rd b/man/ptrunc.Rd
index fdc92e8..53179cd 100644
--- a/man/ptrunc.Rd
+++ b/man/ptrunc.Rd
@@ -2,9 +2,111 @@
 % Please edit documentation in R/ptrunc.R
 \name{ptrunc}
 \alias{ptrunc}
+\alias{ptruncnorm}
+\alias{ptruncbeta}
+\alias{ptruncbinom}
+\alias{ptruncpois}
+\alias{ptruncchisq}
+\alias{ptrunccontbern}
+\alias{ptruncexp}
+\alias{ptruncgamma}
+\alias{ptruncinvgamma}
+\alias{ptruncinvgauss}
+\alias{ptrunclnorm}
+\alias{ptruncnbinom}
 \title{Cummulative Distribution Function}
 \usage{
 ptrunc(q, family, ..., lower.tail = TRUE, log.p = FALSE)
+
+ptruncnorm(
+  q,
+  mean = 0,
+  sd = 1,
+  a = -Inf,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+ptruncbeta(
+  q,
+  shape1,
+  shape2,
+  a = 0,
+  b = 1,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+ptruncbinom(
+  q,
+  size,
+  prob,
+  a = 0,
+  b = size,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+ptruncpois(q, lambda, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
+
+ptruncchisq(q, df, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
+
+ptrunccontbern(q, lambda, a = 0, b = 1, ...)
+
+ptruncexp(q, rate = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
+
+ptruncgamma(
+  q,
+  shape,
+  rate = 1,
+  scale = 1/rate,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+ptruncinvgamma(
+  q,
+  shape,
+  rate = 1,
+  scale = 1/rate,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+ptruncinvgauss(q, m, s, a = 0, b = Inf, ...)
+
+ptrunclnorm(
+  q,
+  meanlog = 0,
+  sdlog = 1,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+ptruncnbinom(
+  q,
+  size,
+  prob,
+  mu,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
 }
 \arguments{
 \item{q}{vector of quantiles}
@@ -18,6 +120,45 @@ ptrunc(q, family, ..., lower.tail = TRUE, log.p = FALSE)
 \eqn{P(X <= x)}{P(X \leq x)} otherwise, \eqn{P(X > x)}}
 
 \item{log.p}{logical; if \code{TRUE}, probabilities p are given as \code{log(p)}}
+
+\item{mean}{mean of parent distribution}
+
+\item{sd}{standard deviation is parent distribution}
+
+\item{a}{point of left truncation. For discrete distributions, \code{a} will be
+included in the support of the truncated distribution.}
+
+\item{b}{point of right truncation}
+
+\item{shape1}{positive shape parameter alpha}
+
+\item{shape2}{positive shape parameter beta}
+
+\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 on each trial}
+
+\item{lambda}{mean and var of "parent" distribution}
+
+\item{df}{degrees of freedom for "parent" distribution}
+
+\item{rate}{inverse gamma rate parameter}
+
+\item{shape}{inverse gamma shape parameter}
+
+\item{scale}{inverse gamma scale parameter}
+
+\item{m}{vector of means}
+
+\item{s}{vector of dispersion parameters}
+
+\item{meanlog}{mean of un-truncated distribution}
+
+\item{sdlog}{standard deviation of un-truncated distribution}
+
+\item{mu}{alternative parametrization via mean}
 }
 \value{
 The cummulative probability of y.

From 5d4f6b23d7c757b7f181f6ea30c12ad74a45d155 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <w.l.netto@medisin.uio.no>
Date: Wed, 21 Aug 2024 09:02:46 +0200
Subject: [PATCH 4/5] Added alias and tests for qtrunc (#54)

---
 NAMESPACE                     |  12 +++
 R/qtrunc.R                    |  88 +++++++++++++++++----
 man/qtrunc.Rd                 | 141 ++++++++++++++++++++++++++++++++++
 tests/testthat/test-aliases.R |  68 ++++++++++++++++
 4 files changed, 295 insertions(+), 14 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 2243881..7870249 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -108,6 +108,18 @@ export(ptruncnbinom)
 export(ptruncnorm)
 export(ptruncpois)
 export(qtrunc)
+export(qtruncbeta)
+export(qtruncbinom)
+export(qtruncchisq)
+export(qtrunccontbern)
+export(qtruncexp)
+export(qtruncgamma)
+export(qtruncinvgamma)
+export(qtruncinvgauss)
+export(qtrunclnorm)
+export(qtruncnbinom)
+export(qtruncnorm)
+export(qtruncpois)
 export(rtrunc)
 export(rtrunc.beta)
 export(rtrunc_direct)
diff --git a/R/qtrunc.R b/R/qtrunc.R
index aff7dd2..926415f 100644
--- a/R/qtrunc.R
+++ b/R/qtrunc.R
@@ -29,12 +29,12 @@ qtrunc <- function(p, family, ..., lower.tail = TRUE, log.p = FALSE) {
   return(unclass(quant))
 }
 
-qtrunc.generic <- function(p, ..., lower.tail, log.p) {
+qtrunc.generic <- function(p, ..., lower.tail = TRUE, log.p = FALSE) {
   UseMethod("qtrunc", p)
 }
 
 qtrunc.beta <- function(
-    p, shape1, shape2, a = 0, b = 1, ..., lower.tail, log.p
+    p, shape1, shape2, a = 0, b = 1, ..., lower.tail = TRUE, log.p = FALSE
   ) {
   F_a <- pbeta(a, shape1, shape2, ncp = 0, lower.tail, FALSE)
   F_b <- pbeta(b, shape1, shape2, ncp = 0, lower.tail, FALSE)
@@ -43,8 +43,13 @@ qtrunc.beta <- function(
   return(q)
 }
 
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncbeta <- qtrunc.beta
+
 qtrunc.binomial <- function(
-    p, size, prob, a = 0, b = size, ..., lower.tail, log.p
+    p, size, prob, a = 0, b = size, ..., lower.tail = TRUE, log.p = FALSE
   ) {
   F_a <- pbinom(a - 1L, size, prob, lower.tail, FALSE)
   F_b <- pbinom(b, size, prob, lower.tail, FALSE)
@@ -53,7 +58,12 @@ qtrunc.binomial <- function(
   return(q)
 }
 
-qtrunc.chisq <- function(p, df, a = 0, b = Inf, ..., lower.tail, log.p) {
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncbinom <- qtrunc.binomial
+
+qtrunc.chisq <- function(p, df, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
   F_a <- pchisq(a - 1L, df, ncp = 0, lower.tail, FALSE)
   F_b <- pchisq(b, df, ncp = 0, lower.tail, FALSE)
   rescaled_p <- rescale_p(p, F_a, F_b, lower.tail, log.p)
@@ -61,7 +71,12 @@ qtrunc.chisq <- function(p, df, a = 0, b = Inf, ..., lower.tail, log.p) {
   return(q)
 }
 
-qtrunc.contbern <- function(p, lambda, a = 0, b = 1, ..., lower.tail, log.p) {
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncchisq <- qtrunc.chisq
+
+qtrunc.contbern <- function(p, lambda, a = 0, b = 1, ..., lower.tail = TRUE, log.p = FALSE) {
   F_a <- pcontbern(a, lambda)
   F_b <- pcontbern(b, lambda)
   rescaled_p <- rescale_p(p, F_a, F_b, lower.tail, log.p)
@@ -69,7 +84,12 @@ qtrunc.contbern <- function(p, lambda, a = 0, b = 1, ..., lower.tail, log.p) {
   return(q)
 }
 
-qtrunc.exp <- function(p, rate = 1, a = 0, b = Inf, ..., lower.tail, log.p) {
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtrunccontbern <- qtrunc.contbern
+
+qtrunc.exp <- function(p, rate = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
   F_a <- pexp(a, rate, lower.tail, FALSE)
   F_b <- pexp(b, rate, lower.tail, FALSE)
   rescaled_p <- rescale_p(p, F_a, F_b, lower.tail, log.p)
@@ -77,8 +97,13 @@ qtrunc.exp <- function(p, rate = 1, a = 0, b = Inf, ..., lower.tail, log.p) {
   return(q)
 }
 
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncexp <- qtrunc.exp
+
 qtrunc.gamma <- function(
-  p, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail, log.p
+  p, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   F_a <- pgamma(a, shape, scale = scale, lower.tail = lower.tail, log.p = FALSE)
   F_b <- pgamma(b, shape, scale = scale, lower.tail = lower.tail, log.p = FALSE)
@@ -87,8 +112,13 @@ qtrunc.gamma <- function(
   return(q)
 }
 
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncgamma <- qtrunc.gamma
+
 qtrunc.invgamma <- function(
-  p, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail, log.p
+  p, shape, rate = 1, scale = 1 / rate, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
 ) {
   F_a <- pinvgamma(a, shape, scale = scale, lower.tail = lower.tail, log.p = FALSE)
   F_b <- pinvgamma(b, shape, scale = scale, lower.tail = lower.tail, log.p = FALSE)
@@ -97,7 +127,12 @@ qtrunc.invgamma <- function(
   return(q)
 }
 
-qtrunc.invgauss <- function(p, m, s, a = 0, b = Inf, ..., lower.tail, log.p) {
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncinvgamma <- qtrunc.invgamma
+
+qtrunc.invgauss <- function(p, m, s, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
   if (!lower.tail || log.p) {
     stop("Only lower.tail = TRUE and log.p = FALSE are supported.")
   }
@@ -108,8 +143,13 @@ qtrunc.invgauss <- function(p, m, s, a = 0, b = Inf, ..., lower.tail, log.p) {
   return(q)
 }
 
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncinvgauss <- qtrunc.invgauss
+
 qtrunc.lognormal <- function(
-    p, meanlog = 0, sdlog = 1, a = 0, b = Inf, ..., lower.tail, log.p
+    p, meanlog = 0, sdlog = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
   ) {
   F_a <- plnorm(a, meanlog, sdlog, lower.tail, FALSE)
   F_b <- plnorm(b, meanlog, sdlog, lower.tail, FALSE)
@@ -118,8 +158,13 @@ qtrunc.lognormal <- function(
   return(q)
 }
 
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtrunclnorm <- qtrunc.lognormal
+
 qtrunc.nbinom <- function(
-    p, size, prob, mu, a = 0, b = Inf, ..., lower.tail, log.p
+    p, size, prob, mu, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
   ) {
   if (missing(prob)) {
     prob <- size / (size + mu) # from help("pnbinom")
@@ -132,8 +177,13 @@ qtrunc.nbinom <- function(
   return(q)
 }
 
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncnbinom <- qtrunc.nbinom
+
 qtrunc.normal <- function(
-    p, mean = 0, sd = 1, a = -Inf, b = Inf, ..., lower.tail, log.p
+    p, mean = 0, sd = 1, a = -Inf, b = Inf, ..., lower.tail = TRUE, log.p = FALSE
   ) {
   F_a <- pnorm(a, mean, sd, lower.tail, FALSE)
   F_b <- pnorm(b, mean, sd, lower.tail, FALSE)
@@ -142,7 +192,12 @@ qtrunc.normal <- function(
   return(q)
 }
 
-qtrunc.poisson <- function(p, lambda, a = 0, b = Inf, ..., lower.tail, log.p) {
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncnorm <- qtrunc.normal
+
+qtrunc.poisson <- function(p, lambda, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE) {
   F_a <- ppois(a - 1L, lambda, lower.tail, FALSE)
   F_b <- ppois(b, lambda, lower.tail, FALSE)
   rescaled_p <- rescale_p(p, F_a, F_b, lower.tail, log.p)
@@ -150,7 +205,12 @@ qtrunc.poisson <- function(p, lambda, a = 0, b = Inf, ..., lower.tail, log.p) {
   return(q)
 }
 
-rescale_p <- function(p, F_a, F_b, lower.tail, log.p) {
+#' @export
+#' @rdname qtrunc
+#' @inheritParams rtrunc
+qtruncpois <- qtrunc.poisson
+
+rescale_p <- function(p, F_a, F_b, lower.tail = TRUE, log.p = FALSE) {
   if (log.p) {
     p <- exp(p)
   }
diff --git a/man/qtrunc.Rd b/man/qtrunc.Rd
index 3bb5340..ad3ad26 100644
--- a/man/qtrunc.Rd
+++ b/man/qtrunc.Rd
@@ -2,9 +2,111 @@
 % Please edit documentation in R/qtrunc.R
 \name{qtrunc}
 \alias{qtrunc}
+\alias{qtruncbeta}
+\alias{qtruncbinom}
+\alias{qtruncchisq}
+\alias{qtrunccontbern}
+\alias{qtruncexp}
+\alias{qtruncgamma}
+\alias{qtruncinvgamma}
+\alias{qtruncinvgauss}
+\alias{qtrunclnorm}
+\alias{qtruncnbinom}
+\alias{qtruncnorm}
+\alias{qtruncpois}
 \title{Quantile Function}
 \usage{
 qtrunc(p, family, ..., lower.tail = TRUE, log.p = FALSE)
+
+qtruncbeta(
+  p,
+  shape1,
+  shape2,
+  a = 0,
+  b = 1,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncbinom(
+  p,
+  size,
+  prob,
+  a = 0,
+  b = size,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncchisq(p, df, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
+
+qtrunccontbern(p, lambda, a = 0, b = 1, ..., lower.tail = TRUE, log.p = FALSE)
+
+qtruncexp(p, rate = 1, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
+
+qtruncgamma(
+  p,
+  shape,
+  rate = 1,
+  scale = 1/rate,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncinvgamma(
+  p,
+  shape,
+  rate = 1,
+  scale = 1/rate,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncinvgauss(p, m, s, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
+
+qtrunclnorm(
+  p,
+  meanlog = 0,
+  sdlog = 1,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncnbinom(
+  p,
+  size,
+  prob,
+  mu,
+  a = 0,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncnorm(
+  p,
+  mean = 0,
+  sd = 1,
+  a = -Inf,
+  b = Inf,
+  ...,
+  lower.tail = TRUE,
+  log.p = FALSE
+)
+
+qtruncpois(p, lambda, a = 0, b = Inf, ..., lower.tail = TRUE, log.p = FALSE)
 }
 \arguments{
 \item{p}{vector of quantiles}
@@ -18,6 +120,45 @@ qtrunc(p, family, ..., lower.tail = TRUE, log.p = FALSE)
 \eqn{P(X <= x)}{P(X \leq x)} otherwise, \eqn{P(X > x)}}
 
 \item{log.p}{logical; if \code{TRUE}, probabilities p are given as \code{log(p)}}
+
+\item{shape1}{positive shape parameter alpha}
+
+\item{shape2}{positive shape parameter beta}
+
+\item{a}{point of left truncation. For discrete distributions, \code{a} will be
+included in the support of the truncated distribution.}
+
+\item{b}{point of right truncation}
+
+\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 on each trial}
+
+\item{df}{degrees of freedom for "parent" distribution}
+
+\item{lambda}{mean and var of "parent" distribution}
+
+\item{rate}{inverse gamma rate parameter}
+
+\item{shape}{inverse gamma shape parameter}
+
+\item{scale}{inverse gamma scale parameter}
+
+\item{m}{vector of means}
+
+\item{s}{vector of dispersion parameters}
+
+\item{meanlog}{mean of un-truncated distribution}
+
+\item{sdlog}{standard deviation of un-truncated distribution}
+
+\item{mu}{alternative parametrization via mean}
+
+\item{mean}{mean of parent distribution}
+
+\item{sd}{standard deviation is parent distribution}
 }
 \value{
 The quantile of \code{p}.
diff --git a/tests/testthat/test-aliases.R b/tests/testthat/test-aliases.R
index 9a523b4..c6c2a8e 100644
--- a/tests/testthat/test-aliases.R
+++ b/tests/testthat/test-aliases.R
@@ -201,6 +201,74 @@ test_that("ptrunc works the same from generic and alias", {
   )
 })
 
+test_that("qtrunc works the same from generic and alias", {
+  gen_args <- function(FUN, ...) {
+    pb <- sort(runif(3))
+    qt <- FUN(pb, ...)
+    list("a" = qt[1], "p" = pb[2], "b" = qt[3])
+  }
+  x <- gen_args(qbeta, shape1 = 1, shape2 = 2)
+  expect_identical(
+    qtrunc(x$p, 1, 2, x$a, x$b, family = "beta"),
+    qtruncbeta(x$p, 1, 2, x$a, x$b)
+  )
+  x <- gen_args(qbinom, size = 50, prob = 0.3)
+  expect_identical(
+    qtrunc(x$p, 50, .3, x$a, x$b, family = "binomial"),
+    qtruncbinom(x$p, 50, .3, x$a, x$b)
+  )
+  x <- gen_args(qchisq, df = 23)
+  expect_identical(
+    qtrunc(x$p, 23, x$a, x$b, family = "chisq"),
+    qtruncchisq(x$p, 23, x$a, x$b)
+  )
+  x <- gen_args(qcontbern, lambda = 0.5)
+  expect_identical(
+    qtrunc(x$p, 0.5, x$a, x$b, family = "contbern"),
+    qtrunccontbern(x$p, 0.5, x$a, x$b)
+  )
+  x <- gen_args(qexp, rate = 26)
+  expect_identical(
+    qtrunc(x$p, 26, x$a, x$b, family = "exp"),
+    qtruncexp(x$p, 26, x$a, x$b)
+  )
+  x <- gen_args(qgamma, shape = 4, rate = 5)
+  expect_identical(
+    qtrunc(x$p, 4, 5, a = x$a, b = x$b, family = "gamma"),
+    qtruncgamma(x$p, 4, 5, a = x$a, b = x$b)
+  )
+  x <- gen_args(qinvgamma, shape = 4, scale = 6)
+  expect_identical(
+    qtrunc(x$p, 4, 6, a = x$a, b = x$b, family = "invgamma"),
+    qtruncinvgamma(x$p, 4, 6, a = x$a, b = x$b)
+  )
+  x <- gen_args(qinvgauss, m = 1, s = 3)
+  expect_identical(
+    qtrunc(x$p, 1, 3, a = x$a, b = x$b, family = "invgauss"),
+    qtruncinvgauss(x$p, 1, 3, a = x$a, b = x$b)
+  )
+  x <- gen_args(qlnorm, meanlog = 7, sdlog = 2)
+  expect_identical(
+    qtrunc(x$p, 7, 2, a = x$a, b = x$b, family = "lognormal"),
+    qtrunclnorm(x$p, 7, 2, a = x$a, b = x$b)
+  )
+  x <- gen_args(qnbinom, size = 55, prob = .4)
+  expect_identical(
+    qtrunc(x$p, 55, .4, a = x$a, b = x$b, family = "nbinom"),
+    qtruncnbinom(x$p, 55, .4, a = x$a, b = x$b)
+  )
+  x <- gen_args(qnorm, mean = 1, sd = 3)
+  expect_identical(
+    qtrunc(x$p, mean = 1, sd = 3, a = x$a, b = x$b),
+    qtruncnorm(x$p, mean = 1, sd = 3, a = x$a, b = x$b)
+  )
+  x <- gen_args(qpois, lambda = 72)
+  expect_identical(
+    qtrunc(x$p, 72, a = x$a, b = x$b, family = "poisson"),
+    qtruncpois(x$p, 72, a = x$a, b = x$b)
+  )
+})
+
 # ======================================================== #
 # rtrunc functions vs stats functions                      #
 # ======================================================== #

From f047c7ee6c7520cc2d7914d1101ef2d48185cee2 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <w.l.netto@medisin.uio.no>
Date: Wed, 21 Aug 2024 09:02:50 +0200
Subject: [PATCH 5/5] Increment version number to 1.1.1.9022

---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 781cd36..8b8bfcf 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: TruncExpFam
 Title: Truncated Exponential Family
-Version: 1.1.1.9021
+Version: 1.1.1.9022
 Date: 2024-02-26
 Authors@R:
 	c(