From 309e23dcc6e4987cc71a3b59e3bbe4173b65519c Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:47:43 -0800 Subject: [PATCH 01/20] Update documentation --- NAMESPACE | 4 ++++ _pkgdown.yml | 4 ++++ man/dev_bern.Rd | 1 + man/dev_beta_binom.Rd | 1 + man/dev_binom.Rd | 1 + man/dev_gamma.Rd | 1 + man/dev_gamma_count.Rd | 40 +++++++++++++++++++++++++++++++++ man/dev_gamma_pois.Rd | 1 + man/dev_lnorm.Rd | 1 + man/dev_neg_binom.Rd | 1 + man/dev_norm.Rd | 1 + man/dev_pois.Rd | 1 + man/dev_pois_zi.Rd | 1 + man/dev_skewnorm.Rd | 1 + man/dev_student.Rd | 1 + man/log_lik_bern.Rd | 1 + man/log_lik_beta_binom.Rd | 1 + man/log_lik_binom.Rd | 1 + man/log_lik_gamma.Rd | 1 + man/log_lik_gamma_count.Rd | 39 ++++++++++++++++++++++++++++++++ man/log_lik_gamma_pois.Rd | 1 + man/log_lik_gamma_pois_zi.Rd | 1 + man/log_lik_lnorm.Rd | 1 + man/log_lik_neg_binom.Rd | 1 + man/log_lik_norm.Rd | 1 + man/log_lik_pois.Rd | 1 + man/log_lik_pois_zi.Rd | 1 + man/log_lik_skewnorm.Rd | 1 + man/log_lik_student.Rd | 1 + man/ran_bern.Rd | 1 + man/ran_beta_binom.Rd | 1 + man/ran_binom.Rd | 1 + man/ran_gamma.Rd | 1 + man/ran_gamma_count.Rd | 39 ++++++++++++++++++++++++++++++++ man/ran_gamma_pois.Rd | 1 + man/ran_gamma_pois_zi.Rd | 1 + man/ran_lnorm.Rd | 1 + man/ran_neg_binom.Rd | 1 + man/ran_norm.Rd | 1 + man/ran_pois.Rd | 1 + man/ran_pois_zi.Rd | 1 + man/ran_skewnorm.Rd | 1 + man/ran_student.Rd | 1 + man/res_bern.Rd | 1 + man/res_beta_binom.Rd | 1 + man/res_binom.Rd | 1 + man/res_gamma.Rd | 1 + man/res_gamma_count.Rd | 43 ++++++++++++++++++++++++++++++++++++ man/res_gamma_pois.Rd | 1 + man/res_gamma_pois_zi.Rd | 1 + man/res_lnorm.Rd | 1 + man/res_neg_binom.Rd | 1 + man/res_norm.Rd | 1 + man/res_pois.Rd | 1 + man/res_pois_zi.Rd | 1 + man/res_skewnorm.Rd | 1 + man/res_student.Rd | 1 + 57 files changed, 220 insertions(+) create mode 100644 man/dev_gamma_count.Rd create mode 100644 man/log_lik_gamma_count.Rd create mode 100644 man/ran_gamma_count.Rd create mode 100644 man/res_gamma_count.Rd diff --git a/NAMESPACE b/NAMESPACE index 634a96b1..dc9a9690 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ export(dev_bern) export(dev_beta_binom) export(dev_binom) export(dev_gamma) +export(dev_gamma_count) export(dev_gamma_pois) export(dev_gamma_pois_zi) export(dev_lnorm) @@ -63,6 +64,7 @@ export(log_lik_bern) export(log_lik_beta_binom) export(log_lik_binom) export(log_lik_gamma) +export(log_lik_gamma_count) export(log_lik_gamma_pois) export(log_lik_gamma_pois_zi) export(log_lik_lnorm) @@ -100,6 +102,7 @@ export(ran_bern) export(ran_beta_binom) export(ran_binom) export(ran_gamma) +export(ran_gamma_count) export(ran_gamma_pois) export(ran_gamma_pois_zi) export(ran_lnorm) @@ -114,6 +117,7 @@ export(res_bern) export(res_beta_binom) export(res_binom) export(res_gamma) +export(res_gamma_count) export(res_gamma_pois) export(res_gamma_pois_zi) export(res_lnorm) diff --git a/_pkgdown.yml b/_pkgdown.yml index 0209b070..57ecb0fd 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -90,6 +90,7 @@ reference: - '`dev_beta_binom`' - '`dev_binom`' - '`dev_gamma`' + - '`dev_gamma_count`' - '`dev_gamma_pois`' - '`dev_gamma_pois_zi`' - '`dev_lnorm`' @@ -106,6 +107,7 @@ reference: - '`res_beta_binom`' - '`res_binom`' - '`res_gamma`' + - '`res_gamma_count`' - '`res_gamma_pois`' - '`res_gamma_pois_zi`' - '`res_lnorm`' @@ -122,6 +124,7 @@ reference: - '`log_lik_beta_binom`' - '`log_lik_binom`' - '`log_lik_gamma`' + - '`log_lik_gamma_count`' - '`log_lik_gamma_pois`' - '`log_lik_gamma_pois_zi`' - '`log_lik_lnorm`' @@ -138,6 +141,7 @@ reference: - '`ran_beta_binom`' - '`ran_binom`' - '`ran_gamma`' + - '`ran_gamma_count`' - '`ran_gamma_pois`' - '`ran_gamma_pois_zi`' - '`ran_lnorm`' diff --git a/man/dev_bern.Rd b/man/dev_bern.Rd index e920fb10..e230d6af 100644 --- a/man/dev_bern.Rd +++ b/man/dev_bern.Rd @@ -26,6 +26,7 @@ dev_bern(c(TRUE, FALSE), 0.7) Other dev_dist: \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_beta_binom.Rd b/man/dev_beta_binom.Rd index 4a14ed8f..2818709e 100644 --- a/man/dev_beta_binom.Rd +++ b/man/dev_beta_binom.Rd @@ -30,6 +30,7 @@ dev_beta_binom(c(0, 1, 2), 1, 0.5, 0) Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_binom.Rd b/man/dev_binom.Rd index cbe89098..de2a2c89 100644 --- a/man/dev_binom.Rd +++ b/man/dev_binom.Rd @@ -28,6 +28,7 @@ dev_binom(c(0, 1, 2), 2, 0.3) Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_gamma.Rd b/man/dev_gamma.Rd index cac20287..0b26c2fb 100644 --- a/man/dev_gamma.Rd +++ b/man/dev_gamma.Rd @@ -29,6 +29,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_lnorm}()}, \code{\link{dev_neg_binom}()}, diff --git a/man/dev_gamma_count.Rd b/man/dev_gamma_count.Rd new file mode 100644 index 00000000..051d5bf7 --- /dev/null +++ b/man/dev_gamma_count.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dev.R +\name{dev_gamma_count} +\alias{dev_gamma_count} +\title{Gamma-Count Deviances} +\usage{ +dev_gamma_count(x, lambda = 1, alpha = 1, res = FALSE) +} +\arguments{ +\item{x}{A non-negative whole numeric vector of values.} + +\item{lambda}{A non-negative numeric vector of means.} + +\item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} +} +\value{ +An numeric vector of the corresponding deviances or deviance residuals. +} +\description{ +Gamma-Count Deviances +} +\examples{ +dev_gamma_count(c(1,3.5,4), 3, 2) +} +\seealso{ +Other dev_dist: +\code{\link{dev_bern}()}, +\code{\link{dev_beta_binom}()}, +\code{\link{dev_binom}()}, +\code{\link{dev_gamma_pois}()}, +\code{\link{dev_gamma}()}, +\code{\link{dev_lnorm}()}, +\code{\link{dev_neg_binom}()}, +\code{\link{dev_norm}()}, +\code{\link{dev_pois_zi}()}, +\code{\link{dev_pois}()}, +\code{\link{dev_skewnorm}()}, +\code{\link{dev_student}()} +} +\concept{dev_dist} diff --git a/man/dev_gamma_pois.Rd b/man/dev_gamma_pois.Rd index 13758798..211f497f 100644 --- a/man/dev_gamma_pois.Rd +++ b/man/dev_gamma_pois.Rd @@ -29,6 +29,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, \code{\link{dev_neg_binom}()}, diff --git a/man/dev_lnorm.Rd b/man/dev_lnorm.Rd index 7a505195..26cb13ed 100644 --- a/man/dev_lnorm.Rd +++ b/man/dev_lnorm.Rd @@ -29,6 +29,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_neg_binom}()}, diff --git a/man/dev_neg_binom.Rd b/man/dev_neg_binom.Rd index 78248df6..4719fe4b 100644 --- a/man/dev_neg_binom.Rd +++ b/man/dev_neg_binom.Rd @@ -29,6 +29,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_norm.Rd b/man/dev_norm.Rd index af408cec..0cb05d38 100644 --- a/man/dev_norm.Rd +++ b/man/dev_norm.Rd @@ -29,6 +29,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_pois.Rd b/man/dev_pois.Rd index f271619d..6cc70e74 100644 --- a/man/dev_pois.Rd +++ b/man/dev_pois.Rd @@ -27,6 +27,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_pois_zi.Rd b/man/dev_pois_zi.Rd index 88cd86b8..df1ea65e 100644 --- a/man/dev_pois_zi.Rd +++ b/man/dev_pois_zi.Rd @@ -29,6 +29,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_skewnorm.Rd b/man/dev_skewnorm.Rd index dd71d386..02a16ce5 100644 --- a/man/dev_skewnorm.Rd +++ b/man/dev_skewnorm.Rd @@ -33,6 +33,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/dev_student.Rd b/man/dev_student.Rd index 3a3fb7a5..5e97a799 100644 --- a/man/dev_student.Rd +++ b/man/dev_student.Rd @@ -31,6 +31,7 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, +\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, diff --git a/man/log_lik_bern.Rd b/man/log_lik_bern.Rd index 1b83910c..2f91671f 100644 --- a/man/log_lik_bern.Rd +++ b/man/log_lik_bern.Rd @@ -24,6 +24,7 @@ log_lik_bern(c(TRUE, FALSE), 0.7) Other log_lik_dist: \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_beta_binom.Rd b/man/log_lik_beta_binom.Rd index 3ca731df..ba2c957b 100644 --- a/man/log_lik_beta_binom.Rd +++ b/man/log_lik_beta_binom.Rd @@ -28,6 +28,7 @@ log_lik_beta_binom(c(0, 1, 2), 1, 0.5, 0) Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_binom.Rd b/man/log_lik_binom.Rd index 260e47f9..20a81f9a 100644 --- a/man/log_lik_binom.Rd +++ b/man/log_lik_binom.Rd @@ -26,6 +26,7 @@ log_lik_binom(c(0, 1, 2), 2, 0.3) Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_gamma.Rd b/man/log_lik_gamma.Rd index 7dc2924e..7aa1ef36 100644 --- a/man/log_lik_gamma.Rd +++ b/man/log_lik_gamma.Rd @@ -27,6 +27,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_lnorm}()}, diff --git a/man/log_lik_gamma_count.Rd b/man/log_lik_gamma_count.Rd new file mode 100644 index 00000000..7dbaa280 --- /dev/null +++ b/man/log_lik_gamma_count.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/log-lik.R +\name{log_lik_gamma_count} +\alias{log_lik_gamma_count} +\title{Gamma-Count Log-Likelihood} +\usage{ +log_lik_gamma_count(x, lambda = 1, alpha = 1) +} +\arguments{ +\item{x}{A non-negative whole numeric vector of values.} + +\item{lambda}{A non-negative numeric vector of means.} +} +\value{ +An numeric vector of the corresponding log-likelihoods. +} +\description{ +Gamma-Count Log-Likelihood +} +\examples{ +log_lik_gamma_count(c(0, 1, 2), 1, 0) +} +\seealso{ +Other log_lik_dist: +\code{\link{log_lik_bern}()}, +\code{\link{log_lik_beta_binom}()}, +\code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_pois_zi}()}, +\code{\link{log_lik_gamma_pois}()}, +\code{\link{log_lik_gamma}()}, +\code{\link{log_lik_lnorm}()}, +\code{\link{log_lik_neg_binom}()}, +\code{\link{log_lik_norm}()}, +\code{\link{log_lik_pois_zi}()}, +\code{\link{log_lik_pois}()}, +\code{\link{log_lik_skewnorm}()}, +\code{\link{log_lik_student}()} +} +\concept{log_lik_dist} diff --git a/man/log_lik_gamma_pois.Rd b/man/log_lik_gamma_pois.Rd index 9046796e..991ed78f 100644 --- a/man/log_lik_gamma_pois.Rd +++ b/man/log_lik_gamma_pois.Rd @@ -27,6 +27,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma}()}, \code{\link{log_lik_lnorm}()}, diff --git a/man/log_lik_gamma_pois_zi.Rd b/man/log_lik_gamma_pois_zi.Rd index 41140716..cc7260f2 100644 --- a/man/log_lik_gamma_pois_zi.Rd +++ b/man/log_lik_gamma_pois_zi.Rd @@ -29,6 +29,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, \code{\link{log_lik_lnorm}()}, diff --git a/man/log_lik_lnorm.Rd b/man/log_lik_lnorm.Rd index f8fcfc2b..36f808d2 100644 --- a/man/log_lik_lnorm.Rd +++ b/man/log_lik_lnorm.Rd @@ -27,6 +27,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_neg_binom.Rd b/man/log_lik_neg_binom.Rd index 594587f1..d60f5df9 100644 --- a/man/log_lik_neg_binom.Rd +++ b/man/log_lik_neg_binom.Rd @@ -27,6 +27,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_norm.Rd b/man/log_lik_norm.Rd index 658e72a9..0688bd0f 100644 --- a/man/log_lik_norm.Rd +++ b/man/log_lik_norm.Rd @@ -27,6 +27,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_pois.Rd b/man/log_lik_pois.Rd index 3f1702eb..0e730a19 100644 --- a/man/log_lik_pois.Rd +++ b/man/log_lik_pois.Rd @@ -25,6 +25,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_pois_zi.Rd b/man/log_lik_pois_zi.Rd index b8c4fb6e..54bf33a1 100644 --- a/man/log_lik_pois_zi.Rd +++ b/man/log_lik_pois_zi.Rd @@ -27,6 +27,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_skewnorm.Rd b/man/log_lik_skewnorm.Rd index 1d68f612..bffbd526 100644 --- a/man/log_lik_skewnorm.Rd +++ b/man/log_lik_skewnorm.Rd @@ -31,6 +31,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/log_lik_student.Rd b/man/log_lik_student.Rd index 383b299a..a1689186 100644 --- a/man/log_lik_student.Rd +++ b/man/log_lik_student.Rd @@ -29,6 +29,7 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, +\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, diff --git a/man/ran_bern.Rd b/man/ran_bern.Rd index 1dbe3567..3cb82100 100644 --- a/man/ran_bern.Rd +++ b/man/ran_bern.Rd @@ -24,6 +24,7 @@ ran_bern(10) Other ran_dist: \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_beta_binom.Rd b/man/ran_beta_binom.Rd index 6f690441..1e32dc53 100644 --- a/man/ran_beta_binom.Rd +++ b/man/ran_beta_binom.Rd @@ -28,6 +28,7 @@ ran_beta_binom(10, 1, 0.5, 0) Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_binom.Rd b/man/ran_binom.Rd index 718ac1f7..15eeb5ca 100644 --- a/man/ran_binom.Rd +++ b/man/ran_binom.Rd @@ -26,6 +26,7 @@ ran_binom(10) Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_gamma.Rd b/man/ran_gamma.Rd index 3ad6a2d3..8bf0dba0 100644 --- a/man/ran_gamma.Rd +++ b/man/ran_gamma.Rd @@ -27,6 +27,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_lnorm}()}, diff --git a/man/ran_gamma_count.Rd b/man/ran_gamma_count.Rd new file mode 100644 index 00000000..c0a3b9f3 --- /dev/null +++ b/man/ran_gamma_count.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ran.R +\name{ran_gamma_count} +\alias{ran_gamma_count} +\title{Gamma-Count Random Samples} +\usage{ +ran_gamma_count(n = 1, lambda = 1, alpha = 1) +} +\arguments{ +\item{n}{A non-negative whole number of the number of random samples to generate.} + +\item{lambda}{A non-negative numeric vector of means.} +} +\value{ +A numeric vector of the random samples. +} +\description{ +Gamma-Count Random Samples +} +\examples{ +ran_gamma_count(n = 10, lambda = 1, alpha = 1) +} +\seealso{ +Other ran_dist: +\code{\link{ran_bern}()}, +\code{\link{ran_beta_binom}()}, +\code{\link{ran_binom}()}, +\code{\link{ran_gamma_pois_zi}()}, +\code{\link{ran_gamma_pois}()}, +\code{\link{ran_gamma}()}, +\code{\link{ran_lnorm}()}, +\code{\link{ran_neg_binom}()}, +\code{\link{ran_norm}()}, +\code{\link{ran_pois_zi}()}, +\code{\link{ran_pois}()}, +\code{\link{ran_skewnorm}()}, +\code{\link{ran_student}()} +} +\concept{ran_dist} diff --git a/man/ran_gamma_pois.Rd b/man/ran_gamma_pois.Rd index 679839df..084e9ffa 100644 --- a/man/ran_gamma_pois.Rd +++ b/man/ran_gamma_pois.Rd @@ -27,6 +27,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma}()}, \code{\link{ran_lnorm}()}, diff --git a/man/ran_gamma_pois_zi.Rd b/man/ran_gamma_pois_zi.Rd index e10d76ea..8c2e6330 100644 --- a/man/ran_gamma_pois_zi.Rd +++ b/man/ran_gamma_pois_zi.Rd @@ -29,6 +29,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, \code{\link{ran_lnorm}()}, diff --git a/man/ran_lnorm.Rd b/man/ran_lnorm.Rd index 3890f45e..985514cc 100644 --- a/man/ran_lnorm.Rd +++ b/man/ran_lnorm.Rd @@ -27,6 +27,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_neg_binom.Rd b/man/ran_neg_binom.Rd index bf4b16d8..ca69ed23 100644 --- a/man/ran_neg_binom.Rd +++ b/man/ran_neg_binom.Rd @@ -27,6 +27,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_norm.Rd b/man/ran_norm.Rd index 54dd58ca..5dceb585 100644 --- a/man/ran_norm.Rd +++ b/man/ran_norm.Rd @@ -27,6 +27,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_pois.Rd b/man/ran_pois.Rd index 08bff4da..76a2d5c6 100644 --- a/man/ran_pois.Rd +++ b/man/ran_pois.Rd @@ -25,6 +25,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_pois_zi.Rd b/man/ran_pois_zi.Rd index d5e810f9..46fc39f7 100644 --- a/man/ran_pois_zi.Rd +++ b/man/ran_pois_zi.Rd @@ -27,6 +27,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_skewnorm.Rd b/man/ran_skewnorm.Rd index ea47611a..abf9ff2d 100644 --- a/man/ran_skewnorm.Rd +++ b/man/ran_skewnorm.Rd @@ -31,6 +31,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/ran_student.Rd b/man/ran_student.Rd index 03b046f6..0dc5c32d 100644 --- a/man/ran_student.Rd +++ b/man/ran_student.Rd @@ -29,6 +29,7 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, +\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, diff --git a/man/res_bern.Rd b/man/res_bern.Rd index 8d37377a..423bae3f 100644 --- a/man/res_bern.Rd +++ b/man/res_bern.Rd @@ -28,6 +28,7 @@ res_bern(c(TRUE, FALSE), 0.7) Other res_dist: \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_beta_binom.Rd b/man/res_beta_binom.Rd index 74331467..8f6dceac 100644 --- a/man/res_beta_binom.Rd +++ b/man/res_beta_binom.Rd @@ -39,6 +39,7 @@ res_beta_binom(c(0, 1, 2), 4, 0.5, 0.1) Other res_dist: \code{\link{res_bern}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_binom.Rd b/man/res_binom.Rd index acb7b19b..0610504d 100644 --- a/man/res_binom.Rd +++ b/man/res_binom.Rd @@ -30,6 +30,7 @@ res_binom(c(0, 1, 2), 2, 0.3) Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_gamma.Rd b/man/res_gamma.Rd index 15fb6a97..785f08e5 100644 --- a/man/res_gamma.Rd +++ b/man/res_gamma.Rd @@ -31,6 +31,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_lnorm}()}, diff --git a/man/res_gamma_count.Rd b/man/res_gamma_count.Rd new file mode 100644 index 00000000..b805e52d --- /dev/null +++ b/man/res_gamma_count.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/res.R +\name{res_gamma_count} +\alias{res_gamma_count} +\title{Gamma-Count Residuals} +\usage{ +res_gamma_count(x, lambda = 1, alpha = 1, type = "dev", simulate = FALSE) +} +\arguments{ +\item{x}{A non-negative whole numeric vector of values.} + +\item{lambda}{A non-negative numeric vector of means.} + +\item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} + +\item{simulate}{A flag specifying whether to simulate residuals.} +} +\value{ +An numeric vector of the corresponding residuals. +} +\description{ +Gamma-Count Residuals +} +\examples{ +res_gamma_count(c(0, 1, 2), 1, 1) +} +\seealso{ +Other res_dist: +\code{\link{res_bern}()}, +\code{\link{res_beta_binom}()}, +\code{\link{res_binom}()}, +\code{\link{res_gamma_pois_zi}()}, +\code{\link{res_gamma_pois}()}, +\code{\link{res_gamma}()}, +\code{\link{res_lnorm}()}, +\code{\link{res_neg_binom}()}, +\code{\link{res_norm}()}, +\code{\link{res_pois_zi}()}, +\code{\link{res_pois}()}, +\code{\link{res_skewnorm}()}, +\code{\link{res_student}()} +} +\concept{res_dist} diff --git a/man/res_gamma_pois.Rd b/man/res_gamma_pois.Rd index 37684a98..080acccc 100644 --- a/man/res_gamma_pois.Rd +++ b/man/res_gamma_pois.Rd @@ -31,6 +31,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma}()}, \code{\link{res_lnorm}()}, diff --git a/man/res_gamma_pois_zi.Rd b/man/res_gamma_pois_zi.Rd index 6efeb624..0a18d251 100644 --- a/man/res_gamma_pois_zi.Rd +++ b/man/res_gamma_pois_zi.Rd @@ -40,6 +40,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, \code{\link{res_lnorm}()}, diff --git a/man/res_lnorm.Rd b/man/res_lnorm.Rd index 1e72b5a0..e6ef6d5d 100644 --- a/man/res_lnorm.Rd +++ b/man/res_lnorm.Rd @@ -31,6 +31,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_neg_binom.Rd b/man/res_neg_binom.Rd index 5d6f38f7..226efa29 100644 --- a/man/res_neg_binom.Rd +++ b/man/res_neg_binom.Rd @@ -31,6 +31,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_norm.Rd b/man/res_norm.Rd index 513dc4d4..b62c08db 100644 --- a/man/res_norm.Rd +++ b/man/res_norm.Rd @@ -31,6 +31,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_pois.Rd b/man/res_pois.Rd index 54e1e845..70250ab5 100644 --- a/man/res_pois.Rd +++ b/man/res_pois.Rd @@ -29,6 +29,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_pois_zi.Rd b/man/res_pois_zi.Rd index 68c907df..cf49b600 100644 --- a/man/res_pois_zi.Rd +++ b/man/res_pois_zi.Rd @@ -31,6 +31,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_skewnorm.Rd b/man/res_skewnorm.Rd index 88527684..a70952cd 100644 --- a/man/res_skewnorm.Rd +++ b/man/res_skewnorm.Rd @@ -33,6 +33,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, diff --git a/man/res_student.Rd b/man/res_student.Rd index e7c430d5..935e9781 100644 --- a/man/res_student.Rd +++ b/man/res_student.Rd @@ -33,6 +33,7 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, +\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, From e7ffb02240d894fe83e82768f194098c3c91ade3 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:48:53 -0800 Subject: [PATCH 02/20] - Add `ran_gamma_count()`, `log_lik_gamma_count()`, `dev_gamma_count()`, and `res_gamma_count()` --- R/dev.R | 94 +++++++++++++++++++++++++++++++++++++++++++++++++++++ R/log-lik.R | 39 ++++++++++++++++++++++ R/ran.R | 19 +++++++++++ R/res.R | 57 ++++++++++++++++++++++++++++++++ 4 files changed, 209 insertions(+) diff --git a/R/dev.R b/R/dev.R index 7eed333f..4554f12f 100644 --- a/R/dev.R +++ b/R/dev.R @@ -97,6 +97,100 @@ dev_gamma <- function(x, shape = 1, rate = 1, res = FALSE) { dev_res(x, mu, dev) } +#' Gamma-Count Deviances +#' +#' @inheritParams params +#' @param x A non-negative whole numeric vector of values. +#' +#' @return An numeric vector of the corresponding deviances or deviance residuals. +#' @family dev_dist +#' @export +#' +#' @examples +#' dev_gamma_count(c(1,3.5,4), 3, 2) +dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { + # Close, but doesn't work for small lambda and alpha + # dev <- log_lik_gamma_count(x, lambda = x, alpha = alpha) - + # log_lik_gamma_count(x, lambda = lambda, alpha = alpha) + # dev <- dev * 2 + # if(vld_false(res)) return(dev) + # dev_res(x, lambda, dev) + + opt_gamma_count <- function(pars = c(log_lambda, log_alpha), x) { + -log_lik_gamma_count(x = x, lambda = exp(pars[1]), alpha = exp(pars[2])) + } + if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} + if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} + opt_lambda <- rep(NA, length(x)) + opt_alpha <- rep(NA, length(x)) + bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) + for (i in seq_along(x)) { + if (bol[i] & !is.na(bol[i])) { + opt <- stats::optim( + par = c(log(lambda[i]), log(alpha[i])), + fn = opt_gamma_count, + x = x[i], + method = "Nelder-Mead" + )$par + opt_lambda[i] <- exp(opt[1]) + opt_alpha[i] <- exp(opt[2]) + } + } + + # opt_gamma_count <- function(alpha, x, lambda) { + # -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) + # } + # if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} + # if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} + # opt_alpha <- rep(NA, length(x)) + # bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) + # for (i in seq_along(x)) { + # if (bol[i] & !is.na(bol[i])) { + # opt_alpha[i] <- stats::optimize( + # opt_gamma_count, + # interval = c(0, 100), + # x = x[i], + # lambda = lambda[i] + # )$minimum + # } + # } + + dev1 <- log_lik_gamma_count(x = x, lambda = opt_lambda, alpha = opt_alpha) + dev2 <- log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) + + # dev <- tibble(x = rep(x, 2), dev = c(dev1, dev2), lik = c(rep("sat", length(dev1)), rep("reg", length(dev2)))) + # + # ggplot() + + # geom_line(data = dev, aes(x = x, y = dev, colour = lik)) + + + # # normal example + # mean <- 100 + # sd <- 0.5 + # set.seed(101) + # x_norm <- rnorm(100, mean, sd) + # sat_norm <- log_lik_norm(x, mean = x, sd = sd) + # ll_norm <- log_lik_norm(x, mean = mean, sd = sd) + # dev_norm <- tibble( + # x = rep(x_norm, 2), + # dev = c(ll_norm, sat_norm), + # lik = rep(c("reg", "sat"), each = length(x_norm)) + # ) + # ggplot(dev_norm) + + # geom_line(aes(x = x, y = dev, colour = lik)) + dev <- dev1 - dev2 + dev <- 2 * dev + use_pois <- (!is.na(alpha) & alpha == 1) + dev_pois <- dev_pois(x = x, lambda = lambda, res = res) + dev[use_pois] <- dev_pois[use_pois] + if(vld_false(res)) return(dev) + gc_mean <- rep(NaN, length(x)) + for (i in 1:length(x)) { + gc_mean[i] <- mean_gamma_count(lambda[i], alpha[i]) + } + dev_res(x, gc_mean, dev) +} + #' Gamma-Poisson Deviances #' #' @inheritParams params diff --git a/R/log-lik.R b/R/log-lik.R index 487b739b..ca7a2972 100644 --- a/R/log-lik.R +++ b/R/log-lik.R @@ -78,6 +78,45 @@ log_lik_gamma <- function(x, shape = 1, rate = 1) { stats::dgamma(x, shape = shape, rate = rate, log = TRUE) } +#' Gamma-Count Log-Likelihood +#' +#' @inheritParams params +#' @param x A non-negative whole numeric vector of values. +#' +#' @return An numeric vector of the corresponding log-likelihoods. +#' @family log_lik_dist +#' @export +#' +#' @examples +#' log_lik_gamma_count(c(0, 1, 2), 1, 0) +log_lik_gamma_count <- function(x, lambda = 1, alpha = 1) { + chk::chk_compatible_lengths(x, lambda, alpha) + chk::chk_all(c(lambda, alpha), chk_fun = "chk_gte", value = 0) + # gammacount::dgc(x = x, lambda = lambda, alpha = alpha, log = TRUE) + # rmutil::dgammacount(y = x, m = lambda, s = alpha, log = TRUE) + x_zero <- x == 0 + x_pos <- x > 0 + x_neg <- x < 0 + lik <- rep(NaN, max(length(x), length(lambda), length(alpha))) + if (length(x) == 1) { + x <- rep(x, length(lik)) + } + if (length(alpha) == 1) { + alpha <- rep(alpha, length(lik)) + } + if (length(lambda) == 1) { + lambda <- rep(lambda, length(lik)) + } + lik[x_zero] <- stats::pgamma(q = 1, shape = alpha[x_zero], rate = alpha[x_zero] * lambda[x_zero], lower.tail = FALSE) + lik[x_pos] <- stats::pgamma(q = 1, shape = x[x_pos] * alpha[x_pos], rate = alpha[x_pos] * lambda[x_pos]) - + stats::pgamma(q = 1, shape = (x[x_pos] + 1) * alpha[x_pos], rate = alpha[x_pos] * lambda[x_pos]) + # lik[x_zero] <- pgamma(alpha[x_zero] * lambda[x_zero], (x[x_zero] + 1) * alpha[x_zero], lower.tail = FALSE) + # lik[x_pos] <- pgamma(alpha[x_pos] * lambda[x_pos], x[x_pos] * alpha[x_pos]) - + # pgamma(alpha[x_pos] * lambda[x_pos], (x[x_pos] + 1) * alpha[x_pos]) + lik[x_neg] <- 0 + log(lik) +} + #' Gamma-Poisson Log-Likelihood #' #' @inheritParams params diff --git a/R/ran.R b/R/ran.R index f43937b2..c1727ffe 100644 --- a/R/ran.R +++ b/R/ran.R @@ -63,6 +63,25 @@ ran_gamma <- function(n = 1, shape = 1, rate = 1) { stats::rgamma(n, shape = shape, rate = rate) } +#' Gamma-Count Random Samples +#' +#' @inheritParams params +#' @return A numeric vector of the random samples. +#' @family ran_dist +#' @export +#' +#' @examples +#' ran_gamma_count(n = 10, lambda = 1, alpha = 1) +ran_gamma_count <- function(n = 1, lambda = 1, alpha = 1) { + chk_whole_number(n) + chk_all(c(n, lambda), chk_fun = "chk_gte", value = 0) + chk_gt(alpha, value = 0) + if (alpha == 1) { + return(stats::rpois(n, lambda = lambda)) + } + gammacount::rgc(n = n, lambda = lambda, alpha = alpha) +} + #' Gamma-Poisson Random Samples #' #' @inheritParams params diff --git a/R/res.R b/R/res.R index 84cd4a3f..4462350c 100644 --- a/R/res.R +++ b/R/res.R @@ -108,6 +108,63 @@ res_gamma <- function(x, shape = 1, rate = 1, type = "dev", simulate = FALSE) { chk_subset(x, c("data", "raw", "dev", "standardized"))) } +res_gamma_count_standardized <- function(x, lambda, alpha) { + mean <- 0 + var_1 <- 0 + iter <- 1 + i <- 1 + while (iter > 1e-12) { + iter <- pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) + mean <- mean + iter + var_1 <- var_1 + ((2 * i - 1) * iter) + i <- i + 1 + } + var <- var_1 - mean^2 + x - mean / sqrt(var) +} + +mean_gamma_count <- function(lambda, alpha) { + mean <- 0 + iter <- 1 + i <- 1 + while (iter > 1e-12) { + iter <- pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) + mean <- mean + iter + i <- i + 1 + } + mean +} + +#' Gamma-Count Residuals +#' +#' @inheritParams params +#' @param x A non-negative whole numeric vector of values. +#' +#' @return An numeric vector of the corresponding residuals. +#' @family res_dist +#' @export +#' +#' @examples +#' res_gamma_count(c(0, 1, 2), 1, 1) +res_gamma_count <- function(x, lambda = 1, alpha = 1, type = "dev", simulate = FALSE) { + chk_string(type) + if(!vld_false(simulate)) { + x <- ran_gamma_count(length(x), lambda = lambda, alpha = alpha) + } + if (length(lambda) == 1) { + lambda <- rep(lambda, length(x)) + } + if (length(alpha) == 1) { + alpha <- rep(alpha, length(x)) + } + switch(type, + data = x, + raw = x - Vectorize(mean_gamma_count)(lambda = lambda, alpha = alpha), + standardized = Vectorize(res_gamma_count_standardized)(x = x, lambda = lambda, alpha = alpha), + dev = dev_gamma_count(x, lambda = lambda, alpha = alpha, res = TRUE), + chk_subset(x, c("data", "raw", "dev", "standardized"))) +} + #' Gamma-Poisson Residuals #' #' @inheritParams params From 733e27825bc3af74514840de9955fd962a105b13 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:56:04 -0800 Subject: [PATCH 03/20] Add alpha parameter --- R/params.R | 1 + man/dev_gamma_count.Rd | 2 ++ man/log_lik_gamma_count.Rd | 2 ++ man/params.Rd | 2 ++ man/ran_gamma_count.Rd | 2 ++ man/res_gamma_count.Rd | 2 ++ 6 files changed, 11 insertions(+) diff --git a/R/params.R b/R/params.R index db18c7fd..debf0ea4 100644 --- a/R/params.R +++ b/R/params.R @@ -29,5 +29,6 @@ #' @param lower.tail A flag specifying whether to return the lower or upper tail of the distribution. #' @param q A vector of quantiles. #' @param p A vector of probabilities. +#' @param alpha A non-negative numeric vector of the dispersion parameter for the gamma-count distribution. #' @name params NULL diff --git a/man/dev_gamma_count.Rd b/man/dev_gamma_count.Rd index 051d5bf7..67708b49 100644 --- a/man/dev_gamma_count.Rd +++ b/man/dev_gamma_count.Rd @@ -11,6 +11,8 @@ dev_gamma_count(x, lambda = 1, alpha = 1, res = FALSE) \item{lambda}{A non-negative numeric vector of means.} +\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} + \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } \value{ diff --git a/man/log_lik_gamma_count.Rd b/man/log_lik_gamma_count.Rd index 7dbaa280..b928ebdf 100644 --- a/man/log_lik_gamma_count.Rd +++ b/man/log_lik_gamma_count.Rd @@ -10,6 +10,8 @@ log_lik_gamma_count(x, lambda = 1, alpha = 1) \item{x}{A non-negative whole numeric vector of values.} \item{lambda}{A non-negative numeric vector of means.} + +\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} } \value{ An numeric vector of the corresponding log-likelihoods. diff --git a/man/params.Rd b/man/params.Rd index 1c65775b..7bdbf90a 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -57,6 +57,8 @@ should be returned as negative values.} \item{q}{A vector of quantiles.} \item{p}{A vector of probabilities.} + +\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} } \description{ Parameter Descriptions diff --git a/man/ran_gamma_count.Rd b/man/ran_gamma_count.Rd index c0a3b9f3..cf2bb91a 100644 --- a/man/ran_gamma_count.Rd +++ b/man/ran_gamma_count.Rd @@ -10,6 +10,8 @@ ran_gamma_count(n = 1, lambda = 1, alpha = 1) \item{n}{A non-negative whole number of the number of random samples to generate.} \item{lambda}{A non-negative numeric vector of means.} + +\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} } \value{ A numeric vector of the random samples. diff --git a/man/res_gamma_count.Rd b/man/res_gamma_count.Rd index b805e52d..85c613e4 100644 --- a/man/res_gamma_count.Rd +++ b/man/res_gamma_count.Rd @@ -11,6 +11,8 @@ res_gamma_count(x, lambda = 1, alpha = 1, type = "dev", simulate = FALSE) \item{lambda}{A non-negative numeric vector of means.} +\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} + \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} \item{simulate}{A flag specifying whether to simulate residuals.} From 97541ac25c6836bf914562ee4080192b72840682 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:56:28 -0800 Subject: [PATCH 04/20] Import pgamma --- NAMESPACE | 1 + R/namespace.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index dc9a9690..8bed1c7a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -148,3 +148,4 @@ importFrom(stats,dlnorm) importFrom(stats,dnbinom) importFrom(stats,dnorm) importFrom(stats,dpois) +importFrom(stats,pgamma) diff --git a/R/namespace.R b/R/namespace.R index 592b2d31..5e51c71b 100644 --- a/R/namespace.R +++ b/R/namespace.R @@ -1,3 +1,3 @@ #' @import chk -#' @importFrom stats dbinom dlnorm dnorm dpois dnbinom +#' @importFrom stats dbinom dlnorm dnorm dpois dnbinom pgamma NULL From 030edfc60edaedb70caef0275cf25cb3125bfa83 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:56:38 -0800 Subject: [PATCH 05/20] Suggest gammacount package --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index dfb2f18e..3a0ec180 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Suggests: aods3, covr, hms, + gammacount, ggplot2, knitr, MASS, From 78d5729848666f8b9398c6e37ace71da4219ebe3 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:56:49 -0800 Subject: [PATCH 06/20] Specify pgamma package --- R/res.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/res.R b/R/res.R index 4462350c..c1ab7cac 100644 --- a/R/res.R +++ b/R/res.R @@ -114,7 +114,7 @@ res_gamma_count_standardized <- function(x, lambda, alpha) { iter <- 1 i <- 1 while (iter > 1e-12) { - iter <- pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) + iter <- stats::pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) mean <- mean + iter var_1 <- var_1 + ((2 * i - 1) * iter) i <- i + 1 @@ -128,7 +128,7 @@ mean_gamma_count <- function(lambda, alpha) { iter <- 1 i <- 1 while (iter > 1e-12) { - iter <- pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) + iter <- stats::pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) mean <- mean + iter i <- i + 1 } From 24d16ab80d177786cbbc515cf6e6741dd5f8eaa3 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Tue, 21 Nov 2023 16:57:10 -0800 Subject: [PATCH 07/20] Get rid of unnecessary names to arguments --- R/dev.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dev.R b/R/dev.R index 4554f12f..d01e6601 100644 --- a/R/dev.R +++ b/R/dev.R @@ -116,7 +116,7 @@ dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { # if(vld_false(res)) return(dev) # dev_res(x, lambda, dev) - opt_gamma_count <- function(pars = c(log_lambda, log_alpha), x) { + opt_gamma_count <- function(pars, x) { -log_lik_gamma_count(x = x, lambda = exp(pars[1]), alpha = exp(pars[2])) } if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} From c1724db79e2b72158b570e92b46ce0c7e6e49dfb Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Thu, 23 Nov 2023 08:36:13 -0800 Subject: [PATCH 08/20] More gamma-count --- R/dev.R | 83 +++++++++++++++++++++++++++++++++++++---------------- R/log-lik.R | 6 ++-- R/ran.R | 12 ++++++-- 3 files changed, 73 insertions(+), 28 deletions(-) diff --git a/R/dev.R b/R/dev.R index d01e6601..53b2c771 100644 --- a/R/dev.R +++ b/R/dev.R @@ -116,6 +116,12 @@ dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { # if(vld_false(res)) return(dev) # dev_res(x, lambda, dev) + n <- 1000 + lambda <- 6.21 + alpha <- 4.8421053 + set.seed(101) + x <- ran_gamma_count(n, lambda, alpha) + opt_gamma_count <- function(pars, x) { -log_lik_gamma_count(x = x, lambda = exp(pars[1]), alpha = exp(pars[2])) } @@ -137,31 +143,59 @@ dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { } } - # opt_gamma_count <- function(alpha, x, lambda) { - # -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) - # } - # if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} - # if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} - # opt_alpha <- rep(NA, length(x)) - # bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) - # for (i in seq_along(x)) { - # if (bol[i] & !is.na(bol[i])) { - # opt_alpha[i] <- stats::optimize( - # opt_gamma_count, - # interval = c(0, 100), - # x = x[i], - # lambda = lambda[i] - # )$minimum - # } - # } + opt_gamma_count <- function(pars, x) { + ll <- log_lik_gamma_count(x = x, lambda = exp(pars[1]), alpha = exp(pars[2])) + -sum(ll) + } + if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} + if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} + opt_lambda <- rep(NA, length(x)) + opt_alpha <- rep(NA, length(x)) + bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) + if (all(bol & !is.na(bol))) { + opt <- stats::optim( + par = c(log(mean(x)), log(1)), + fn = opt_gamma_count, + x = x, + method = "Nelder-Mead" + )$par + opt_lambda <- exp(opt[1]) + opt_alpha <- exp(opt[2]) + } + + opt_lambda + opt_alpha + # Returns the correct parameter values when fitted to the whole set of (lots of) data + # Means log-likelihood is correct. + - dev1 <- log_lik_gamma_count(x = x, lambda = opt_lambda, alpha = opt_alpha) + + opt_gamma_count <- function(alpha, x, lambda) { + -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) + } + if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} + if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} + opt_alpha <- rep(NA, length(x)) + bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) + for (i in seq_along(x)) { + if (bol[i] & !is.na(bol[i])) { + opt_alpha[i] <- stats::optimize( + opt_gamma_count, + interval = c(0, 1e10), + x = x[i], + lambda = lambda[i] + )$minimum + } + } + + # dev1 <- log_lik_gamma_count(x = x, lambda = x, alpha = opt_alpha) + dev1 <- log_lik_gamma_count(x = x, lambda = x, alpha = opt_alpha) dev2 <- log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) - # dev <- tibble(x = rep(x, 2), dev = c(dev1, dev2), lik = c(rep("sat", length(dev1)), rep("reg", length(dev2)))) - # - # ggplot() + - # geom_line(data = dev, aes(x = x, y = dev, colour = lik)) + dev <- tibble(x = rep(x, 2), ll = c(dev1, dev2), lik = c(rep("sat", length(dev1)), rep("reg", length(dev2)))) + + ggplot() + + geom_line(data = dev, aes(x = x, y = ll, colour = lik)) # # normal example @@ -169,8 +203,8 @@ dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { # sd <- 0.5 # set.seed(101) # x_norm <- rnorm(100, mean, sd) - # sat_norm <- log_lik_norm(x, mean = x, sd = sd) - # ll_norm <- log_lik_norm(x, mean = mean, sd = sd) + # sat_norm <- log_lik_norm(x_norm, mean = x_norm, sd = sd) + # ll_norm <- log_lik_norm(x_norm, mean = mean, sd = sd) # dev_norm <- tibble( # x = rep(x_norm, 2), # dev = c(ll_norm, sat_norm), @@ -178,6 +212,7 @@ dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { # ) # ggplot(dev_norm) + # geom_line(aes(x = x, y = dev, colour = lik)) + dev <- dev1 - dev2 dev <- 2 * dev use_pois <- (!is.na(alpha) & alpha == 1) diff --git a/R/log-lik.R b/R/log-lik.R index ca7a2972..7e1c1603 100644 --- a/R/log-lik.R +++ b/R/log-lik.R @@ -91,7 +91,9 @@ log_lik_gamma <- function(x, shape = 1, rate = 1) { #' log_lik_gamma_count(c(0, 1, 2), 1, 0) log_lik_gamma_count <- function(x, lambda = 1, alpha = 1) { chk::chk_compatible_lengths(x, lambda, alpha) - chk::chk_all(c(lambda, alpha), chk_fun = "chk_gte", value = 0) + chk::chk_gt(alpha, value = 0) + chk::chk_gte(lambda, value = 0) + # gammacount::dgc(x = x, lambda = lambda, alpha = alpha, log = TRUE) # rmutil::dgammacount(y = x, m = lambda, s = alpha, log = TRUE) x_zero <- x == 0 @@ -107,10 +109,10 @@ log_lik_gamma_count <- function(x, lambda = 1, alpha = 1) { if (length(lambda) == 1) { lambda <- rep(lambda, length(lik)) } + # lik[x_zero] <- stats::pgamma(alpha[x_zero] * lambda[x_zero], (x[x_zero] + 1) * alpha[x_zero], lower.tail = FALSE) lik[x_zero] <- stats::pgamma(q = 1, shape = alpha[x_zero], rate = alpha[x_zero] * lambda[x_zero], lower.tail = FALSE) lik[x_pos] <- stats::pgamma(q = 1, shape = x[x_pos] * alpha[x_pos], rate = alpha[x_pos] * lambda[x_pos]) - stats::pgamma(q = 1, shape = (x[x_pos] + 1) * alpha[x_pos], rate = alpha[x_pos] * lambda[x_pos]) - # lik[x_zero] <- pgamma(alpha[x_zero] * lambda[x_zero], (x[x_zero] + 1) * alpha[x_zero], lower.tail = FALSE) # lik[x_pos] <- pgamma(alpha[x_pos] * lambda[x_pos], x[x_pos] * alpha[x_pos]) - # pgamma(alpha[x_pos] * lambda[x_pos], (x[x_pos] + 1) * alpha[x_pos]) lik[x_neg] <- 0 diff --git a/R/ran.R b/R/ran.R index c1727ffe..1e4633b5 100644 --- a/R/ran.R +++ b/R/ran.R @@ -74,9 +74,17 @@ ran_gamma <- function(n = 1, shape = 1, rate = 1) { #' ran_gamma_count(n = 10, lambda = 1, alpha = 1) ran_gamma_count <- function(n = 1, lambda = 1, alpha = 1) { chk_whole_number(n) - chk_all(c(n, lambda), chk_fun = "chk_gte", value = 0) + chk_gte(n, value = 0) + chk_gt(lambda, value = 0) chk_gt(alpha, value = 0) - if (alpha == 1) { + if (length(lambda) == 1) { + lambda <- rep(lambda, n) + } + if (length(alpha) == 1) { + alpha <- rep(alpha, n) + } + bol_alpha <- alpha == 1 + if (all(bol_alpha) & all(!is.na(alpha))) { return(stats::rpois(n, lambda = lambda)) } gammacount::rgc(n = n, lambda = lambda, alpha = alpha) From 95fface73f401bdc41f472618278df505d483c43 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Thu, 23 Nov 2023 15:35:19 -0800 Subject: [PATCH 09/20] - Add `ran_upois()`, `log_lik_upois()`, `dev_upois()`, and `res_upois()` --- NAMESPACE | 8 +- R/dev.R | 152 +++++------------ R/log-lik.R | 64 +++++--- R/ran.R | 65 ++++++-- R/res.R | 42 +---- R/test-dev-upois-2.R | 153 ++++++++++++++++++ R/test-dev-upois.R | 149 +++++++++++++++++ _pkgdown.yml | 4 - man/dev_bern.Rd | 4 +- man/dev_beta_binom.Rd | 4 +- man/dev_binom.Rd | 4 +- man/dev_gamma.Rd | 4 +- man/dev_gamma_pois.Rd | 4 +- man/dev_lnorm.Rd | 4 +- man/dev_neg_binom.Rd | 4 +- man/dev_norm.Rd | 4 +- man/dev_pois.Rd | 4 +- man/dev_pois_zi.Rd | 4 +- man/dev_skewnorm.Rd | 4 +- man/dev_student.Rd | 4 +- man/{dev_gamma_count.Rd => dev_upois.Rd} | 14 +- man/log_lik_bern.Rd | 4 +- man/log_lik_beta_binom.Rd | 4 +- man/log_lik_binom.Rd | 4 +- man/log_lik_gamma.Rd | 4 +- man/log_lik_gamma_pois.Rd | 4 +- man/log_lik_gamma_pois_zi.Rd | 4 +- man/log_lik_lnorm.Rd | 4 +- man/log_lik_neg_binom.Rd | 4 +- man/log_lik_norm.Rd | 4 +- man/log_lik_pois.Rd | 4 +- man/log_lik_pois_zi.Rd | 4 +- man/log_lik_skewnorm.Rd | 4 +- man/log_lik_student.Rd | 4 +- ...og_lik_gamma_count.Rd => log_lik_upois.Rd} | 14 +- man/ran_bern.Rd | 4 +- man/ran_beta_binom.Rd | 4 +- man/ran_binom.Rd | 4 +- man/ran_gamma.Rd | 4 +- man/ran_gamma_pois.Rd | 4 +- man/ran_gamma_pois_zi.Rd | 4 +- man/ran_lnorm.Rd | 4 +- man/ran_neg_binom.Rd | 4 +- man/ran_norm.Rd | 4 +- man/ran_pois.Rd | 4 +- man/ran_pois_zi.Rd | 4 +- man/ran_skewnorm.Rd | 4 +- man/ran_student.Rd | 4 +- man/{ran_gamma_count.Rd => ran_upois.Rd} | 14 +- man/res_bern.Rd | 4 +- man/res_beta_binom.Rd | 4 +- man/res_binom.Rd | 4 +- man/res_gamma.Rd | 4 +- man/res_gamma_pois.Rd | 4 +- man/res_gamma_pois_zi.Rd | 4 +- man/res_lnorm.Rd | 4 +- man/res_neg_binom.Rd | 4 +- man/res_norm.Rd | 4 +- man/res_pois.Rd | 4 +- man/res_pois_zi.Rd | 4 +- man/res_skewnorm.Rd | 4 +- man/res_student.Rd | 4 +- man/{res_gamma_count.Rd => res_upois.Rd} | 10 +- tests/testthat/test-dev.R | 74 +++++++++ tests/testthat/test-log-lik.R | 40 +++++ tests/testthat/test-ran.R | 38 +++++ tests/testthat/test-res.R | 33 ++++ 67 files changed, 756 insertions(+), 322 deletions(-) create mode 100644 R/test-dev-upois-2.R create mode 100644 R/test-dev-upois.R rename man/{dev_gamma_count.Rd => dev_upois.Rd} (72%) rename man/{log_lik_gamma_count.Rd => log_lik_upois.Rd} (71%) rename man/{ran_gamma_count.Rd => ran_upois.Rd} (69%) rename man/{res_gamma_count.Rd => res_upois.Rd} (78%) diff --git a/NAMESPACE b/NAMESPACE index 8bed1c7a..5f2ad19c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,7 +36,6 @@ export(dev_bern) export(dev_beta_binom) export(dev_binom) export(dev_gamma) -export(dev_gamma_count) export(dev_gamma_pois) export(dev_gamma_pois_zi) export(dev_lnorm) @@ -46,6 +45,7 @@ export(dev_pois) export(dev_pois_zi) export(dev_skewnorm) export(dev_student) +export(dev_upois) export(dskewnorm) export(exp10) export(exp2) @@ -64,7 +64,6 @@ export(log_lik_bern) export(log_lik_beta_binom) export(log_lik_binom) export(log_lik_gamma) -export(log_lik_gamma_count) export(log_lik_gamma_pois) export(log_lik_gamma_pois_zi) export(log_lik_lnorm) @@ -74,6 +73,7 @@ export(log_lik_pois) export(log_lik_pois_zi) export(log_lik_skewnorm) export(log_lik_student) +export(log_lik_upois) export(log_odds) export(log_odds_ratio) export(log_odds_ratio2) @@ -102,7 +102,6 @@ export(ran_bern) export(ran_beta_binom) export(ran_binom) export(ran_gamma) -export(ran_gamma_count) export(ran_gamma_pois) export(ran_gamma_pois_zi) export(ran_lnorm) @@ -112,12 +111,12 @@ export(ran_pois) export(ran_pois_zi) export(ran_skewnorm) export(ran_student) +export(ran_upois) export(rbern) export(res_bern) export(res_beta_binom) export(res_binom) export(res_gamma) -export(res_gamma_count) export(res_gamma_pois) export(res_gamma_pois_zi) export(res_lnorm) @@ -127,6 +126,7 @@ export(res_pois) export(res_pois_zi) export(res_skewnorm) export(res_student) +export(res_upois) export(rskewnorm) export(sextreme) export(skewness) diff --git a/R/dev.R b/R/dev.R index 53b2c771..2e6f1a8a 100644 --- a/R/dev.R +++ b/R/dev.R @@ -97,7 +97,7 @@ dev_gamma <- function(x, shape = 1, rate = 1, res = FALSE) { dev_res(x, mu, dev) } -#' Gamma-Count Deviances +#' Underdispersed Poisson Deviances #' #' @inheritParams params #' @param x A non-negative whole numeric vector of values. @@ -107,123 +107,51 @@ dev_gamma <- function(x, shape = 1, rate = 1, res = FALSE) { #' @export #' #' @examples -#' dev_gamma_count(c(1,3.5,4), 3, 2) -dev_gamma_count <- function(x, lambda = 1, alpha = 1, res = FALSE) { - # Close, but doesn't work for small lambda and alpha - # dev <- log_lik_gamma_count(x, lambda = x, alpha = alpha) - - # log_lik_gamma_count(x, lambda = lambda, alpha = alpha) - # dev <- dev * 2 - # if(vld_false(res)) return(dev) - # dev_res(x, lambda, dev) +#' dev_upois(c(1,3.5,4), 3, 2) +dev_upois <- function(x, lambda = 1, theta = 0, res = FALSE) { + # n <- 1000 + # lambda <- rlnorm(1, 8, 1) + # print(lambda) + # theta <- 1 + # x <- ran_upois(n, lambda, theta) - n <- 1000 - lambda <- 6.21 - alpha <- 4.8421053 - set.seed(101) - x <- ran_gamma_count(n, lambda, alpha) + sat <- log_lik_upois(x = x, lambda = pmax(x - (theta / (1 + theta)), 0), theta = theta) + ll <- log_lik_upois(x = x, lambda = lambda, theta = theta) +# +# ll_pois <- log_lik_pois(x = x, lambda = lambda) +# sat_pois <- log_lik_pois(x = x, lambda = x) +# +# test = tibble( +# x = rep(x, 4), +# ll = c(ll, sat, ll_pois, sat_pois), +# lik = c(rep(c(rep("ll", n), rep("sat", n)), 2)), +# type = c(rep("upois", n * 2), rep("pois", n * 2)) +# ) +# +# # dev <- tibble(x = rep(x, 2), ll = c(dev1, dev2), lik = c(rep("sat", length(dev1)), rep("reg", length(dev2)))) +# +# ggplot(test) + +# geom_line(aes(x = x, y = ll, colour = lik), alpha = 0.5) + +# facet_wrap(~type) +# +# check_dev <- sat - ll +# unique(check_dev[check_dev < 0]) +# chk_true(all(check_dev >= 0)) - opt_gamma_count <- function(pars, x) { - -log_lik_gamma_count(x = x, lambda = exp(pars[1]), alpha = exp(pars[2])) - } - if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} - if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} - opt_lambda <- rep(NA, length(x)) - opt_alpha <- rep(NA, length(x)) - bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) - for (i in seq_along(x)) { - if (bol[i] & !is.na(bol[i])) { - opt <- stats::optim( - par = c(log(lambda[i]), log(alpha[i])), - fn = opt_gamma_count, - x = x[i], - method = "Nelder-Mead" - )$par - opt_lambda[i] <- exp(opt[1]) - opt_alpha[i] <- exp(opt[2]) - } - } - - opt_gamma_count <- function(pars, x) { - ll <- log_lik_gamma_count(x = x, lambda = exp(pars[1]), alpha = exp(pars[2])) - -sum(ll) - } - if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} - if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} - opt_lambda <- rep(NA, length(x)) - opt_alpha <- rep(NA, length(x)) - bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) - if (all(bol & !is.na(bol))) { - opt <- stats::optim( - par = c(log(mean(x)), log(1)), - fn = opt_gamma_count, - x = x, - method = "Nelder-Mead" - )$par - opt_lambda <- exp(opt[1]) - opt_alpha <- exp(opt[2]) - } - - opt_lambda - opt_alpha - # Returns the correct parameter values when fitted to the whole set of (lots of) data - # Means log-likelihood is correct. - - - - opt_gamma_count <- function(alpha, x, lambda) { - -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) - } - if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} - if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} - opt_alpha <- rep(NA, length(x)) - bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) - for (i in seq_along(x)) { - if (bol[i] & !is.na(bol[i])) { - opt_alpha[i] <- stats::optimize( - opt_gamma_count, - interval = c(0, 1e10), - x = x[i], - lambda = lambda[i] - )$minimum - } - } - - # dev1 <- log_lik_gamma_count(x = x, lambda = x, alpha = opt_alpha) - dev1 <- log_lik_gamma_count(x = x, lambda = x, alpha = opt_alpha) - dev2 <- log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) - - dev <- tibble(x = rep(x, 2), ll = c(dev1, dev2), lik = c(rep("sat", length(dev1)), rep("reg", length(dev2)))) - - ggplot() + - geom_line(data = dev, aes(x = x, y = ll, colour = lik)) + # Failing for lambda = 0.2492107, theta = 1 + # lambda = 5.488455, theta = 1 + # lambda = 0.4531443, theta = 1 - - # # normal example - # mean <- 100 - # sd <- 0.5 - # set.seed(101) - # x_norm <- rnorm(100, mean, sd) - # sat_norm <- log_lik_norm(x_norm, mean = x_norm, sd = sd) - # ll_norm <- log_lik_norm(x_norm, mean = mean, sd = sd) - # dev_norm <- tibble( - # x = rep(x_norm, 2), - # dev = c(ll_norm, sat_norm), - # lik = rep(c("reg", "sat"), each = length(x_norm)) - # ) - # ggplot(dev_norm) + - # geom_line(aes(x = x, y = dev, colour = lik)) - - dev <- dev1 - dev2 + dev <- sat - ll dev <- 2 * dev - use_pois <- (!is.na(alpha) & alpha == 1) - dev_pois <- dev_pois(x = x, lambda = lambda, res = res) + # Some cases where dev < 0, but all are very small diff (largest diff = 0.001) + neg <- dev < 0 + dev[neg] <- 0 + use_pois <- !is.na(theta) & theta == 0 + dev_pois <- dev_pois(x = x, lambda = lambda, res = FALSE) dev[use_pois] <- dev_pois[use_pois] if(vld_false(res)) return(dev) - gc_mean <- rep(NaN, length(x)) - for (i in 1:length(x)) { - gc_mean[i] <- mean_gamma_count(lambda[i], alpha[i]) - } - dev_res(x, gc_mean, dev) + dev_res(x, lambda + (theta / (1 + theta)), dev) } #' Gamma-Poisson Deviances diff --git a/R/log-lik.R b/R/log-lik.R index 7e1c1603..b49f6ef1 100644 --- a/R/log-lik.R +++ b/R/log-lik.R @@ -78,7 +78,7 @@ log_lik_gamma <- function(x, shape = 1, rate = 1) { stats::dgamma(x, shape = shape, rate = rate, log = TRUE) } -#' Gamma-Count Log-Likelihood +#' Underdispersed Poisson Log-Likelihood #' #' @inheritParams params #' @param x A non-negative whole numeric vector of values. @@ -88,35 +88,47 @@ log_lik_gamma <- function(x, shape = 1, rate = 1) { #' @export #' #' @examples -#' log_lik_gamma_count(c(0, 1, 2), 1, 0) -log_lik_gamma_count <- function(x, lambda = 1, alpha = 1) { - chk::chk_compatible_lengths(x, lambda, alpha) - chk::chk_gt(alpha, value = 0) - chk::chk_gte(lambda, value = 0) +#' log_lik_upois(c(0, 1, 2), 1, 0) +log_lik_upois <- function(x, lambda = 1, theta = 0) { + chk_gte(lambda) + chk_gte(theta) - # gammacount::dgc(x = x, lambda = lambda, alpha = alpha, log = TRUE) - # rmutil::dgammacount(y = x, m = lambda, s = alpha, log = TRUE) - x_zero <- x == 0 - x_pos <- x > 0 - x_neg <- x < 0 - lik <- rep(NaN, max(length(x), length(lambda), length(alpha))) - if (length(x) == 1) { - x <- rep(x, length(lik)) - } - if (length(alpha) == 1) { - alpha <- rep(alpha, length(lik)) + if (length(theta) == 1) { + theta <- rep(theta, length(x)) } + if (length(lambda) == 1) { - lambda <- rep(lambda, length(lik)) + lambda <- rep(lambda, length(x)) + } + + log_lik <- + (-lambda + (x - 1) * log(lambda) + log(lambda + theta * x)) - + (log(1 + theta) + lfactorial(x)) + + # log_lik <- rep(NaN, max(length(x), length(lambda), length(theta))) + + x_lambda_zero <- x == 0 & lambda == 0 & !is.na(x) & !is.na(lambda) + if (any(x_lambda_zero)) { + log_lik[x_lambda_zero] <- log(1 / (1 + theta[x_lambda_zero])) } - # lik[x_zero] <- stats::pgamma(alpha[x_zero] * lambda[x_zero], (x[x_zero] + 1) * alpha[x_zero], lower.tail = FALSE) - lik[x_zero] <- stats::pgamma(q = 1, shape = alpha[x_zero], rate = alpha[x_zero] * lambda[x_zero], lower.tail = FALSE) - lik[x_pos] <- stats::pgamma(q = 1, shape = x[x_pos] * alpha[x_pos], rate = alpha[x_pos] * lambda[x_pos]) - - stats::pgamma(q = 1, shape = (x[x_pos] + 1) * alpha[x_pos], rate = alpha[x_pos] * lambda[x_pos]) - # lik[x_pos] <- pgamma(alpha[x_pos] * lambda[x_pos], x[x_pos] * alpha[x_pos]) - - # pgamma(alpha[x_pos] * lambda[x_pos], (x[x_pos] + 1) * alpha[x_pos]) - lik[x_neg] <- 0 - log(lik) + + x_one_lambda_zero <- x == 1 & lambda == 0 & !is.na(x) & !is.na(lambda) + if (any(x_one_lambda_zero)) { + log_lik[x_one_lambda_zero] <- log(theta[x_one_lambda_zero] / (1 + theta[x_one_lambda_zero])) + } + + zero <- theta == 0 & !is.na(theta) & !is.na(lambda) & !is.na(x) + if (any(zero)) { + log_lik[zero] <- log_lik_pois(x[zero], lambda[zero]) + } + + # others <- !zero & !x_lambda_zero & !x_one_lambda_zero + + # log_lik[others] <- + # (-lambda[others] + (x[others] - 1) * log(lambda[others]) + log(lambda[others] + theta[others] * x[others])) - + # (log(1 + theta[others]) + lfactorial(x[others])) + + log_lik } #' Gamma-Poisson Log-Likelihood diff --git a/R/ran.R b/R/ran.R index 1e4633b5..dfbb145f 100644 --- a/R/ran.R +++ b/R/ran.R @@ -63,7 +63,20 @@ ran_gamma <- function(n = 1, shape = 1, rate = 1) { stats::rgamma(n, shape = shape, rate = rate) } -#' Gamma-Count Random Samples +# Cumulative distribution function for underdispersed poisson distribution +pupois <- function(q, lambda, theta) { + sapply(q, \(x) {sum(exp(log_lik_upois(0:x, lambda, theta)))}) + # mapply( + # \(q, lambda, theta) { + # sum(exp(log_lik_upois(0:q, lambda, theta))) + # }, + # q = q, + # lambda = lambda, + # theta = theta + # ) +} + +#' Underdispersed Poisson Random Samples #' #' @inheritParams params #' @return A numeric vector of the random samples. @@ -71,23 +84,47 @@ ran_gamma <- function(n = 1, shape = 1, rate = 1) { #' @export #' #' @examples -#' ran_gamma_count(n = 10, lambda = 1, alpha = 1) -ran_gamma_count <- function(n = 1, lambda = 1, alpha = 1) { +#' ran_upois(n = 10, lambda = 1, theta = 1) +ran_upois <- function(n = 1, lambda = 1, theta = 0) { chk_whole_number(n) - chk_gte(n, value = 0) - chk_gt(lambda, value = 0) - chk_gt(alpha, value = 0) - if (length(lambda) == 1) { - lambda <- rep(lambda, n) + chk_gte(n) + chk_gte(lambda) + chk_gte(theta) + # chk_compatible_lengths(rep(1, n), lambda, theta) + ### Figure out how to get this to work for a lambda/theta vector + + use_pois <- all(theta == 0 & !is.na(theta)) + if (use_pois) { + stats::rpois(n, lambda = lambda) } - if (length(alpha) == 1) { - alpha <- rep(alpha, n) + + fun <- function(n, lambda, theta) { + u = stats::runif(n) + cmf <- pupois(0:max((ceiling(lambda) * 3), 50), lambda = lambda, theta = theta) + ix <- min(which(abs(cmf - 1) < 1e-8)) + # ix <- min(which(cmf == 1)) + first = min(which(cmf > 0)) + cmf = unique(c(0, cmf[first:ix])) + cmfTbl = table(cut(u, breaks = cmf, include.lowest = TRUE)) + X = rep(1:length(cmfTbl), as.numeric(cmfTbl)) - 1 + ifelse(first > 1, first, 0) + X <- as.integer(X) + samp <- sample(1:n, size = n) + X[samp] } - bol_alpha <- alpha == 1 - if (all(bol_alpha) & all(!is.na(alpha))) { - return(stats::rpois(n, lambda = lambda)) + + lambda_vec <- length(lambda) > 1L & length(unique(lambda)) != 1 + theta_vec <- length(theta) > 1L & length(unique(theta)) != 1 + if (lambda_vec | theta_vec) { + n_rep <- rep(1, n) + mapply( + fun, + n = n_rep, + lambda = lambda, + theta = theta + ) + } else { + fun(n, lambda[1], theta[1]) } - gammacount::rgc(n = n, lambda = lambda, alpha = alpha) } #' Gamma-Poisson Random Samples diff --git a/R/res.R b/R/res.R index c1ab7cac..a10398e4 100644 --- a/R/res.R +++ b/R/res.R @@ -108,32 +108,6 @@ res_gamma <- function(x, shape = 1, rate = 1, type = "dev", simulate = FALSE) { chk_subset(x, c("data", "raw", "dev", "standardized"))) } -res_gamma_count_standardized <- function(x, lambda, alpha) { - mean <- 0 - var_1 <- 0 - iter <- 1 - i <- 1 - while (iter > 1e-12) { - iter <- stats::pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) - mean <- mean + iter - var_1 <- var_1 + ((2 * i - 1) * iter) - i <- i + 1 - } - var <- var_1 - mean^2 - x - mean / sqrt(var) -} - -mean_gamma_count <- function(lambda, alpha) { - mean <- 0 - iter <- 1 - i <- 1 - while (iter > 1e-12) { - iter <- stats::pgamma(q = 1, shape = alpha * i, rate = lambda * alpha) - mean <- mean + iter - i <- i + 1 - } - mean -} #' Gamma-Count Residuals #' @@ -145,23 +119,23 @@ mean_gamma_count <- function(lambda, alpha) { #' @export #' #' @examples -#' res_gamma_count(c(0, 1, 2), 1, 1) -res_gamma_count <- function(x, lambda = 1, alpha = 1, type = "dev", simulate = FALSE) { +#' res_upois(c(0, 1, 2), 1, 1) +res_upois <- function(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) { chk_string(type) if(!vld_false(simulate)) { - x <- ran_gamma_count(length(x), lambda = lambda, alpha = alpha) + x <- ran_upois(length(x), lambda = lambda, theta = theta) } if (length(lambda) == 1) { lambda <- rep(lambda, length(x)) } - if (length(alpha) == 1) { - alpha <- rep(alpha, length(x)) + if (length(theta) == 1) { + theta <- rep(theta, length(x)) } switch(type, data = x, - raw = x - Vectorize(mean_gamma_count)(lambda = lambda, alpha = alpha), - standardized = Vectorize(res_gamma_count_standardized)(x = x, lambda = lambda, alpha = alpha), - dev = dev_gamma_count(x, lambda = lambda, alpha = alpha, res = TRUE), + raw = x - (lambda + (theta / (1 + theta))), + standardized = (x - (lambda + (theta / (1 + theta)))) / sqrt(lambda + (theta / (1 + theta)^2)), + dev = dev_upois(x, lambda = lambda, theta = theta, res = TRUE), chk_subset(x, c("data", "raw", "dev", "standardized"))) } diff --git a/R/test-dev-upois-2.R b/R/test-dev-upois-2.R new file mode 100644 index 00000000..2f780611 --- /dev/null +++ b/R/test-dev-upois-2.R @@ -0,0 +1,153 @@ +# # Test gamma count deviance +# library(dplyr) +# library(tidyr) +# library(ggplot2) +# +# # When you pick nice numbers, the alpha < 0.5 rule works +# # pars_theta <- c(seq(0.1, 1.1, by = 0.05), seq(2, 20, by = 0.5)) +# # pars_lambda <- seq(1, 10000, by = 100) +# # +# # pars <- expand_grid(lambda = pars_lambda, theta = pars_theta) +# # pars$fail <- NA +# +# # But when you pick stranger values, it doesn't :( +# pars2_theta <- rlnorm(10, 1, 1) +# pars2_lambda <- rlnorm(10, 2, 1) +# +# pars2 <- expand_grid(lambda = pars2_lambda, theta = pars2_theta) +# pars2$fail_x <- NA +# pars2$fail_mean <- NA +# pars2$diff_x <- NA +# pars2$diff_mean <- NA +# pars2$dev <- NA +# +# for (i in 1:nrow(pars2)) { +# # print(paste("i = ", i, ", theta is ", pull(pars2[i, "theta"]), ", lambda is ", pull(pars2[i, "lambda"]))) +# n <- 1000 +# lambda <- pull(pars2[i, "lambda"]) +# theta <- pull(pars2[i, "theta"]) +# x <- ran_upois(n, lambda, theta) +# +# test <- +# tibble( +# x = x, lambda = lambda, theta = theta +# ) %>% +# mutate( +# ll = log_lik_upois(x, lambda, theta) +# ) +# +# test$sat_x = log_lik_upois(test$x, pmax(test$x - (test$theta / (1 + test$theta)), 0), test$theta) +# # test$sat_mean = log_lik_upois(test$mean, test$lambda, test$theta) +# test$dev <- dev_upois(test$x, test$lambda, test$theta, res = TRUE) +# +# # chk_false(any(test$sat < test$ll)) +# pars2$fail_x[i] <- vld_true(any(test$sat_x < test$ll)) +# # pars2$fail_mean[i] <- vld_true(any(test$sat_mean < test$ll)) +# +# diff <- test$sat_x[test$sat_x < test$ll] - test$ll[test$sat_x < test$ll] +# pars2$diff_x[i] <- mean(diff) +# pars2$dev[i] <- any(dev < 0) +# # diff <- test$sat_mean[test$sat_mean < test$ll] - test$ll[test$sat_mean < test$ll] +# # pars2$diff_mean[i] <- mean(diff) +# +# +# # opt_gamma_count <- function(alpha, x, lambda) { +# # -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) +# # } +# # if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} +# # if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} +# # opt_alpha <- rep(NA, length(x)) +# # bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) +# # for (i in seq_along(x)) { +# # if (bol[i] & !is.na(bol[i])) { +# # opt_alpha[i] <- stats::optimize( +# # opt_gamma_count, +# # interval = c(0, 1e10), +# # x = x[i], +# # lambda = lambda[i] +# # )$minimum +# # } +# # } +# +# # test$dev <- dev_gamma_count(x, lambda, alpha) +# # test$sat <- test$dev / 2 + test$ll +# +# # test$ll_pois <- log_lik_pois(test$x, test$lambda) +# # test$sat_pois <- log_lik_pois(test$x, test$x) +# +# # test$ll_pois <- log_lik_pois(test$x, test$lambda) +# # test$sat_pois <- log_lik_pois(test$x, test$x) +# # +# # ggplot(test) + +# # geom_line(aes(x = x, y = ll), colour = "red") + +# # geom_line(aes(x = x, y = sat), colour = "firebrick") + +# # geom_line(aes(x = x, y = ll_pois), colour = "blue") + +# # geom_line(aes(x = x, y = sat_pois), colour = "steelblue") +# +# # test$mean <- NA +# # for (i in 1:nrow(test)) { +# # test$mean[i] <- mean_gamma_count(test$lambda[i], test$alpha[i]) +# # } +# # +# # test %>% dplyr::arrange(desc(ll)) +# } +# +# pars2 %>% filter(!dev) +# # +# # # pars2 %>% +# # # filter(fail_mean) %>% +# # # ggplot() + +# # # geom_histogram(aes(x = theta)) +# # +# # pars2 %>% +# # filter(fail_x) %>% +# # ggplot() + +# # geom_histogram(aes(x = theta)) +# # +# # pars2 %>% +# # filter(fail_x) %>% +# # ggplot() + +# # geom_histogram(aes(x = diff_x)) +# # +# # # pars2 %>% +# # # filter(fail_mean) %>% +# # # ggplot() + +# # # geom_histogram(aes(x = diff_mean)) +# # +# # # lambda theta fail_x fail_mean diff_x diff_mean +# # # +# # # 1 1.27 1.62 TRUE NA -0.00294 NA +# # # 2 1.27 2.29 TRUE NA -0.00175 NA +# # # 3 1.27 1.24 TRUE NA -0.000488 NA +# # # +# # # lambda theta fail_x fail_mean diff_x diff_mean +# # # +# # # 1 8.26 2.71 TRUE NA -0.0000133 NA +# # +# # # lambda theta fail_x fail_mean diff_x diff_mean +# # # +# # # 1 4.82 0.225 TRUE NA -0.000000189 NA +# # +# # # lambda theta fail_x fail_mean diff_x diff_mean +# # # +# # # 1 7.23 3.12 TRUE NA -0.0000218 NA +# # # 2 1.45 0.778 TRUE NA -0.00106 NA +# # # 3 1.45 0.824 TRUE NA -0.00148 NA +# # # 4 1.45 1.20 TRUE NA -0.000155 NA +# # # 5 1.45 0.794 TRUE NA -0.00123 NA +# # # 6 13.5 1.20 TRUE NA -0.00000215 NA +# # # 7 5.41 1.20 TRUE NA -0.00000334 NA +# # +# # # lambda theta fail_x fail_mean diff_x diff_mean +# # # +# # # 1 11.5 0.987 TRUE NA -0.000000263 NA +# # # 2 11.5 0.947 TRUE NA -0.00000475 NA +# # # 3 2.49 0.987 TRUE NA -0.000143 NA +# # # 4 2.49 0.947 TRUE NA -0.000271 NA +# # +# # # lambda theta fail_x fail_mean diff_x diff_mean +# # # +# # # 1 9.18 3.96 TRUE NA -0.00000472 NA +# # # 2 9.18 4.23 TRUE NA -0.00000892 NA +# # # 3 3.31 1.56 TRUE NA -0.0000203 NA +# # # 4 4.34 1.56 TRUE NA -0.0000655 NA diff --git a/R/test-dev-upois.R b/R/test-dev-upois.R new file mode 100644 index 00000000..15c808ce --- /dev/null +++ b/R/test-dev-upois.R @@ -0,0 +1,149 @@ +# # Test gamma count deviance +# library(dplyr) +# library(tidyr) +# library(ggplot2) +# +# # When you pick nice numbers, the alpha < 0.5 rule works +# # pars_theta <- c(seq(0.1, 1.1, by = 0.05), seq(2, 20, by = 0.5)) +# # pars_lambda <- seq(1, 10000, by = 100) +# # +# # pars <- expand_grid(lambda = pars_lambda, theta = pars_theta) +# # pars$fail <- NA +# +# # But when you pick stranger values, it doesn't :( +# pars2_theta <- rlnorm(10, 1, 1) +# pars2_lambda <- rlnorm(10, 2, 1) +# +# pars2 <- expand_grid(lambda = pars2_lambda, theta = pars2_theta) +# pars2$fail_x <- NA +# pars2$fail_mean <- NA +# pars2$diff_x <- NA +# pars2$diff_mean <- NA +# +# for (i in 1:nrow(pars2)) { +# print(paste("i = ", i, ", theta is ", pull(pars2[i, "theta"]), ", lambda is ", pull(pars2[i, "lambda"]))) +# n <- 1000 +# lambda <- pull(pars2[i, "lambda"]) +# theta <- pull(pars2[i, "theta"]) +# x <- ran_upois(n, lambda, theta) +# +# test <- +# tibble( +# x = x, lambda = lambda, theta = theta +# ) %>% +# mutate( +# ll = log_lik_upois(x, lambda, theta) +# ) +# +# test$sat_x = log_lik_upois(test$x, pmax(test$x - (test$theta / (1 + test$theta)), 0), test$theta) +# # test$sat_mean = log_lik_upois(test$mean, test$lambda, test$theta) +# +# # chk_false(any(test$sat < test$ll)) +# pars2$fail_x[i] <- vld_true(any(test$sat_x < test$ll)) +# # pars2$fail_mean[i] <- vld_true(any(test$sat_mean < test$ll)) +# +# diff <- test$sat_x[test$sat_x < test$ll] - test$ll[test$sat_x < test$ll] +# pars2$diff_x[i] <- mean(diff) +# # diff <- test$sat_mean[test$sat_mean < test$ll] - test$ll[test$sat_mean < test$ll] +# # pars2$diff_mean[i] <- mean(diff) +# +# +# # opt_gamma_count <- function(alpha, x, lambda) { +# # -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) +# # } +# # if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} +# # if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} +# # opt_alpha <- rep(NA, length(x)) +# # bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) +# # for (i in seq_along(x)) { +# # if (bol[i] & !is.na(bol[i])) { +# # opt_alpha[i] <- stats::optimize( +# # opt_gamma_count, +# # interval = c(0, 1e10), +# # x = x[i], +# # lambda = lambda[i] +# # )$minimum +# # } +# # } +# +# # test$dev <- dev_gamma_count(x, lambda, alpha) +# # test$sat <- test$dev / 2 + test$ll +# +# # test$ll_pois <- log_lik_pois(test$x, test$lambda) +# # test$sat_pois <- log_lik_pois(test$x, test$x) +# +# # test$ll_pois <- log_lik_pois(test$x, test$lambda) +# # test$sat_pois <- log_lik_pois(test$x, test$x) +# # +# # ggplot(test) + +# # geom_line(aes(x = x, y = ll), colour = "red") + +# # geom_line(aes(x = x, y = sat), colour = "firebrick") + +# # geom_line(aes(x = x, y = ll_pois), colour = "blue") + +# # geom_line(aes(x = x, y = sat_pois), colour = "steelblue") +# +# # test$mean <- NA +# # for (i in 1:nrow(test)) { +# # test$mean[i] <- mean_gamma_count(test$lambda[i], test$alpha[i]) +# # } +# # +# # test %>% dplyr::arrange(desc(ll)) +# print(i) +# } +# +# # pars2 %>% +# # filter(fail_mean) %>% +# # ggplot() + +# # geom_histogram(aes(x = theta)) +# +# pars2 %>% +# filter(fail_x) %>% +# ggplot() + +# geom_histogram(aes(x = theta)) +# +# pars2 %>% +# filter(fail_x) %>% +# ggplot() + +# geom_histogram(aes(x = diff_x)) +# +# # pars2 %>% +# # filter(fail_mean) %>% +# # ggplot() + +# # geom_histogram(aes(x = diff_mean)) +# +# # lambda theta fail_x fail_mean diff_x diff_mean +# # +# # 1 1.27 1.62 TRUE NA -0.00294 NA +# # 2 1.27 2.29 TRUE NA -0.00175 NA +# # 3 1.27 1.24 TRUE NA -0.000488 NA +# # +# # lambda theta fail_x fail_mean diff_x diff_mean +# # +# # 1 8.26 2.71 TRUE NA -0.0000133 NA +# +# # lambda theta fail_x fail_mean diff_x diff_mean +# # +# # 1 4.82 0.225 TRUE NA -0.000000189 NA +# +# # lambda theta fail_x fail_mean diff_x diff_mean +# # +# # 1 7.23 3.12 TRUE NA -0.0000218 NA +# # 2 1.45 0.778 TRUE NA -0.00106 NA +# # 3 1.45 0.824 TRUE NA -0.00148 NA +# # 4 1.45 1.20 TRUE NA -0.000155 NA +# # 5 1.45 0.794 TRUE NA -0.00123 NA +# # 6 13.5 1.20 TRUE NA -0.00000215 NA +# # 7 5.41 1.20 TRUE NA -0.00000334 NA +# +# # lambda theta fail_x fail_mean diff_x diff_mean +# # +# # 1 11.5 0.987 TRUE NA -0.000000263 NA +# # 2 11.5 0.947 TRUE NA -0.00000475 NA +# # 3 2.49 0.987 TRUE NA -0.000143 NA +# # 4 2.49 0.947 TRUE NA -0.000271 NA +# +# # lambda theta fail_x fail_mean diff_x diff_mean +# # +# # 1 9.18 3.96 TRUE NA -0.00000472 NA +# # 2 9.18 4.23 TRUE NA -0.00000892 NA +# # 3 3.31 1.56 TRUE NA -0.0000203 NA +# # 4 4.34 1.56 TRUE NA -0.0000655 NA diff --git a/_pkgdown.yml b/_pkgdown.yml index 57ecb0fd..0209b070 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -90,7 +90,6 @@ reference: - '`dev_beta_binom`' - '`dev_binom`' - '`dev_gamma`' - - '`dev_gamma_count`' - '`dev_gamma_pois`' - '`dev_gamma_pois_zi`' - '`dev_lnorm`' @@ -107,7 +106,6 @@ reference: - '`res_beta_binom`' - '`res_binom`' - '`res_gamma`' - - '`res_gamma_count`' - '`res_gamma_pois`' - '`res_gamma_pois_zi`' - '`res_lnorm`' @@ -124,7 +122,6 @@ reference: - '`log_lik_beta_binom`' - '`log_lik_binom`' - '`log_lik_gamma`' - - '`log_lik_gamma_count`' - '`log_lik_gamma_pois`' - '`log_lik_gamma_pois_zi`' - '`log_lik_lnorm`' @@ -141,7 +138,6 @@ reference: - '`ran_beta_binom`' - '`ran_binom`' - '`ran_gamma`' - - '`ran_gamma_count`' - '`ran_gamma_pois`' - '`ran_gamma_pois_zi`' - '`ran_lnorm`' diff --git a/man/dev_bern.Rd b/man/dev_bern.Rd index e230d6af..2839ce34 100644 --- a/man/dev_bern.Rd +++ b/man/dev_bern.Rd @@ -26,7 +26,6 @@ dev_bern(c(TRUE, FALSE), 0.7) Other dev_dist: \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -35,6 +34,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_beta_binom.Rd b/man/dev_beta_binom.Rd index 2818709e..15f2890b 100644 --- a/man/dev_beta_binom.Rd +++ b/man/dev_beta_binom.Rd @@ -30,7 +30,6 @@ dev_beta_binom(c(0, 1, 2), 1, 0.5, 0) Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -39,6 +38,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_binom.Rd b/man/dev_binom.Rd index de2a2c89..fdbc218f 100644 --- a/man/dev_binom.Rd +++ b/man/dev_binom.Rd @@ -28,7 +28,6 @@ dev_binom(c(0, 1, 2), 2, 0.3) Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_gamma.Rd b/man/dev_gamma.Rd index 0b26c2fb..f1d9dfb2 100644 --- a/man/dev_gamma.Rd +++ b/man/dev_gamma.Rd @@ -29,7 +29,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_lnorm}()}, \code{\link{dev_neg_binom}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_gamma_pois.Rd b/man/dev_gamma_pois.Rd index 211f497f..cdc41d97 100644 --- a/man/dev_gamma_pois.Rd +++ b/man/dev_gamma_pois.Rd @@ -29,7 +29,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, \code{\link{dev_neg_binom}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_lnorm.Rd b/man/dev_lnorm.Rd index 26cb13ed..1587ec78 100644 --- a/man/dev_lnorm.Rd +++ b/man/dev_lnorm.Rd @@ -29,7 +29,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_neg_binom}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_neg_binom.Rd b/man/dev_neg_binom.Rd index 4719fe4b..37e7bbe1 100644 --- a/man/dev_neg_binom.Rd +++ b/man/dev_neg_binom.Rd @@ -29,7 +29,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_norm.Rd b/man/dev_norm.Rd index 0cb05d38..9971ad4f 100644 --- a/man/dev_norm.Rd +++ b/man/dev_norm.Rd @@ -29,7 +29,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_pois.Rd b/man/dev_pois.Rd index 6cc70e74..e8b057ec 100644 --- a/man/dev_pois.Rd +++ b/man/dev_pois.Rd @@ -27,7 +27,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -35,6 +34,7 @@ Other dev_dist: \code{\link{dev_norm}()}, \code{\link{dev_pois_zi}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_pois_zi.Rd b/man/dev_pois_zi.Rd index df1ea65e..75ff7d94 100644 --- a/man/dev_pois_zi.Rd +++ b/man/dev_pois_zi.Rd @@ -29,7 +29,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -37,6 +36,7 @@ Other dev_dist: \code{\link{dev_norm}()}, \code{\link{dev_pois}()}, \code{\link{dev_skewnorm}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_skewnorm.Rd b/man/dev_skewnorm.Rd index 02a16ce5..a17e438b 100644 --- a/man/dev_skewnorm.Rd +++ b/man/dev_skewnorm.Rd @@ -33,7 +33,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -41,6 +40,7 @@ Other dev_dist: \code{\link{dev_norm}()}, \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, -\code{\link{dev_student}()} +\code{\link{dev_student}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_student.Rd b/man/dev_student.Rd index 5e97a799..5097d944 100644 --- a/man/dev_student.Rd +++ b/man/dev_student.Rd @@ -31,7 +31,6 @@ Other dev_dist: \code{\link{dev_bern}()}, \code{\link{dev_beta_binom}()}, \code{\link{dev_binom}()}, -\code{\link{dev_gamma_count}()}, \code{\link{dev_gamma_pois}()}, \code{\link{dev_gamma}()}, \code{\link{dev_lnorm}()}, @@ -39,6 +38,7 @@ Other dev_dist: \code{\link{dev_norm}()}, \code{\link{dev_pois_zi}()}, \code{\link{dev_pois}()}, -\code{\link{dev_skewnorm}()} +\code{\link{dev_skewnorm}()}, +\code{\link{dev_upois}()} } \concept{dev_dist} diff --git a/man/dev_gamma_count.Rd b/man/dev_upois.Rd similarity index 72% rename from man/dev_gamma_count.Rd rename to man/dev_upois.Rd index 67708b49..d8c7ba8e 100644 --- a/man/dev_gamma_count.Rd +++ b/man/dev_upois.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dev.R -\name{dev_gamma_count} -\alias{dev_gamma_count} -\title{Gamma-Count Deviances} +\name{dev_upois} +\alias{dev_upois} +\title{Underdispersed Poisson Deviances} \usage{ -dev_gamma_count(x, lambda = 1, alpha = 1, res = FALSE) +dev_upois(x, lambda = 1, theta = 0, res = FALSE) } \arguments{ \item{x}{A non-negative whole numeric vector of values.} \item{lambda}{A non-negative numeric vector of means.} -\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } @@ -19,10 +19,10 @@ dev_gamma_count(x, lambda = 1, alpha = 1, res = FALSE) An numeric vector of the corresponding deviances or deviance residuals. } \description{ -Gamma-Count Deviances +Underdispersed Poisson Deviances } \examples{ -dev_gamma_count(c(1,3.5,4), 3, 2) +dev_upois(c(1,3.5,4), 3, 2) } \seealso{ Other dev_dist: diff --git a/man/log_lik_bern.Rd b/man/log_lik_bern.Rd index 2f91671f..4402c1c8 100644 --- a/man/log_lik_bern.Rd +++ b/man/log_lik_bern.Rd @@ -24,7 +24,6 @@ log_lik_bern(c(TRUE, FALSE), 0.7) Other log_lik_dist: \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -34,6 +33,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_beta_binom.Rd b/man/log_lik_beta_binom.Rd index ba2c957b..e18019e5 100644 --- a/man/log_lik_beta_binom.Rd +++ b/man/log_lik_beta_binom.Rd @@ -28,7 +28,6 @@ log_lik_beta_binom(c(0, 1, 2), 1, 0.5, 0) Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -38,6 +37,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_binom.Rd b/man/log_lik_binom.Rd index 20a81f9a..a9813ecc 100644 --- a/man/log_lik_binom.Rd +++ b/man/log_lik_binom.Rd @@ -26,7 +26,6 @@ log_lik_binom(c(0, 1, 2), 2, 0.3) Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_gamma.Rd b/man/log_lik_gamma.Rd index 7aa1ef36..56d8d32b 100644 --- a/man/log_lik_gamma.Rd +++ b/man/log_lik_gamma.Rd @@ -27,7 +27,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_lnorm}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_gamma_pois.Rd b/man/log_lik_gamma_pois.Rd index 991ed78f..fc9b8ff5 100644 --- a/man/log_lik_gamma_pois.Rd +++ b/man/log_lik_gamma_pois.Rd @@ -27,7 +27,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma}()}, \code{\link{log_lik_lnorm}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_gamma_pois_zi.Rd b/man/log_lik_gamma_pois_zi.Rd index cc7260f2..95a80de4 100644 --- a/man/log_lik_gamma_pois_zi.Rd +++ b/man/log_lik_gamma_pois_zi.Rd @@ -29,7 +29,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, \code{\link{log_lik_lnorm}()}, @@ -38,6 +37,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_lnorm.Rd b/man/log_lik_lnorm.Rd index 36f808d2..6f7aa152 100644 --- a/man/log_lik_lnorm.Rd +++ b/man/log_lik_lnorm.Rd @@ -27,7 +27,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_neg_binom.Rd b/man/log_lik_neg_binom.Rd index d60f5df9..65890f19 100644 --- a/man/log_lik_neg_binom.Rd +++ b/man/log_lik_neg_binom.Rd @@ -27,7 +27,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_norm.Rd b/man/log_lik_norm.Rd index 0688bd0f..68a1558b 100644 --- a/man/log_lik_norm.Rd +++ b/man/log_lik_norm.Rd @@ -27,7 +27,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_pois.Rd b/man/log_lik_pois.Rd index 0e730a19..be8a5ef1 100644 --- a/man/log_lik_pois.Rd +++ b/man/log_lik_pois.Rd @@ -25,7 +25,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -34,6 +33,7 @@ Other log_lik_dist: \code{\link{log_lik_norm}()}, \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_pois_zi.Rd b/man/log_lik_pois_zi.Rd index 54bf33a1..91e12461 100644 --- a/man/log_lik_pois_zi.Rd +++ b/man/log_lik_pois_zi.Rd @@ -27,7 +27,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -36,6 +35,7 @@ Other log_lik_dist: \code{\link{log_lik_norm}()}, \code{\link{log_lik_pois}()}, \code{\link{log_lik_skewnorm}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_skewnorm.Rd b/man/log_lik_skewnorm.Rd index bffbd526..2611d452 100644 --- a/man/log_lik_skewnorm.Rd +++ b/man/log_lik_skewnorm.Rd @@ -31,7 +31,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -40,6 +39,7 @@ Other log_lik_dist: \code{\link{log_lik_norm}()}, \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, -\code{\link{log_lik_student}()} +\code{\link{log_lik_student}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_student.Rd b/man/log_lik_student.Rd index a1689186..1e1d7a07 100644 --- a/man/log_lik_student.Rd +++ b/man/log_lik_student.Rd @@ -29,7 +29,6 @@ Other log_lik_dist: \code{\link{log_lik_bern}()}, \code{\link{log_lik_beta_binom}()}, \code{\link{log_lik_binom}()}, -\code{\link{log_lik_gamma_count}()}, \code{\link{log_lik_gamma_pois_zi}()}, \code{\link{log_lik_gamma_pois}()}, \code{\link{log_lik_gamma}()}, @@ -38,6 +37,7 @@ Other log_lik_dist: \code{\link{log_lik_norm}()}, \code{\link{log_lik_pois_zi}()}, \code{\link{log_lik_pois}()}, -\code{\link{log_lik_skewnorm}()} +\code{\link{log_lik_skewnorm}()}, +\code{\link{log_lik_upois}()} } \concept{log_lik_dist} diff --git a/man/log_lik_gamma_count.Rd b/man/log_lik_upois.Rd similarity index 71% rename from man/log_lik_gamma_count.Rd rename to man/log_lik_upois.Rd index b928ebdf..fc62980f 100644 --- a/man/log_lik_gamma_count.Rd +++ b/man/log_lik_upois.Rd @@ -1,26 +1,26 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/log-lik.R -\name{log_lik_gamma_count} -\alias{log_lik_gamma_count} -\title{Gamma-Count Log-Likelihood} +\name{log_lik_upois} +\alias{log_lik_upois} +\title{Underdispersed Poisson Log-Likelihood} \usage{ -log_lik_gamma_count(x, lambda = 1, alpha = 1) +log_lik_upois(x, lambda = 1, theta = 0) } \arguments{ \item{x}{A non-negative whole numeric vector of values.} \item{lambda}{A non-negative numeric vector of means.} -\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} } \value{ An numeric vector of the corresponding log-likelihoods. } \description{ -Gamma-Count Log-Likelihood +Underdispersed Poisson Log-Likelihood } \examples{ -log_lik_gamma_count(c(0, 1, 2), 1, 0) +log_lik_upois(c(0, 1, 2), 1, 0) } \seealso{ Other log_lik_dist: diff --git a/man/ran_bern.Rd b/man/ran_bern.Rd index 3cb82100..c8a8c2dc 100644 --- a/man/ran_bern.Rd +++ b/man/ran_bern.Rd @@ -24,7 +24,6 @@ ran_bern(10) Other ran_dist: \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -34,6 +33,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_beta_binom.Rd b/man/ran_beta_binom.Rd index 1e32dc53..9baa501e 100644 --- a/man/ran_beta_binom.Rd +++ b/man/ran_beta_binom.Rd @@ -28,7 +28,6 @@ ran_beta_binom(10, 1, 0.5, 0) Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -38,6 +37,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_binom.Rd b/man/ran_binom.Rd index 15eeb5ca..b3a773c2 100644 --- a/man/ran_binom.Rd +++ b/man/ran_binom.Rd @@ -26,7 +26,6 @@ ran_binom(10) Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_gamma.Rd b/man/ran_gamma.Rd index 8bf0dba0..7c404575 100644 --- a/man/ran_gamma.Rd +++ b/man/ran_gamma.Rd @@ -27,7 +27,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_lnorm}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_gamma_pois.Rd b/man/ran_gamma_pois.Rd index 084e9ffa..617adf6d 100644 --- a/man/ran_gamma_pois.Rd +++ b/man/ran_gamma_pois.Rd @@ -27,7 +27,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma}()}, \code{\link{ran_lnorm}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_gamma_pois_zi.Rd b/man/ran_gamma_pois_zi.Rd index 8c2e6330..b2105e87 100644 --- a/man/ran_gamma_pois_zi.Rd +++ b/man/ran_gamma_pois_zi.Rd @@ -29,7 +29,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, \code{\link{ran_lnorm}()}, @@ -38,6 +37,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_lnorm.Rd b/man/ran_lnorm.Rd index 985514cc..8f517109 100644 --- a/man/ran_lnorm.Rd +++ b/man/ran_lnorm.Rd @@ -27,7 +27,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_neg_binom.Rd b/man/ran_neg_binom.Rd index ca69ed23..f78317e3 100644 --- a/man/ran_neg_binom.Rd +++ b/man/ran_neg_binom.Rd @@ -27,7 +27,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_norm.Rd b/man/ran_norm.Rd index 5dceb585..8a90d589 100644 --- a/man/ran_norm.Rd +++ b/man/ran_norm.Rd @@ -27,7 +27,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_pois.Rd b/man/ran_pois.Rd index 76a2d5c6..1f7633cf 100644 --- a/man/ran_pois.Rd +++ b/man/ran_pois.Rd @@ -25,7 +25,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -34,6 +33,7 @@ Other ran_dist: \code{\link{ran_norm}()}, \code{\link{ran_pois_zi}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_pois_zi.Rd b/man/ran_pois_zi.Rd index 46fc39f7..05e42234 100644 --- a/man/ran_pois_zi.Rd +++ b/man/ran_pois_zi.Rd @@ -27,7 +27,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -36,6 +35,7 @@ Other ran_dist: \code{\link{ran_norm}()}, \code{\link{ran_pois}()}, \code{\link{ran_skewnorm}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_skewnorm.Rd b/man/ran_skewnorm.Rd index abf9ff2d..edfdc440 100644 --- a/man/ran_skewnorm.Rd +++ b/man/ran_skewnorm.Rd @@ -31,7 +31,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -40,6 +39,7 @@ Other ran_dist: \code{\link{ran_norm}()}, \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, -\code{\link{ran_student}()} +\code{\link{ran_student}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_student.Rd b/man/ran_student.Rd index 0dc5c32d..ac8ec58b 100644 --- a/man/ran_student.Rd +++ b/man/ran_student.Rd @@ -29,7 +29,6 @@ Other ran_dist: \code{\link{ran_bern}()}, \code{\link{ran_beta_binom}()}, \code{\link{ran_binom}()}, -\code{\link{ran_gamma_count}()}, \code{\link{ran_gamma_pois_zi}()}, \code{\link{ran_gamma_pois}()}, \code{\link{ran_gamma}()}, @@ -38,6 +37,7 @@ Other ran_dist: \code{\link{ran_norm}()}, \code{\link{ran_pois_zi}()}, \code{\link{ran_pois}()}, -\code{\link{ran_skewnorm}()} +\code{\link{ran_skewnorm}()}, +\code{\link{ran_upois}()} } \concept{ran_dist} diff --git a/man/ran_gamma_count.Rd b/man/ran_upois.Rd similarity index 69% rename from man/ran_gamma_count.Rd rename to man/ran_upois.Rd index cf2bb91a..27ad08cf 100644 --- a/man/ran_gamma_count.Rd +++ b/man/ran_upois.Rd @@ -1,26 +1,26 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ran.R -\name{ran_gamma_count} -\alias{ran_gamma_count} -\title{Gamma-Count Random Samples} +\name{ran_upois} +\alias{ran_upois} +\title{Underdispersed Poisson Random Samples} \usage{ -ran_gamma_count(n = 1, lambda = 1, alpha = 1) +ran_upois(n = 1, lambda = 1, theta = 0) } \arguments{ \item{n}{A non-negative whole number of the number of random samples to generate.} \item{lambda}{A non-negative numeric vector of means.} -\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} } \value{ A numeric vector of the random samples. } \description{ -Gamma-Count Random Samples +Underdispersed Poisson Random Samples } \examples{ -ran_gamma_count(n = 10, lambda = 1, alpha = 1) +ran_upois(n = 10, lambda = 1, theta = 1) } \seealso{ Other ran_dist: diff --git a/man/res_bern.Rd b/man/res_bern.Rd index 423bae3f..fa862d6a 100644 --- a/man/res_bern.Rd +++ b/man/res_bern.Rd @@ -28,7 +28,6 @@ res_bern(c(TRUE, FALSE), 0.7) Other res_dist: \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -38,6 +37,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_beta_binom.Rd b/man/res_beta_binom.Rd index 8f6dceac..3f066fbe 100644 --- a/man/res_beta_binom.Rd +++ b/man/res_beta_binom.Rd @@ -39,7 +39,6 @@ res_beta_binom(c(0, 1, 2), 4, 0.5, 0.1) Other res_dist: \code{\link{res_bern}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -49,6 +48,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_binom.Rd b/man/res_binom.Rd index 0610504d..2e66c045 100644 --- a/man/res_binom.Rd +++ b/man/res_binom.Rd @@ -30,7 +30,6 @@ res_binom(c(0, 1, 2), 2, 0.3) Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_gamma.Rd b/man/res_gamma.Rd index 785f08e5..2d57768f 100644 --- a/man/res_gamma.Rd +++ b/man/res_gamma.Rd @@ -31,7 +31,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_lnorm}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_gamma_pois.Rd b/man/res_gamma_pois.Rd index 080acccc..2eb7d7f8 100644 --- a/man/res_gamma_pois.Rd +++ b/man/res_gamma_pois.Rd @@ -31,7 +31,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma}()}, \code{\link{res_lnorm}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_gamma_pois_zi.Rd b/man/res_gamma_pois_zi.Rd index 0a18d251..9d14c7af 100644 --- a/man/res_gamma_pois_zi.Rd +++ b/man/res_gamma_pois_zi.Rd @@ -40,7 +40,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, \code{\link{res_lnorm}()}, @@ -49,6 +48,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_lnorm.Rd b/man/res_lnorm.Rd index e6ef6d5d..6bcc08ac 100644 --- a/man/res_lnorm.Rd +++ b/man/res_lnorm.Rd @@ -31,7 +31,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_neg_binom.Rd b/man/res_neg_binom.Rd index 226efa29..a8510c7b 100644 --- a/man/res_neg_binom.Rd +++ b/man/res_neg_binom.Rd @@ -31,7 +31,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_norm.Rd b/man/res_norm.Rd index b62c08db..1d683177 100644 --- a/man/res_norm.Rd +++ b/man/res_norm.Rd @@ -31,7 +31,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_pois.Rd b/man/res_pois.Rd index 70250ab5..efff57d9 100644 --- a/man/res_pois.Rd +++ b/man/res_pois.Rd @@ -29,7 +29,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -38,6 +37,7 @@ Other res_dist: \code{\link{res_norm}()}, \code{\link{res_pois_zi}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_pois_zi.Rd b/man/res_pois_zi.Rd index cf49b600..010cc935 100644 --- a/man/res_pois_zi.Rd +++ b/man/res_pois_zi.Rd @@ -31,7 +31,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -40,6 +39,7 @@ Other res_dist: \code{\link{res_norm}()}, \code{\link{res_pois}()}, \code{\link{res_skewnorm}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_skewnorm.Rd b/man/res_skewnorm.Rd index a70952cd..010594ce 100644 --- a/man/res_skewnorm.Rd +++ b/man/res_skewnorm.Rd @@ -33,7 +33,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -42,6 +41,7 @@ Other res_dist: \code{\link{res_norm}()}, \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, -\code{\link{res_student}()} +\code{\link{res_student}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_student.Rd b/man/res_student.Rd index 935e9781..c282480e 100644 --- a/man/res_student.Rd +++ b/man/res_student.Rd @@ -33,7 +33,6 @@ Other res_dist: \code{\link{res_bern}()}, \code{\link{res_beta_binom}()}, \code{\link{res_binom}()}, -\code{\link{res_gamma_count}()}, \code{\link{res_gamma_pois_zi}()}, \code{\link{res_gamma_pois}()}, \code{\link{res_gamma}()}, @@ -42,6 +41,7 @@ Other res_dist: \code{\link{res_norm}()}, \code{\link{res_pois_zi}()}, \code{\link{res_pois}()}, -\code{\link{res_skewnorm}()} +\code{\link{res_skewnorm}()}, +\code{\link{res_upois}()} } \concept{res_dist} diff --git a/man/res_gamma_count.Rd b/man/res_upois.Rd similarity index 78% rename from man/res_gamma_count.Rd rename to man/res_upois.Rd index 85c613e4..569a3859 100644 --- a/man/res_gamma_count.Rd +++ b/man/res_upois.Rd @@ -1,17 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/res.R -\name{res_gamma_count} -\alias{res_gamma_count} +\name{res_upois} +\alias{res_upois} \title{Gamma-Count Residuals} \usage{ -res_gamma_count(x, lambda = 1, alpha = 1, type = "dev", simulate = FALSE) +res_upois(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) } \arguments{ \item{x}{A non-negative whole numeric vector of values.} \item{lambda}{A non-negative numeric vector of means.} -\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} @@ -24,7 +24,7 @@ An numeric vector of the corresponding residuals. Gamma-Count Residuals } \examples{ -res_gamma_count(c(0, 1, 2), 1, 1) +res_upois(c(0, 1, 2), 1, 1) } \seealso{ Other res_dist: diff --git a/tests/testthat/test-dev.R b/tests/testthat/test-dev.R index 415c3349..795de1ba 100644 --- a/tests/testthat/test-dev.R +++ b/tests/testthat/test-dev.R @@ -768,3 +768,77 @@ test_that("skewnorm deviance", { deviance <- sum(dev_skewnorm(samples, coef(mod)[1])) expect_equal(deviance, deviance(mod)) }) + +test_that("upois known values", { + expect_identical(dev_upois(1, 1), 0) + expect_equal(dev_upois(1, 1, 1), 0.424635855096438) + expect_identical(dev_upois(0, 0), 0) + expect_identical(dev_upois(0, 0, 1), 0) + expect_identical(dev_upois(0, 0, 0), dev_pois(0, 0)) + expect_equal(dev_upois(0, 1, 0), dev_pois(0, 1)) + expect_equal(dev_upois(1, 0), Inf) + expect_equal(dev_upois(1, 0, 1), 0) + expect_equal(dev_upois(1, 0, 5), 0) + expect_equal(dev_upois(0, 1, 5), 2) + expect_equal(dev_upois(0, 1, 1), 2) + expect_equal(dev_upois(20, 1, 1), 77.139306160016) + expect_equal(dev_upois(10, 1, 5), 23.8440589297922) + expect_equal(dev_upois(0, 2, 5), 4) + expect_equal(dev_upois(0, 2, 1), 4) + expect_equal(dev_upois(3, 2, 1), 0.0831945648654893) + expect_equal(dev_upois(13, 2, 1), 24.0432116320838) + expect_equal(dev_upois(1, 2, 2), 2.25534033186796) + expect_equal(dev_upois(10, 2, 2), 13.6367082152856) + expect_equal(dev_upois(100, 2, 2), 579.376048918714) + expect_equal(dev_upois(10, 2, 0), dev_pois(10, 2)) + expect_equal(dev_upois(100, 2, 0), dev_pois(100, 2)) +}) + +test_that("upois vectorized", { + expect_equal(dev_upois(0:3, 2, 0.1), + c(4, 0.716043163399263, 0.00437744156764275, 0.346749115995378)) + expect_equal(dev_upois(c(0, 1, 3, 0), 3, 0.5), + c(6, 2.46944208933045, 0.0416124417688755, 6)) + expect_equal(dev_upois(0:3, 0:3, rep(1, 4)), + c(0, 0.424635855096438, 0.157573069847393, 0.0966910188449219 + )) + expect_equal(dev_upois(0:3, 3:0, 0:3), c(6, 1.61370563888011, 0.0377745205120377, Inf)) +}) + +test_that("upois vectorized missing values", { + expect_equal(dev_upois(c(NA,1), 0:1, 0:1), c(NA,0.424635855096438)) + expect_equal(dev_upois(c(0,NA), 0:1, 1:2), c(0,NA)) + expect_equal(dev_upois(c(0:1), c(NA,1), 1:2), c(NA, 0.830704476771521)) + expect_equal(dev_upois(c(0:1), c(0,NA), 1:2), c(0,NA)) + expect_equal(dev_upois(c(0:1), c(0:1), c(NA,1)), c(NA, 0.424635855096438)) + expect_equal(dev_upois(c(0:1), c(0:1), c(1,NA)), c(0,NA)) +}) + +test_that("upois res", { + expect_equal(dev_upois(10, 0.5, 0.5), dev_upois(10, 0.5, 0.5, res = TRUE)^2) + expect_equal(dev_upois(0:1, c(0.3,0.6), 0.5), dev_upois(0:1, c(0.3,0.6), 0.5, res = TRUE)^2) +}) + +test_that("upois log_lik", { + expect_equal(dev_upois(5:6, 1:2, 2:3), + 2 * (log_lik_upois(5:6, 5:6 - (2:3 / (1 + 2:3)), 2:3) - + log_lik_upois(5:6, 1:2, 2:3))) +}) + +test_that("upois ran", { + set.seed(101) + samples <- ran_upois(100000, 3, 0.5) + expect_equal(mean(samples), 3.33127) + expect_equal(var(samples), 3.18490203611947) + res <- dev_upois(samples, 3, 0.5, res = TRUE) + expect_equal(mean(res), -0.113602120823609) + expect_equal(sd(res), 1.02371893617533) +}) + +test_that("upois deviance", { + # Poisson case + samples <- ran_upois(1000, 3, 0) + mod <- glm(samples~1, family = poisson) + deviance <- sum(dev_upois(samples, exp(coef(mod)[1]))) + expect_equal(deviance, deviance(mod)) +}) diff --git a/tests/testthat/test-log-lik.R b/tests/testthat/test-log-lik.R index f64fb18e..601a2fb6 100644 --- a/tests/testthat/test-log-lik.R +++ b/tests/testthat/test-log-lik.R @@ -243,3 +243,43 @@ test_that("skewnorm vectorized", { c(-111.116353440211, -11.8095006207706, -11.1163537268622, -111.116353440211) ) }) + +test_that("upois missing values", { + expect_identical(log_lik_upois(numeric(0), numeric(0), numeric(0)), numeric(0)) + expect_identical(log_lik_upois(1, lambda = numeric(0)), numeric(0)) + expect_identical(log_lik_upois(1, 1, theta = numeric(0)), numeric(0)) + expect_identical(log_lik_upois(NA, 1, 1), NA_real_) + expect_identical(log_lik_upois(1, NA, 1), NA_real_) + expect_identical(log_lik_upois(1, 1, NA), NA_real_) +}) + +test_that("upois known values", { + expect_identical(log_lik_upois(1, 2), dpois(1, 2, log = TRUE)) + expect_identical(log_lik_upois(0, 2), dpois(0, 2, log = TRUE)) + expect_equal(log_lik_upois(0, 2, 1), -2.69314718055995) + expect_identical(log_lik_upois(1, 0, 0), -Inf) + expect_identical(log_lik_upois(0, 0, 0), 0) + expect_identical(log_lik_upois(1, 0, 10), log(10 / (1 + 10))) + expect_identical(log_lik_upois(0, 0, 10), log(1 / (1 + 10))) + expect_identical(log_lik_upois(100, 1000, 0), dpois(100, 1000, log = TRUE)) + expect_equal(log_lik_upois(3, 3.5, 0), log_lik_pois(3, 3.5)) + expect_equal(log_lik_upois(3, 3.5, 0), -1.53347056374195) + expect_equal(log_lik_upois(3, 3.5, 0.1), -1.5465426453093) + expect_equal(log_lik_upois(3, 3.5, 0.2), -1.55756811532101) + expect_equal(log_lik_upois(3, 3.5, 1), -1.60757853589567) +}) + +test_that("upois vectorized", { + expect_identical(log_lik_upois(0:1, 0:1, 0:1), c(0, -1)) + expect_equal(log_lik_upois(0:1, 0:1, 1:2), c(-0.693147180559945, -1)) + expect_identical(log_lik_upois(0:1, 0:1, 0), dpois(0:1, 0:1, log = TRUE)) + expect_identical(log_lik_upois(0:1, 1000, 0), dpois(0:1, 1000, log = TRUE)) + expect_equal(log_lik_upois(c(0, 2), 2, 0.5), c(-2.40546510810816, -1.30685281944005)) + expect_equal(log_lik_upois(c(0, 1, 3), c(0, 0, 1), 1), + c(-0.693147180559945, -0.693147180559945, -2.09861228866811)) + expect_equal(log_lik_upois(c(0, 1, 3), c(0, 0, 1), 2), + c(-1.09861228866811, -0.405465108108164, -1.94446160884085)) + expect_equal(log_lik_upois(c(19, 1000, 21), c(10, 2000, 10), c(0, 1, 10)), + c(-5.59076742031263, -311.513401018534, -6.33270476504199)) +}) + diff --git a/tests/testthat/test-ran.R b/tests/testthat/test-ran.R index 952cce80..e6e1966e 100644 --- a/tests/testthat/test-ran.R +++ b/tests/testthat/test-ran.R @@ -278,3 +278,41 @@ test_that("ran_skewnorm", { expect_equal(ran_skewnorm(2, c(10,100), sd = 0, shape = -1), c(10, 100)) expect_equal(ran_skewnorm(1, c(10,100), sd = 10, shape = -1), c(-2.24639864962439)) }) + + +test_that("ran_upois", { + expect_error(ran_upois(NA_integer_)) + expect_error(ran_upois(NULL)) + expect_error(ran_upois(integer(0))) + expect_error(ran_upois(-1)) + expect_error(ran_upois(1, -1, 1)) + expect_error(ran_upois(1, 1, -1)) + expect_identical(ran_upois(0L), integer(0)) + expect_warning(ran_upois(1L, 1:3, 1:2), c("longer argument not a multiple of length of shorter")) + set.seed(101) + expect_identical(ran_upois(1, 1, 0), 0L) + expect_identical(ran_upois(1, 2, 0), 1L) + expect_identical(ran_upois(1, 0, 0), 0L) + expect_identical(ran_upois(10, 1, 0), c(0L, 1L, 2L, 0L, 1L, 1L, 1L, 3L, 3L, 0L)) + expect_identical(length(ran_upois(10, 1, 0)), 10L) + expect_identical(ran_upois(1, 1000, 0), 1056L) + # Vectorized + set.seed(101) + expect_identical(ran_upois(2, c(1, 2), 0), c(1L, 1L)) + expect_identical(ran_upois(2, c(1, 1000), 0), c(2L, 1020L)) + expect_identical(ran_upois(10, 10, seq(0, 9, 1)), c(9L, 13L, 10L, 12L, 8L, 16L, 6L, 10L, 10L, 8L)) + # Correct mean + set.seed(101) + x <- ran_upois(10000, 10, 0) + expect_equal(mean(x), 10, tolerance = 0.01) + set.seed(101) + x <- ran_upois(10000, 10, 1) + expect_equal(mean(x), 10 + (1 / (1 + 1)), tolerance = 0.01) + # Correct variance + set.seed(101) + x <- ran_upois(10000, 10, 0) + expect_equal(var(x), 10, tolerance = 0.01) + set.seed(101) + x <- ran_upois(10000, 10, 1) + expect_equal(var(x), 10 + (1 / (1 + 1)^2), tolerance = 0.01) +}) diff --git a/tests/testthat/test-res.R b/tests/testthat/test-res.R index d7b02dfb..1f2c4cd8 100644 --- a/tests/testthat/test-res.R +++ b/tests/testthat/test-res.R @@ -570,3 +570,36 @@ test_that("res_skewnorm", { expect_equal(mean(res), 0.0236707225149864) expect_equal(sd(res), 3.34458775450197) }) + +test_that("res_upois", { + expect_identical(res_upois(integer(0), integer(0), integer(0)), numeric(0)) + expect_equal(res_upois(1, 1, 1), -0.651640894278772) + expect_identical(res_upois(1, 1, 1, type = "raw"), -0.5) + expect_equal(res_upois(1, 1, 0.5, type = "raw"), -1/3) + expect_equal(res_upois(1, 1, 0.5), -0.405015814635496) + expect_equal(res_upois(2, 2, 2, type = "raw"), -2/3) + expect_equal(res_upois(0, 1, 0, type = "raw"), -1) + expect_identical(res_upois(NA, 1, 1), NA_real_) + expect_identical(res_upois(1, NA, 1), NA_real_) + expect_identical(res_upois(1, 1, NA), NA_real_) + expect_error(res_upois(1, 3, 1, type = "unknown")) + expect_equal(res_upois(1, 3, 1, type = "raw"), -2.5) + expect_equal(res_upois(c(1,3.5,4), 3, 10, type = "raw"), + c(-2.90909090909091, -0.409090909090909, 0.0909090909090908)) + expect_equal(res_upois(c(1,3.5,4), 3, 5, type = "raw"), + c(-2.83333333333333, -0.333333333333333, 0.166666666666667)) + set.seed(101) + expect_equal(res_upois(1:2, 2, 2, simulate = TRUE, type = "raw"), c(-0.666666666666667, -2.66666666666667)) + expect_equal(res_upois(1:2, 2, 2, simulate = TRUE), c(-0.535571699965782, -0.535571699965782)) + set.seed(101) + expect_equal(res_upois(1:2, 2, 0.5, simulate = TRUE, type = "raw"), c(-0.333333333333333, -2.33333333333333)) + expect_equal(res_upois(1:2, 2, 0.5, simulate = TRUE), c(-1.06882485121411, -1.06882485121411)) + set.seed(101) + expect_equal(res_upois(1:2, 2, 1, simulate = TRUE, type = "data"), c(2L, 0L)) + set.seed(101) + expect_equal(res_upois(1:2, 2, 1, simulate = TRUE, type = "standardized"), c(-0.333333333333333, -1.66666666666667)) + set.seed(101) + res <- res_upois(rep(2, 10000), 2, 1, simulate = TRUE, type = "standardized") + expect_equal(mean(res), 0.00306666666666664) + expect_equal(sd(res), 1.00071178233097) +}) From eeaffbd0f0fab50579d54efb7231c241fd196450 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Thu, 23 Nov 2023 16:24:04 -0800 Subject: [PATCH 10/20] Clean up functions --- R/dev.R | 33 +-------------------------------- R/log-lik.R | 8 -------- R/ran.R | 3 --- R/res.R | 2 +- 4 files changed, 2 insertions(+), 44 deletions(-) diff --git a/R/dev.R b/R/dev.R index 2e6f1a8a..91b6b59e 100644 --- a/R/dev.R +++ b/R/dev.R @@ -109,42 +109,11 @@ dev_gamma <- function(x, shape = 1, rate = 1, res = FALSE) { #' @examples #' dev_upois(c(1,3.5,4), 3, 2) dev_upois <- function(x, lambda = 1, theta = 0, res = FALSE) { - # n <- 1000 - # lambda <- rlnorm(1, 8, 1) - # print(lambda) - # theta <- 1 - # x <- ran_upois(n, lambda, theta) - sat <- log_lik_upois(x = x, lambda = pmax(x - (theta / (1 + theta)), 0), theta = theta) ll <- log_lik_upois(x = x, lambda = lambda, theta = theta) -# -# ll_pois <- log_lik_pois(x = x, lambda = lambda) -# sat_pois <- log_lik_pois(x = x, lambda = x) -# -# test = tibble( -# x = rep(x, 4), -# ll = c(ll, sat, ll_pois, sat_pois), -# lik = c(rep(c(rep("ll", n), rep("sat", n)), 2)), -# type = c(rep("upois", n * 2), rep("pois", n * 2)) -# ) -# -# # dev <- tibble(x = rep(x, 2), ll = c(dev1, dev2), lik = c(rep("sat", length(dev1)), rep("reg", length(dev2)))) -# -# ggplot(test) + -# geom_line(aes(x = x, y = ll, colour = lik), alpha = 0.5) + -# facet_wrap(~type) -# -# check_dev <- sat - ll -# unique(check_dev[check_dev < 0]) -# chk_true(all(check_dev >= 0)) - - # Failing for lambda = 0.2492107, theta = 1 - # lambda = 5.488455, theta = 1 - # lambda = 0.4531443, theta = 1 - dev <- sat - ll dev <- 2 * dev - # Some cases where dev < 0, but all are very small diff (largest diff = 0.001) + # Some cases where dev < 0, but all are very small diff (largest 1e-3) neg <- dev < 0 dev[neg] <- 0 use_pois <- !is.na(theta) & theta == 0 diff --git a/R/log-lik.R b/R/log-lik.R index b49f6ef1..ad9fe02e 100644 --- a/R/log-lik.R +++ b/R/log-lik.R @@ -105,8 +105,6 @@ log_lik_upois <- function(x, lambda = 1, theta = 0) { (-lambda + (x - 1) * log(lambda) + log(lambda + theta * x)) - (log(1 + theta) + lfactorial(x)) - # log_lik <- rep(NaN, max(length(x), length(lambda), length(theta))) - x_lambda_zero <- x == 0 & lambda == 0 & !is.na(x) & !is.na(lambda) if (any(x_lambda_zero)) { log_lik[x_lambda_zero] <- log(1 / (1 + theta[x_lambda_zero])) @@ -122,12 +120,6 @@ log_lik_upois <- function(x, lambda = 1, theta = 0) { log_lik[zero] <- log_lik_pois(x[zero], lambda[zero]) } - # others <- !zero & !x_lambda_zero & !x_one_lambda_zero - - # log_lik[others] <- - # (-lambda[others] + (x[others] - 1) * log(lambda[others]) + log(lambda[others] + theta[others] * x[others])) - - # (log(1 + theta[others]) + lfactorial(x[others])) - log_lik } diff --git a/R/ran.R b/R/ran.R index dfbb145f..e038685e 100644 --- a/R/ran.R +++ b/R/ran.R @@ -90,8 +90,6 @@ ran_upois <- function(n = 1, lambda = 1, theta = 0) { chk_gte(n) chk_gte(lambda) chk_gte(theta) - # chk_compatible_lengths(rep(1, n), lambda, theta) - ### Figure out how to get this to work for a lambda/theta vector use_pois <- all(theta == 0 & !is.na(theta)) if (use_pois) { @@ -102,7 +100,6 @@ ran_upois <- function(n = 1, lambda = 1, theta = 0) { u = stats::runif(n) cmf <- pupois(0:max((ceiling(lambda) * 3), 50), lambda = lambda, theta = theta) ix <- min(which(abs(cmf - 1) < 1e-8)) - # ix <- min(which(cmf == 1)) first = min(which(cmf > 0)) cmf = unique(c(0, cmf[first:ix])) cmfTbl = table(cut(u, breaks = cmf, include.lowest = TRUE)) diff --git a/R/res.R b/R/res.R index a10398e4..cd1e40a4 100644 --- a/R/res.R +++ b/R/res.R @@ -109,7 +109,7 @@ res_gamma <- function(x, shape = 1, rate = 1, type = "dev", simulate = FALSE) { } -#' Gamma-Count Residuals +#' Underdispersed Poisson Residuals #' #' @inheritParams params #' @param x A non-negative whole numeric vector of values. From a5b27f855d623bd023675f1fe562095d086a9b74 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Thu, 23 Nov 2023 16:25:22 -0800 Subject: [PATCH 11/20] Update params documentation --- R/params.R | 2 +- man/dev_beta_binom.Rd | 2 +- man/dev_gamma_pois.Rd | 2 +- man/dev_gamma_pois_zi.Rd | 2 +- man/dev_neg_binom.Rd | 2 +- man/dev_student.Rd | 2 +- man/dev_upois.Rd | 2 +- man/log_lik_beta_binom.Rd | 2 +- man/log_lik_gamma_pois.Rd | 2 +- man/log_lik_gamma_pois_zi.Rd | 2 +- man/log_lik_neg_binom.Rd | 2 +- man/log_lik_student.Rd | 2 +- man/log_lik_upois.Rd | 2 +- man/params.Rd | 2 +- man/ran_beta_binom.Rd | 2 +- man/ran_gamma_pois.Rd | 2 +- man/ran_gamma_pois_zi.Rd | 2 +- man/ran_neg_binom.Rd | 2 +- man/ran_student.Rd | 2 +- man/ran_upois.Rd | 2 +- man/res_beta_binom.Rd | 2 +- man/res_gamma_pois.Rd | 2 +- man/res_gamma_pois_zi.Rd | 2 +- man/res_neg_binom.Rd | 2 +- man/res_student.Rd | 2 +- man/res_upois.Rd | 6 +++--- 26 files changed, 28 insertions(+), 28 deletions(-) diff --git a/R/params.R b/R/params.R index debf0ea4..45192280 100644 --- a/R/params.R +++ b/R/params.R @@ -18,7 +18,7 @@ #' @param size A non-negative whole numeric vector of the number of trials. #' @param prob A numeric vector of values between 0 and 1 of the probability of success. #' @param lambda A non-negative numeric vector of means. -#' @param theta A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial). +#' @param theta A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson). #' @param shape A non-negative numeric vector of shape. #' @param rate A non-negative numeric vector of rate. #' @param type A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data. diff --git a/man/dev_beta_binom.Rd b/man/dev_beta_binom.Rd index 15f2890b..482dc369 100644 --- a/man/dev_beta_binom.Rd +++ b/man/dev_beta_binom.Rd @@ -13,7 +13,7 @@ dev_beta_binom(x, size = 1, prob = 0.5, theta = 0, res = FALSE) \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } diff --git a/man/dev_gamma_pois.Rd b/man/dev_gamma_pois.Rd index cdc41d97..36dff2c5 100644 --- a/man/dev_gamma_pois.Rd +++ b/man/dev_gamma_pois.Rd @@ -11,7 +11,7 @@ dev_gamma_pois(x, lambda = 1, theta = 0, res = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } diff --git a/man/dev_gamma_pois_zi.Rd b/man/dev_gamma_pois_zi.Rd index d9b96d70..3b8835d2 100644 --- a/man/dev_gamma_pois_zi.Rd +++ b/man/dev_gamma_pois_zi.Rd @@ -11,7 +11,7 @@ dev_gamma_pois_zi(x, lambda = 1, theta = 0, prob = 0, res = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} diff --git a/man/dev_neg_binom.Rd b/man/dev_neg_binom.Rd index 37e7bbe1..117798a7 100644 --- a/man/dev_neg_binom.Rd +++ b/man/dev_neg_binom.Rd @@ -11,7 +11,7 @@ dev_neg_binom(x, lambda = 1, theta = 0, res = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } diff --git a/man/dev_student.Rd b/man/dev_student.Rd index 5097d944..8c5a053a 100644 --- a/man/dev_student.Rd +++ b/man/dev_student.Rd @@ -13,7 +13,7 @@ dev_student(x, mean = 0, sd = 1, theta = 0, res = FALSE) \item{sd}{A non-negative numeric vector of the standard deviations.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } diff --git a/man/dev_upois.Rd b/man/dev_upois.Rd index d8c7ba8e..dfe6d25f 100644 --- a/man/dev_upois.Rd +++ b/man/dev_upois.Rd @@ -11,7 +11,7 @@ dev_upois(x, lambda = 1, theta = 0, res = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{res}{A flag specifying whether to return the deviance residual as opposed to the deviance.} } diff --git a/man/log_lik_beta_binom.Rd b/man/log_lik_beta_binom.Rd index e18019e5..0bd3c3b4 100644 --- a/man/log_lik_beta_binom.Rd +++ b/man/log_lik_beta_binom.Rd @@ -13,7 +13,7 @@ log_lik_beta_binom(x, size = 1, prob = 0.5, theta = 0) \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ An numeric vector of the corresponding log-likelihoods. diff --git a/man/log_lik_gamma_pois.Rd b/man/log_lik_gamma_pois.Rd index fc9b8ff5..ddf06398 100644 --- a/man/log_lik_gamma_pois.Rd +++ b/man/log_lik_gamma_pois.Rd @@ -11,7 +11,7 @@ log_lik_gamma_pois(x, lambda = 1, theta = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ An numeric vector of the corresponding log-likelihoods. diff --git a/man/log_lik_gamma_pois_zi.Rd b/man/log_lik_gamma_pois_zi.Rd index 95a80de4..a11686ca 100644 --- a/man/log_lik_gamma_pois_zi.Rd +++ b/man/log_lik_gamma_pois_zi.Rd @@ -11,7 +11,7 @@ log_lik_gamma_pois_zi(x, lambda = 1, theta = 0, prob = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} } diff --git a/man/log_lik_neg_binom.Rd b/man/log_lik_neg_binom.Rd index 65890f19..6212690b 100644 --- a/man/log_lik_neg_binom.Rd +++ b/man/log_lik_neg_binom.Rd @@ -11,7 +11,7 @@ log_lik_neg_binom(x, lambda = 1, theta = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ An numeric vector of the corresponding log-likelihoods. diff --git a/man/log_lik_student.Rd b/man/log_lik_student.Rd index 1e1d7a07..4c272d68 100644 --- a/man/log_lik_student.Rd +++ b/man/log_lik_student.Rd @@ -13,7 +13,7 @@ log_lik_student(x, mean = 0, sd = 1, theta = 0) \item{sd}{A non-negative numeric vector of the standard deviations.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ An numeric vector of the corresponding log-likelihoods. diff --git a/man/log_lik_upois.Rd b/man/log_lik_upois.Rd index fc62980f..786cd9f6 100644 --- a/man/log_lik_upois.Rd +++ b/man/log_lik_upois.Rd @@ -11,7 +11,7 @@ log_lik_upois(x, lambda = 1, theta = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ An numeric vector of the corresponding log-likelihoods. diff --git a/man/params.Rd b/man/params.Rd index 7bdbf90a..b574b655 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -36,7 +36,7 @@ should be returned as negative values.} \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{shape}{A non-negative numeric vector of shape.} diff --git a/man/ran_beta_binom.Rd b/man/ran_beta_binom.Rd index 9baa501e..1978a62a 100644 --- a/man/ran_beta_binom.Rd +++ b/man/ran_beta_binom.Rd @@ -13,7 +13,7 @@ ran_beta_binom(n = 1, size = 1, prob = 0.5, theta = 0) \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ A numeric vector of the random samples. diff --git a/man/ran_gamma_pois.Rd b/man/ran_gamma_pois.Rd index 617adf6d..17658b99 100644 --- a/man/ran_gamma_pois.Rd +++ b/man/ran_gamma_pois.Rd @@ -11,7 +11,7 @@ ran_gamma_pois(n = 1, lambda = 1, theta = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ A numeric vector of the random samples. diff --git a/man/ran_gamma_pois_zi.Rd b/man/ran_gamma_pois_zi.Rd index b2105e87..de599f29 100644 --- a/man/ran_gamma_pois_zi.Rd +++ b/man/ran_gamma_pois_zi.Rd @@ -11,7 +11,7 @@ ran_gamma_pois_zi(n = 1, lambda = 1, theta = 0, prob = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} } diff --git a/man/ran_neg_binom.Rd b/man/ran_neg_binom.Rd index f78317e3..b07f20ea 100644 --- a/man/ran_neg_binom.Rd +++ b/man/ran_neg_binom.Rd @@ -11,7 +11,7 @@ ran_neg_binom(n = 1, lambda = 1, theta = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ A numeric vector of the random samples. diff --git a/man/ran_student.Rd b/man/ran_student.Rd index ac8ec58b..9a5da01b 100644 --- a/man/ran_student.Rd +++ b/man/ran_student.Rd @@ -13,7 +13,7 @@ ran_student(n = 1, mean = 0, sd = 1, theta = 0) \item{sd}{A non-negative numeric vector of the standard deviations.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ A numeric vector of the random samples. diff --git a/man/ran_upois.Rd b/man/ran_upois.Rd index 27ad08cf..1d7d0d1e 100644 --- a/man/ran_upois.Rd +++ b/man/ran_upois.Rd @@ -11,7 +11,7 @@ ran_upois(n = 1, lambda = 1, theta = 0) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} } \value{ A numeric vector of the random samples. diff --git a/man/res_beta_binom.Rd b/man/res_beta_binom.Rd index 3f066fbe..bdc00fb0 100644 --- a/man/res_beta_binom.Rd +++ b/man/res_beta_binom.Rd @@ -20,7 +20,7 @@ res_beta_binom( \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} diff --git a/man/res_gamma_pois.Rd b/man/res_gamma_pois.Rd index 2eb7d7f8..83c6caed 100644 --- a/man/res_gamma_pois.Rd +++ b/man/res_gamma_pois.Rd @@ -11,7 +11,7 @@ res_gamma_pois(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} diff --git a/man/res_gamma_pois_zi.Rd b/man/res_gamma_pois_zi.Rd index 9d14c7af..6f1b467d 100644 --- a/man/res_gamma_pois_zi.Rd +++ b/man/res_gamma_pois_zi.Rd @@ -18,7 +18,7 @@ res_gamma_pois_zi( \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{prob}{A numeric vector of values between 0 and 1 of the probability of success.} diff --git a/man/res_neg_binom.Rd b/man/res_neg_binom.Rd index a8510c7b..0e1d4be7 100644 --- a/man/res_neg_binom.Rd +++ b/man/res_neg_binom.Rd @@ -11,7 +11,7 @@ res_neg_binom(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} diff --git a/man/res_student.Rd b/man/res_student.Rd index c282480e..435b76e5 100644 --- a/man/res_student.Rd +++ b/man/res_student.Rd @@ -13,7 +13,7 @@ res_student(x, mean = 0, sd = 1, theta = 0, type = "dev", simulate = FALSE) \item{sd}{A non-negative numeric vector of the standard deviations.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} diff --git a/man/res_upois.Rd b/man/res_upois.Rd index 569a3859..0b32c5fd 100644 --- a/man/res_upois.Rd +++ b/man/res_upois.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/res.R \name{res_upois} \alias{res_upois} -\title{Gamma-Count Residuals} +\title{Underdispersed Poisson Residuals} \usage{ res_upois(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) } @@ -11,7 +11,7 @@ res_upois(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) \item{lambda}{A non-negative numeric vector of means.} -\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson and beta-binomial).} +\item{theta}{A non-negative numeric vector of the dispersion for the mixture models (student, gamma-Poisson, beta-binomial, and underdispersed Poisson).} \item{type}{A string of the residual type. 'raw' for raw residuals 'dev' for deviance residuals and 'data' for the data.} @@ -21,7 +21,7 @@ res_upois(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) An numeric vector of the corresponding residuals. } \description{ -Gamma-Count Residuals +Underdispersed Poisson Residuals } \examples{ res_upois(c(0, 1, 2), 1, 1) From 8c13f9147a05ac17b79fa7c6a7dc41b34babe24c Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Thu, 23 Nov 2023 17:12:42 -0800 Subject: [PATCH 12/20] Delete gamma-count parameter --- R/params.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/params.R b/R/params.R index 45192280..7dfe79d4 100644 --- a/R/params.R +++ b/R/params.R @@ -29,6 +29,5 @@ #' @param lower.tail A flag specifying whether to return the lower or upper tail of the distribution. #' @param q A vector of quantiles. #' @param p A vector of probabilities. -#' @param alpha A non-negative numeric vector of the dispersion parameter for the gamma-count distribution. #' @name params NULL From b3d732769d6140b19865b6b1b25b550727582715 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 09:29:36 -0800 Subject: [PATCH 13/20] Clean up extra function --- R/ran.R | 8 -------- 1 file changed, 8 deletions(-) diff --git a/R/ran.R b/R/ran.R index e038685e..33fd6d9a 100644 --- a/R/ran.R +++ b/R/ran.R @@ -66,14 +66,6 @@ ran_gamma <- function(n = 1, shape = 1, rate = 1) { # Cumulative distribution function for underdispersed poisson distribution pupois <- function(q, lambda, theta) { sapply(q, \(x) {sum(exp(log_lik_upois(0:x, lambda, theta)))}) - # mapply( - # \(q, lambda, theta) { - # sum(exp(log_lik_upois(0:q, lambda, theta))) - # }, - # q = q, - # lambda = lambda, - # theta = theta - # ) } #' Underdispersed Poisson Random Samples From f7e7357a4372a6c668f3ce046aa8df7644827aa5 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 09:40:29 -0800 Subject: [PATCH 14/20] Update params file --- man/params.Rd | 2 -- 1 file changed, 2 deletions(-) diff --git a/man/params.Rd b/man/params.Rd index b574b655..988758d1 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -57,8 +57,6 @@ should be returned as negative values.} \item{q}{A vector of quantiles.} \item{p}{A vector of probabilities.} - -\item{alpha}{A non-negative numeric vector of the dispersion parameter for the gamma-count distribution.} } \description{ Parameter Descriptions From a1873c683afc94cdf16523826076e9dd50b56d58 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 09:40:54 -0800 Subject: [PATCH 15/20] Put functions in alphabetical order --- R/dev.R | 51 +++++++++++++------------ R/log-lik.R | 90 ++++++++++++++++++++++---------------------- R/ran.R | 106 ++++++++++++++++++++++++++-------------------------- R/res.R | 61 +++++++++++++++--------------- 4 files changed, 153 insertions(+), 155 deletions(-) diff --git a/R/dev.R b/R/dev.R index 91b6b59e..22397440 100644 --- a/R/dev.R +++ b/R/dev.R @@ -97,32 +97,6 @@ dev_gamma <- function(x, shape = 1, rate = 1, res = FALSE) { dev_res(x, mu, dev) } -#' Underdispersed Poisson Deviances -#' -#' @inheritParams params -#' @param x A non-negative whole numeric vector of values. -#' -#' @return An numeric vector of the corresponding deviances or deviance residuals. -#' @family dev_dist -#' @export -#' -#' @examples -#' dev_upois(c(1,3.5,4), 3, 2) -dev_upois <- function(x, lambda = 1, theta = 0, res = FALSE) { - sat <- log_lik_upois(x = x, lambda = pmax(x - (theta / (1 + theta)), 0), theta = theta) - ll <- log_lik_upois(x = x, lambda = lambda, theta = theta) - dev <- sat - ll - dev <- 2 * dev - # Some cases where dev < 0, but all are very small diff (largest 1e-3) - neg <- dev < 0 - dev[neg] <- 0 - use_pois <- !is.na(theta) & theta == 0 - dev_pois <- dev_pois(x = x, lambda = lambda, res = FALSE) - dev[use_pois] <- dev_pois[use_pois] - if(vld_false(res)) return(dev) - dev_res(x, lambda + (theta / (1 + theta)), dev) -} - #' Gamma-Poisson Deviances #' #' @inheritParams params @@ -313,3 +287,28 @@ dev_student <- function(x, mean = 0, sd = 1, theta = 0, res = FALSE) { dev_res(x, mean, dev) } +#' Underdispersed Poisson Deviances +#' +#' @inheritParams params +#' @param x A non-negative whole numeric vector of values. +#' +#' @return An numeric vector of the corresponding deviances or deviance residuals. +#' @family dev_dist +#' @export +#' +#' @examples +#' dev_upois(c(1,3.5,4), 3, 2) +dev_upois <- function(x, lambda = 1, theta = 0, res = FALSE) { + sat <- log_lik_upois(x = x, lambda = pmax(x - (theta / (1 + theta)), 0), theta = theta) + ll <- log_lik_upois(x = x, lambda = lambda, theta = theta) + dev <- sat - ll + dev <- 2 * dev + # Some cases where dev < 0, but all are very small diff (largest 1e-3) + neg <- dev < 0 + dev[neg] <- 0 + use_pois <- !is.na(theta) & theta == 0 + dev_pois <- dev_pois(x = x, lambda = lambda, res = FALSE) + dev[use_pois] <- dev_pois[use_pois] + if(vld_false(res)) return(dev) + dev_res(x, lambda + (theta / (1 + theta)), dev) +} diff --git a/R/log-lik.R b/R/log-lik.R index ad9fe02e..f14557fd 100644 --- a/R/log-lik.R +++ b/R/log-lik.R @@ -78,51 +78,6 @@ log_lik_gamma <- function(x, shape = 1, rate = 1) { stats::dgamma(x, shape = shape, rate = rate, log = TRUE) } -#' Underdispersed Poisson Log-Likelihood -#' -#' @inheritParams params -#' @param x A non-negative whole numeric vector of values. -#' -#' @return An numeric vector of the corresponding log-likelihoods. -#' @family log_lik_dist -#' @export -#' -#' @examples -#' log_lik_upois(c(0, 1, 2), 1, 0) -log_lik_upois <- function(x, lambda = 1, theta = 0) { - chk_gte(lambda) - chk_gte(theta) - - if (length(theta) == 1) { - theta <- rep(theta, length(x)) - } - - if (length(lambda) == 1) { - lambda <- rep(lambda, length(x)) - } - - log_lik <- - (-lambda + (x - 1) * log(lambda) + log(lambda + theta * x)) - - (log(1 + theta) + lfactorial(x)) - - x_lambda_zero <- x == 0 & lambda == 0 & !is.na(x) & !is.na(lambda) - if (any(x_lambda_zero)) { - log_lik[x_lambda_zero] <- log(1 / (1 + theta[x_lambda_zero])) - } - - x_one_lambda_zero <- x == 1 & lambda == 0 & !is.na(x) & !is.na(lambda) - if (any(x_one_lambda_zero)) { - log_lik[x_one_lambda_zero] <- log(theta[x_one_lambda_zero] / (1 + theta[x_one_lambda_zero])) - } - - zero <- theta == 0 & !is.na(theta) & !is.na(lambda) & !is.na(x) - if (any(zero)) { - log_lik[zero] <- log_lik_pois(x[zero], lambda[zero]) - } - - log_lik -} - #' Gamma-Poisson Log-Likelihood #' #' @inheritParams params @@ -285,3 +240,48 @@ log_lik_student <- function(x, mean = 0, sd = 1, theta = 0) { lstudent[use_norm] <- lnorm[use_norm] lstudent } + +#' Underdispersed Poisson Log-Likelihood +#' +#' @inheritParams params +#' @param x A non-negative whole numeric vector of values. +#' +#' @return An numeric vector of the corresponding log-likelihoods. +#' @family log_lik_dist +#' @export +#' +#' @examples +#' log_lik_upois(c(0, 1, 2), 1, 0) +log_lik_upois <- function(x, lambda = 1, theta = 0) { + chk_gte(lambda) + chk_gte(theta) + + if (length(theta) == 1) { + theta <- rep(theta, length(x)) + } + + if (length(lambda) == 1) { + lambda <- rep(lambda, length(x)) + } + + log_lik <- + (-lambda + (x - 1) * log(lambda) + log(lambda + theta * x)) - + (log(1 + theta) + lfactorial(x)) + + x_lambda_zero <- x == 0 & lambda == 0 & !is.na(x) & !is.na(lambda) + if (any(x_lambda_zero)) { + log_lik[x_lambda_zero] <- log(1 / (1 + theta[x_lambda_zero])) + } + + x_one_lambda_zero <- x == 1 & lambda == 0 & !is.na(x) & !is.na(lambda) + if (any(x_one_lambda_zero)) { + log_lik[x_one_lambda_zero] <- log(theta[x_one_lambda_zero] / (1 + theta[x_one_lambda_zero])) + } + + zero <- theta == 0 & !is.na(theta) & !is.na(lambda) & !is.na(x) + if (any(zero)) { + log_lik[zero] <- log_lik_pois(x[zero], lambda[zero]) + } + + log_lik +} diff --git a/R/ran.R b/R/ran.R index 33fd6d9a..4376816a 100644 --- a/R/ran.R +++ b/R/ran.R @@ -63,59 +63,6 @@ ran_gamma <- function(n = 1, shape = 1, rate = 1) { stats::rgamma(n, shape = shape, rate = rate) } -# Cumulative distribution function for underdispersed poisson distribution -pupois <- function(q, lambda, theta) { - sapply(q, \(x) {sum(exp(log_lik_upois(0:x, lambda, theta)))}) -} - -#' Underdispersed Poisson Random Samples -#' -#' @inheritParams params -#' @return A numeric vector of the random samples. -#' @family ran_dist -#' @export -#' -#' @examples -#' ran_upois(n = 10, lambda = 1, theta = 1) -ran_upois <- function(n = 1, lambda = 1, theta = 0) { - chk_whole_number(n) - chk_gte(n) - chk_gte(lambda) - chk_gte(theta) - - use_pois <- all(theta == 0 & !is.na(theta)) - if (use_pois) { - stats::rpois(n, lambda = lambda) - } - - fun <- function(n, lambda, theta) { - u = stats::runif(n) - cmf <- pupois(0:max((ceiling(lambda) * 3), 50), lambda = lambda, theta = theta) - ix <- min(which(abs(cmf - 1) < 1e-8)) - first = min(which(cmf > 0)) - cmf = unique(c(0, cmf[first:ix])) - cmfTbl = table(cut(u, breaks = cmf, include.lowest = TRUE)) - X = rep(1:length(cmfTbl), as.numeric(cmfTbl)) - 1 + ifelse(first > 1, first, 0) - X <- as.integer(X) - samp <- sample(1:n, size = n) - X[samp] - } - - lambda_vec <- length(lambda) > 1L & length(unique(lambda)) != 1 - theta_vec <- length(theta) > 1L & length(unique(theta)) != 1 - if (lambda_vec | theta_vec) { - n_rep <- rep(1, n) - mapply( - fun, - n = n_rep, - lambda = lambda, - theta = theta - ) - } else { - fun(n, lambda[1], theta[1]) - } -} - #' Gamma-Poisson Random Samples #' #' @inheritParams params @@ -253,3 +200,56 @@ ran_student <- function(n = 1, mean = 0, sd = 1, theta = 0) { r <- x * sd + mean r } + +# Cumulative distribution function for underdispersed poisson distribution +pupois <- function(q, lambda, theta) { + sapply(q, \(x) {sum(exp(log_lik_upois(0:x, lambda, theta)))}) +} + +#' Underdispersed Poisson Random Samples +#' +#' @inheritParams params +#' @return A numeric vector of the random samples. +#' @family ran_dist +#' @export +#' +#' @examples +#' ran_upois(n = 10, lambda = 1, theta = 1) +ran_upois <- function(n = 1, lambda = 1, theta = 0) { + chk_whole_number(n) + chk_gte(n) + chk_gte(lambda) + chk_gte(theta) + + use_pois <- all(theta == 0 & !is.na(theta)) + if (use_pois) { + stats::rpois(n, lambda = lambda) + } + + fun <- function(n, lambda, theta) { + u = stats::runif(n) + cmf <- pupois(0:max((ceiling(lambda) * 3), 50), lambda = lambda, theta = theta) + last <- min(which(abs(cmf - 1) < 1e-8)) + first = min(which(cmf > 0)) + cmf = unique(c(0, cmf[first:last])) + cmf_tbl = table(cut(u, breaks = cmf, include.lowest = TRUE)) + x = rep(1:length(cmf_tbl), as.numeric(cmf_tbl)) - 1 + ifelse(first > 1, first, 0) + x <- as.integer(x) + samp <- sample(1:n, size = n) + x[samp] + } + + lambda_vec <- length(lambda) > 1L & length(unique(lambda)) != 1 + theta_vec <- length(theta) > 1L & length(unique(theta)) != 1 + if (lambda_vec | theta_vec) { + n_rep <- rep(1, n) + mapply( + fun, + n = n_rep, + lambda = lambda, + theta = theta + ) + } else { + fun(n, lambda[1], theta[1]) + } +} diff --git a/R/res.R b/R/res.R index cd1e40a4..0b3015a4 100644 --- a/R/res.R +++ b/R/res.R @@ -108,37 +108,6 @@ res_gamma <- function(x, shape = 1, rate = 1, type = "dev", simulate = FALSE) { chk_subset(x, c("data", "raw", "dev", "standardized"))) } - -#' Underdispersed Poisson Residuals -#' -#' @inheritParams params -#' @param x A non-negative whole numeric vector of values. -#' -#' @return An numeric vector of the corresponding residuals. -#' @family res_dist -#' @export -#' -#' @examples -#' res_upois(c(0, 1, 2), 1, 1) -res_upois <- function(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) { - chk_string(type) - if(!vld_false(simulate)) { - x <- ran_upois(length(x), lambda = lambda, theta = theta) - } - if (length(lambda) == 1) { - lambda <- rep(lambda, length(x)) - } - if (length(theta) == 1) { - theta <- rep(theta, length(x)) - } - switch(type, - data = x, - raw = x - (lambda + (theta / (1 + theta))), - standardized = (x - (lambda + (theta / (1 + theta)))) / sqrt(lambda + (theta / (1 + theta)^2)), - dev = dev_upois(x, lambda = lambda, theta = theta, res = TRUE), - chk_subset(x, c("data", "raw", "dev", "standardized"))) -} - #' Gamma-Poisson Residuals #' #' @inheritParams params @@ -376,3 +345,33 @@ res_student <- function(x, mean = 0, sd = 1, theta = 0, type = "dev", simulate = dev = dev_student(x, mean = mean, sd = sd, theta = theta, res = TRUE), chk_subset(x, c("data", "raw", "dev", "standardized"))) } + +#' Underdispersed Poisson Residuals +#' +#' @inheritParams params +#' @param x A non-negative whole numeric vector of values. +#' +#' @return An numeric vector of the corresponding residuals. +#' @family res_dist +#' @export +#' +#' @examples +#' res_upois(c(0, 1, 2), 1, 1) +res_upois <- function(x, lambda = 1, theta = 0, type = "dev", simulate = FALSE) { + chk_string(type) + if(!vld_false(simulate)) { + x <- ran_upois(length(x), lambda = lambda, theta = theta) + } + if (length(lambda) == 1) { + lambda <- rep(lambda, length(x)) + } + if (length(theta) == 1) { + theta <- rep(theta, length(x)) + } + switch(type, + data = x, + raw = x - (lambda + (theta / (1 + theta))), + standardized = (x - (lambda + (theta / (1 + theta)))) / sqrt(lambda + (theta / (1 + theta)^2)), + dev = dev_upois(x, lambda = lambda, theta = theta, res = TRUE), + chk_subset(x, c("data", "raw", "dev", "standardized"))) +} From bbed1a6133c1b0413bfb3c288211fcdb76ce4f47 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 10:03:46 -0800 Subject: [PATCH 16/20] Remove unnecessary imports --- DESCRIPTION | 1 - R/namespace.R | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3a0ec180..dfb2f18e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,7 +31,6 @@ Suggests: aods3, covr, hms, - gammacount, ggplot2, knitr, MASS, diff --git a/R/namespace.R b/R/namespace.R index 5e51c71b..592b2d31 100644 --- a/R/namespace.R +++ b/R/namespace.R @@ -1,3 +1,3 @@ #' @import chk -#' @importFrom stats dbinom dlnorm dnorm dpois dnbinom pgamma +#' @importFrom stats dbinom dlnorm dnorm dpois dnbinom NULL From bff89976081dd0b2d31334b9bbc57131e00f6a7d Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 10:03:53 -0800 Subject: [PATCH 17/20] Remove testing files --- R/test-dev-upois-2.R | 153 ------------------------------------------- R/test-dev-upois.R | 149 ----------------------------------------- 2 files changed, 302 deletions(-) delete mode 100644 R/test-dev-upois-2.R delete mode 100644 R/test-dev-upois.R diff --git a/R/test-dev-upois-2.R b/R/test-dev-upois-2.R deleted file mode 100644 index 2f780611..00000000 --- a/R/test-dev-upois-2.R +++ /dev/null @@ -1,153 +0,0 @@ -# # Test gamma count deviance -# library(dplyr) -# library(tidyr) -# library(ggplot2) -# -# # When you pick nice numbers, the alpha < 0.5 rule works -# # pars_theta <- c(seq(0.1, 1.1, by = 0.05), seq(2, 20, by = 0.5)) -# # pars_lambda <- seq(1, 10000, by = 100) -# # -# # pars <- expand_grid(lambda = pars_lambda, theta = pars_theta) -# # pars$fail <- NA -# -# # But when you pick stranger values, it doesn't :( -# pars2_theta <- rlnorm(10, 1, 1) -# pars2_lambda <- rlnorm(10, 2, 1) -# -# pars2 <- expand_grid(lambda = pars2_lambda, theta = pars2_theta) -# pars2$fail_x <- NA -# pars2$fail_mean <- NA -# pars2$diff_x <- NA -# pars2$diff_mean <- NA -# pars2$dev <- NA -# -# for (i in 1:nrow(pars2)) { -# # print(paste("i = ", i, ", theta is ", pull(pars2[i, "theta"]), ", lambda is ", pull(pars2[i, "lambda"]))) -# n <- 1000 -# lambda <- pull(pars2[i, "lambda"]) -# theta <- pull(pars2[i, "theta"]) -# x <- ran_upois(n, lambda, theta) -# -# test <- -# tibble( -# x = x, lambda = lambda, theta = theta -# ) %>% -# mutate( -# ll = log_lik_upois(x, lambda, theta) -# ) -# -# test$sat_x = log_lik_upois(test$x, pmax(test$x - (test$theta / (1 + test$theta)), 0), test$theta) -# # test$sat_mean = log_lik_upois(test$mean, test$lambda, test$theta) -# test$dev <- dev_upois(test$x, test$lambda, test$theta, res = TRUE) -# -# # chk_false(any(test$sat < test$ll)) -# pars2$fail_x[i] <- vld_true(any(test$sat_x < test$ll)) -# # pars2$fail_mean[i] <- vld_true(any(test$sat_mean < test$ll)) -# -# diff <- test$sat_x[test$sat_x < test$ll] - test$ll[test$sat_x < test$ll] -# pars2$diff_x[i] <- mean(diff) -# pars2$dev[i] <- any(dev < 0) -# # diff <- test$sat_mean[test$sat_mean < test$ll] - test$ll[test$sat_mean < test$ll] -# # pars2$diff_mean[i] <- mean(diff) -# -# -# # opt_gamma_count <- function(alpha, x, lambda) { -# # -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) -# # } -# # if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} -# # if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} -# # opt_alpha <- rep(NA, length(x)) -# # bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) -# # for (i in seq_along(x)) { -# # if (bol[i] & !is.na(bol[i])) { -# # opt_alpha[i] <- stats::optimize( -# # opt_gamma_count, -# # interval = c(0, 1e10), -# # x = x[i], -# # lambda = lambda[i] -# # )$minimum -# # } -# # } -# -# # test$dev <- dev_gamma_count(x, lambda, alpha) -# # test$sat <- test$dev / 2 + test$ll -# -# # test$ll_pois <- log_lik_pois(test$x, test$lambda) -# # test$sat_pois <- log_lik_pois(test$x, test$x) -# -# # test$ll_pois <- log_lik_pois(test$x, test$lambda) -# # test$sat_pois <- log_lik_pois(test$x, test$x) -# # -# # ggplot(test) + -# # geom_line(aes(x = x, y = ll), colour = "red") + -# # geom_line(aes(x = x, y = sat), colour = "firebrick") + -# # geom_line(aes(x = x, y = ll_pois), colour = "blue") + -# # geom_line(aes(x = x, y = sat_pois), colour = "steelblue") -# -# # test$mean <- NA -# # for (i in 1:nrow(test)) { -# # test$mean[i] <- mean_gamma_count(test$lambda[i], test$alpha[i]) -# # } -# # -# # test %>% dplyr::arrange(desc(ll)) -# } -# -# pars2 %>% filter(!dev) -# # -# # # pars2 %>% -# # # filter(fail_mean) %>% -# # # ggplot() + -# # # geom_histogram(aes(x = theta)) -# # -# # pars2 %>% -# # filter(fail_x) %>% -# # ggplot() + -# # geom_histogram(aes(x = theta)) -# # -# # pars2 %>% -# # filter(fail_x) %>% -# # ggplot() + -# # geom_histogram(aes(x = diff_x)) -# # -# # # pars2 %>% -# # # filter(fail_mean) %>% -# # # ggplot() + -# # # geom_histogram(aes(x = diff_mean)) -# # -# # # lambda theta fail_x fail_mean diff_x diff_mean -# # # -# # # 1 1.27 1.62 TRUE NA -0.00294 NA -# # # 2 1.27 2.29 TRUE NA -0.00175 NA -# # # 3 1.27 1.24 TRUE NA -0.000488 NA -# # # -# # # lambda theta fail_x fail_mean diff_x diff_mean -# # # -# # # 1 8.26 2.71 TRUE NA -0.0000133 NA -# # -# # # lambda theta fail_x fail_mean diff_x diff_mean -# # # -# # # 1 4.82 0.225 TRUE NA -0.000000189 NA -# # -# # # lambda theta fail_x fail_mean diff_x diff_mean -# # # -# # # 1 7.23 3.12 TRUE NA -0.0000218 NA -# # # 2 1.45 0.778 TRUE NA -0.00106 NA -# # # 3 1.45 0.824 TRUE NA -0.00148 NA -# # # 4 1.45 1.20 TRUE NA -0.000155 NA -# # # 5 1.45 0.794 TRUE NA -0.00123 NA -# # # 6 13.5 1.20 TRUE NA -0.00000215 NA -# # # 7 5.41 1.20 TRUE NA -0.00000334 NA -# # -# # # lambda theta fail_x fail_mean diff_x diff_mean -# # # -# # # 1 11.5 0.987 TRUE NA -0.000000263 NA -# # # 2 11.5 0.947 TRUE NA -0.00000475 NA -# # # 3 2.49 0.987 TRUE NA -0.000143 NA -# # # 4 2.49 0.947 TRUE NA -0.000271 NA -# # -# # # lambda theta fail_x fail_mean diff_x diff_mean -# # # -# # # 1 9.18 3.96 TRUE NA -0.00000472 NA -# # # 2 9.18 4.23 TRUE NA -0.00000892 NA -# # # 3 3.31 1.56 TRUE NA -0.0000203 NA -# # # 4 4.34 1.56 TRUE NA -0.0000655 NA diff --git a/R/test-dev-upois.R b/R/test-dev-upois.R deleted file mode 100644 index 15c808ce..00000000 --- a/R/test-dev-upois.R +++ /dev/null @@ -1,149 +0,0 @@ -# # Test gamma count deviance -# library(dplyr) -# library(tidyr) -# library(ggplot2) -# -# # When you pick nice numbers, the alpha < 0.5 rule works -# # pars_theta <- c(seq(0.1, 1.1, by = 0.05), seq(2, 20, by = 0.5)) -# # pars_lambda <- seq(1, 10000, by = 100) -# # -# # pars <- expand_grid(lambda = pars_lambda, theta = pars_theta) -# # pars$fail <- NA -# -# # But when you pick stranger values, it doesn't :( -# pars2_theta <- rlnorm(10, 1, 1) -# pars2_lambda <- rlnorm(10, 2, 1) -# -# pars2 <- expand_grid(lambda = pars2_lambda, theta = pars2_theta) -# pars2$fail_x <- NA -# pars2$fail_mean <- NA -# pars2$diff_x <- NA -# pars2$diff_mean <- NA -# -# for (i in 1:nrow(pars2)) { -# print(paste("i = ", i, ", theta is ", pull(pars2[i, "theta"]), ", lambda is ", pull(pars2[i, "lambda"]))) -# n <- 1000 -# lambda <- pull(pars2[i, "lambda"]) -# theta <- pull(pars2[i, "theta"]) -# x <- ran_upois(n, lambda, theta) -# -# test <- -# tibble( -# x = x, lambda = lambda, theta = theta -# ) %>% -# mutate( -# ll = log_lik_upois(x, lambda, theta) -# ) -# -# test$sat_x = log_lik_upois(test$x, pmax(test$x - (test$theta / (1 + test$theta)), 0), test$theta) -# # test$sat_mean = log_lik_upois(test$mean, test$lambda, test$theta) -# -# # chk_false(any(test$sat < test$ll)) -# pars2$fail_x[i] <- vld_true(any(test$sat_x < test$ll)) -# # pars2$fail_mean[i] <- vld_true(any(test$sat_mean < test$ll)) -# -# diff <- test$sat_x[test$sat_x < test$ll] - test$ll[test$sat_x < test$ll] -# pars2$diff_x[i] <- mean(diff) -# # diff <- test$sat_mean[test$sat_mean < test$ll] - test$ll[test$sat_mean < test$ll] -# # pars2$diff_mean[i] <- mean(diff) -# -# -# # opt_gamma_count <- function(alpha, x, lambda) { -# # -log_lik_gamma_count(x = x, lambda = lambda, alpha = alpha) -# # } -# # if (length(lambda) == 1) {lambda <- rep(lambda, length(x))} -# # if (length(alpha) == 1) {alpha <- rep(alpha, length(x))} -# # opt_alpha <- rep(NA, length(x)) -# # bol <- !is.na(x) & !is.na(lambda) & !is.na(alpha) -# # for (i in seq_along(x)) { -# # if (bol[i] & !is.na(bol[i])) { -# # opt_alpha[i] <- stats::optimize( -# # opt_gamma_count, -# # interval = c(0, 1e10), -# # x = x[i], -# # lambda = lambda[i] -# # )$minimum -# # } -# # } -# -# # test$dev <- dev_gamma_count(x, lambda, alpha) -# # test$sat <- test$dev / 2 + test$ll -# -# # test$ll_pois <- log_lik_pois(test$x, test$lambda) -# # test$sat_pois <- log_lik_pois(test$x, test$x) -# -# # test$ll_pois <- log_lik_pois(test$x, test$lambda) -# # test$sat_pois <- log_lik_pois(test$x, test$x) -# # -# # ggplot(test) + -# # geom_line(aes(x = x, y = ll), colour = "red") + -# # geom_line(aes(x = x, y = sat), colour = "firebrick") + -# # geom_line(aes(x = x, y = ll_pois), colour = "blue") + -# # geom_line(aes(x = x, y = sat_pois), colour = "steelblue") -# -# # test$mean <- NA -# # for (i in 1:nrow(test)) { -# # test$mean[i] <- mean_gamma_count(test$lambda[i], test$alpha[i]) -# # } -# # -# # test %>% dplyr::arrange(desc(ll)) -# print(i) -# } -# -# # pars2 %>% -# # filter(fail_mean) %>% -# # ggplot() + -# # geom_histogram(aes(x = theta)) -# -# pars2 %>% -# filter(fail_x) %>% -# ggplot() + -# geom_histogram(aes(x = theta)) -# -# pars2 %>% -# filter(fail_x) %>% -# ggplot() + -# geom_histogram(aes(x = diff_x)) -# -# # pars2 %>% -# # filter(fail_mean) %>% -# # ggplot() + -# # geom_histogram(aes(x = diff_mean)) -# -# # lambda theta fail_x fail_mean diff_x diff_mean -# # -# # 1 1.27 1.62 TRUE NA -0.00294 NA -# # 2 1.27 2.29 TRUE NA -0.00175 NA -# # 3 1.27 1.24 TRUE NA -0.000488 NA -# # -# # lambda theta fail_x fail_mean diff_x diff_mean -# # -# # 1 8.26 2.71 TRUE NA -0.0000133 NA -# -# # lambda theta fail_x fail_mean diff_x diff_mean -# # -# # 1 4.82 0.225 TRUE NA -0.000000189 NA -# -# # lambda theta fail_x fail_mean diff_x diff_mean -# # -# # 1 7.23 3.12 TRUE NA -0.0000218 NA -# # 2 1.45 0.778 TRUE NA -0.00106 NA -# # 3 1.45 0.824 TRUE NA -0.00148 NA -# # 4 1.45 1.20 TRUE NA -0.000155 NA -# # 5 1.45 0.794 TRUE NA -0.00123 NA -# # 6 13.5 1.20 TRUE NA -0.00000215 NA -# # 7 5.41 1.20 TRUE NA -0.00000334 NA -# -# # lambda theta fail_x fail_mean diff_x diff_mean -# # -# # 1 11.5 0.987 TRUE NA -0.000000263 NA -# # 2 11.5 0.947 TRUE NA -0.00000475 NA -# # 3 2.49 0.987 TRUE NA -0.000143 NA -# # 4 2.49 0.947 TRUE NA -0.000271 NA -# -# # lambda theta fail_x fail_mean diff_x diff_mean -# # -# # 1 9.18 3.96 TRUE NA -0.00000472 NA -# # 2 9.18 4.23 TRUE NA -0.00000892 NA -# # 3 3.31 1.56 TRUE NA -0.0000203 NA -# # 4 4.34 1.56 TRUE NA -0.0000655 NA From 26b51f05b099c4b4c296551fb3b84199aa47fb5f Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 10:07:56 -0800 Subject: [PATCH 18/20] Update documentation --- NAMESPACE | 1 - 1 file changed, 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 5f2ad19c..d3708fea 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -148,4 +148,3 @@ importFrom(stats,dlnorm) importFrom(stats,dnbinom) importFrom(stats,dnorm) importFrom(stats,dpois) -importFrom(stats,pgamma) From 6acd3462931353ea7457c786d7c998a98ecbc75a Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 10:16:17 -0800 Subject: [PATCH 19/20] Add new functions to .yml file --- _pkgdown.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 0209b070..a8251bab 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -99,6 +99,7 @@ reference: - '`dev_pois_zi`' - '`dev_skewnorm`' - '`dev_student`' + - '`dev_upois`' - title: Residual desc: Raw and Deviance Residuals contents: @@ -115,6 +116,7 @@ reference: - '`res_pois_zi`' - '`res_skewnorm`' - '`res_student`' + - '`res_upois`' - title: Log-Likelihood desc: Log-likelihood functions contents: @@ -131,6 +133,7 @@ reference: - '`log_lik_pois_zi`' - '`log_lik_skewnorm`' - '`log_lik_student`' + - '`log_lik_upois`' - title: Random desc: Random sample functions contents: @@ -147,6 +150,7 @@ reference: - '`ran_pois_zi`' - '`ran_skewnorm`' - '`ran_student`' + - '`ran_upois`' - title: Bernoulli desc: Bernoulli distribution functions contents: From bae9c6d2cc92a6cee8160daed3dd6b988a35b824 Mon Sep 17 00:00:00 2001 From: Nicole Hill Date: Fri, 24 Nov 2023 10:24:30 -0800 Subject: [PATCH 20/20] Fix function definition to work with old R version --- R/ran.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ran.R b/R/ran.R index 4376816a..4ba107b7 100644 --- a/R/ran.R +++ b/R/ran.R @@ -203,7 +203,7 @@ ran_student <- function(n = 1, mean = 0, sd = 1, theta = 0) { # Cumulative distribution function for underdispersed poisson distribution pupois <- function(q, lambda, theta) { - sapply(q, \(x) {sum(exp(log_lik_upois(0:x, lambda, theta)))}) + sapply(q, function(x) {sum(exp(log_lik_upois(0:x, lambda, theta)))}) } #' Underdispersed Poisson Random Samples