Merge pull request #8 from sims1253/additional_distributions

Additional distributions

.github/workflows/test-coverage.yaml

@@ -29,6 +29,8 @@ jobs:
         with:
           extra-packages: |
             any::covr
+            any::BH
+            any::RcppEigen
           needs: coverage
 
       - name: Test coverage

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bayesfam
 Type: Package
 Title: brms Custom Families
-Version: 0.2.4
+Version: 0.3.0
 Date: 2022-10-26
 Authors@R:
     c(person("Maximilian", "Scholz", email = "[email protected]",
@@ -15,7 +15,8 @@ Encoding: UTF-8
 LazyData: true
 Imports:
     brms (>= 2.18.1),
-    stats
+    stats,
+    lamW
 Suggests:
     testthat (>= 3.1.0),
     rmutil,

NAMESPACE

@@ -18,10 +18,13 @@ export(dkumaraswamy)
 export(dlogistic)
 export(dlogitnormal)
 export(dlognormal)
+export(dlognormal_natural)
 export(dlomax)
+export(dshifted_inv_gaussian)
 export(dsimplex)
 export(dsoftplusnormal)
 export(dsymlognormal)
+export(dunit_lindley)
 export(dweibull_median)
 export(erf)
 export(generalized_normal)
@@ -41,6 +44,7 @@ export(limit_data)
 export(logistic)
 export(logit)
 export(logitnormal)
+export(lognormal_natural)
 export(lomax)
 export(pkumaraswamy)
 export(qbeta_mean)
@@ -51,6 +55,7 @@ export(qgumbel_mean)
 export(qkumaraswamy)
 export(qlogistic)
 export(qlomax)
+export(qunit_lindley)
 export(rbeta_mean)
 export(rbetaprime)
 export(rcauchitnormal)
@@ -65,16 +70,21 @@ export(rkumaraswamy)
 export(rlogistic)
 export(rlogitnormal)
 export(rlognormal)
+export(rlognormal_natural)
 export(rlomax)
+export(rshifted_inv_gaussian)
 export(rsimplex)
 export(rsoftplusnormal)
 export(rstudent_mean)
 export(rsymlognormal)
+export(runit_lindley)
 export(rweibull_median)
+export(shifted_inv_gaussian)
 export(simplex)
 export(softplus)
 export(softplusnormal)
 export(symlog)
 export(symlognormal)
+export(unit_lindley)
 import(graphics)
 import(stats)

R/beta_prime.R

@@ -100,8 +100,8 @@ rbetaprime <- function(n, mu = 1, phi = 1) {
 
 #' Log-Likelihood of the beta prime distribution
 #'
-#' @param i BRMS indices
-#' @param prep BRMS data
+#' @param i brms indices
+#' @param prep brms data
 #'
 #' @return Log-Likelihood of beta prime given data in prep
 log_lik_betaprime <- function(i, prep) {
@@ -114,9 +114,9 @@ log_lik_betaprime <- function(i, prep) {
 
 #' posterior_predict for the beta prime distribution
 #'
-#' @param i BRMS indices
-#' @param prep BRMS data
-#' @param ... catchall
+#' @param i brms indices
+#' @param prep brms data
+#' @param ... Catchall argument
 #'
 #' @return Draws from the Posterior Predictive Distribution
 posterior_predict_betaprime <- function(i, prep, ...) {
@@ -127,7 +127,7 @@ posterior_predict_betaprime <- function(i, prep, ...) {
 
 #' posterior_epred for the beta prime distribution
 #'
-#' @param prep BRMS data
+#' @param prep brms data
 #'
 #' @return Expected Values of the Posterior Predictive Distribution
 posterior_epred_betaprime <- function(prep) {
@@ -145,9 +145,11 @@ posterior_epred_betaprime <- function(prep) {
 #'
 #' @examples a <- rnorm(n = 1000)
 #' data <- list(a = a, y = rbetaprime(n = 1000, mu = exp(0.5 * a + 1), phi = 2))
-#' fit <- brms::brm(formula = y ~ 1 + a, data = data,
-#'  family = betaprime(), stanvars = betaprime()$stanvars,
-#'  refresh = 0)
+#' fit <- brms::brm(
+#'   formula = y ~ 1 + a, data = data,
+#'   family = betaprime(), stanvars = betaprime()$stanvars,
+#'   refresh = 0
+#' )
 #' plot(fit)
 betaprime <- function(link = "log", link_phi = "log") {
   family <- brms::custom_family(

R/cauchitnormal.R

@@ -51,9 +51,9 @@ rcauchitnormal <- function(n, mu = 0, sigma = 1) {
 #' Log-Likelihood vignette for the Cauchitnormal Distribution
 #'
 #' @param i Indices
-#' @param prep BRMS data
+#' @param prep brms data
 #'
-#' @return log_likelihood of the Cauchitnormal Distribution, given some BRMS data.
+#' @return log_likelihood of the Cauchitnormal Distribution, given some brms data.
 log_lik_cauchitnormal <- function(i, prep) {
   mu <- brms::get_dpar(prep, "mu", i = i)
   sigma <- brms::get_dpar(prep, "sigma", i = i)
@@ -64,10 +64,10 @@ log_lik_cauchitnormal <- function(i, prep) {
 #' Posterior-predict vignette for the Cauchitnormal Distribution
 #'
 #' @param i Indices
-#' @param prep BRMS data
-#' @param ... catchall
+#' @param prep brms data
+#' @param ... Catchall argument
 #'
-#' @return The posterior prediction of the Cauchitnormal Distribution, given some BRMS data.
+#' @return The posterior prediction of the Cauchitnormal Distribution, given some brms data.
 posterior_predict_cauchitnormal <- function(i, prep, ...) {
   mu <- brms::get_dpar(prep, "mu", i = i)
   sigma <- brms::get_dpar(prep, "sigma", i = i)
@@ -76,7 +76,7 @@ posterior_predict_cauchitnormal <- function(i, prep, ...) {
 
 #' Posterior expected value prediction. Mean undefined for Cauchitnormal.
 #'
-#' @param prep BRMS data
+#' @param prep brms data
 #'
 #' @return Nothing
 posterior_epred_cauchitnormal <- function(prep) {
@@ -85,19 +85,21 @@ posterior_epred_cauchitnormal <- function(prep) {
         distribution, posterior_epred is currently not supported.")
 }
 
-#' Custom BRMS family Cauchitnormal
+#' Custom brms family Cauchitnormal
 #'
 #' @param link Link function argument (as string) for Median argument. Left as identity!
 #' @param link_sigma Link function argument (as string) for Shape argument
 #'
-#' @return Cauchitnormal BRMS model-object
+#' @return Cauchitnormal brms model-object
 #' @export
 #'
 #' @examples a <- rnorm(1000)
 #' data <- list(a = a, y = rcauchitnormal(1000, 0.5 * a + 1, 2))
-#' fit1 <- brms::brm(formula = y ~ 1 + a, data = data,
-#'  family = cauchitnormal(), stanvars = cauchitnormal()$stanvars,
-#'  refresh = 0)
+#' fit1 <- brms::brm(
+#'   formula = y ~ 1 + a, data = data,
+#'   family = cauchitnormal(), stanvars = cauchitnormal()$stanvars,
+#'   refresh = 0
+#' )
 #' plot(fit1)
 cauchitnormal <- function(link = "identity", link_sigma = "log") {
   stopifnot(link == "identity")

R/cloglognormal.R

@@ -50,7 +50,7 @@ rcloglognormal <- function(n, mu = -0.36, sigma = 0.75) {
 #' Log-Likelihood vignette for the Chauchitnormal distribution, with Median parametrization.
 #'
 #' @param i indices
-#' @param prep BRMS data
+#' @param prep brms data
 #'
 #' @return log_lik
 log_lik_cloglognormal <- function(i, prep) {
@@ -63,8 +63,8 @@ log_lik_cloglognormal <- function(i, prep) {
 #' Posterior-predict vignette for the Chauchitnormal distribution, with Median parametrization.
 #'
 #' @param i Indices
-#' @param prep BRMS data
-#' @param ... catchall
+#' @param prep brms data
+#' @param ... Catchall argument
 #'
 #' @return Posterior prediction of the data
 posterior_predict_cloglognormal <- function(i, prep, ...) {
@@ -75,7 +75,7 @@ posterior_predict_cloglognormal <- function(i, prep, ...) {
 
 #' Posterior expected value prediction. Mean undefined for Cloglog-Normal
 #'
-#' @param prep BRMS data
+#' @param prep brms data
 #'
 #' @return Nothing
 posterior_epred_cloglognormal <- function(prep) {
@@ -84,20 +84,22 @@ posterior_epred_cloglognormal <- function(prep) {
         distribution, posterior_epred is currently not supported.")
 }
 
-#' Custom BRMS family Cloglog-Normal in median parametrization.
+#' Custom brms family Cloglog-Normal in median parametrization.
 #'
 #' @param link Link function argument (as string) for Median argument. Left as identity!
 #' @param link_sigma Link function argument (as string) for Shape argument
 #'
-#' @return Cloglog BRMS model-object
+#' @return Cloglog brms model-object
 #' @export
 #'
 #' @examples data <- rcloglognormal(1000, 0.5, 2)
 #' # cloglognormal does not like values to close to the boundary
 #' data <- limit_data(data, c(1e-12, 1 - 1e-12))
-#' fit <- brms::brm(formula = y ~ 1, data = list(y = data),
-#'  family = cloglognormal(), stanvars = cloglognormal()$stanvars,
-#'  refresh = 0)
+#' fit <- brms::brm(
+#'   formula = y ~ 1, data = list(y = data),
+#'   family = cloglognormal(), stanvars = cloglognormal()$stanvars,
+#'   refresh = 0
+#' )
 #' plot(fit)
 cloglognormal <- function(link = "identity", link_sigma = "log") {
   stopifnot(link == "identity")

R/gompertz.R

@@ -89,8 +89,8 @@ rgompertz <- function(n, mu = 1, beta = 0.5) {
 
 #' Log-Likelihood vignette for the Gompertz distribution, with Median parametrization.
 #'
-#' @param i BRMS indices
-#' @param prep BRMS data
+#' @param i brms indices
+#' @param prep brms data
 #'
 #' @return Log-Likelihood of gompertz given data in prep
 log_lik_gompertz <- function(i, prep) {
@@ -102,9 +102,9 @@ log_lik_gompertz <- function(i, prep) {
 
 #' Posterior-Prediction vignette for the Gompertz distribution, with Median parametrization.
 #'
-#' @param i BRMS indices
-#' @param prep BRMS data
-#' @param ... catchall
+#' @param i brms indices
+#' @param prep brms data
+#' @param ... Catchall argument
 #'
 #' @return Posterior prediction of gompertz, given data in prep
 posterior_predict_gompertz <- function(i, prep, ...) {
@@ -116,27 +116,29 @@ posterior_predict_gompertz <- function(i, prep, ...) {
 #' Expectation-Predict vignette for the Gompertz distribution, with Median parametrization.
 #' Not defined for the Gompertz family.
 #'
-#' @param prep BRMS data
+#' @param prep brms data
 #'
 #' @return Nothing
 posterior_epred_gompertz <- function(prep) {
   stop("posterior_epred is not defined for the gompertz family")
 }
 
 
-#' Custom Gompertz BRMS-implementation in median parametrization.
+#' Custom Gompertz brms-implementation in median parametrization.
 #'
 #' @param link Link function for function
 #' @param link_b Link function for eta argument
 #'
-#' @return BRMS gompertz distribution family
+#' @return brms gompertz distribution family
 #' @export
 #'
 #' @examples a <- rnorm(1000)
 #' data <- list(a = a, y = rgompertz(1000, mu = exp(0.5 * a + 1), beta = 0.1))
-#' fit <- brms::brm(formula = y ~ 1 + a, data = data,
-#'  family = gompertz(), stanvars = gompertz()$stanvars,
-#'  refresh = 0)
+#' fit <- brms::brm(
+#'   formula = y ~ 1 + a, data = data,
+#'   family = gompertz(), stanvars = gompertz()$stanvars,
+#'   refresh = 0
+#' )
 #' plot(fit)
 gompertz <- function(link = "log", link_b = "log") {
   family <- brms::custom_family(