Fixes #34

DESCRIPTION

@@ -25,7 +25,8 @@ Imports:
     tidyr,
     purrr,
     stringr,
-    healthyR.ai
+    healthyR.ai,
+    actuar
 Suggests: 
     rmarkdown,
     knitr,

NAMESPACE

@@ -26,6 +26,7 @@ export(tidy_normal)
 export(tidy_poisson)
 export(tidy_uniform)
 export(tidy_weibull)
+export(tidy_zero_truncated_poisson)
 importFrom(magrittr,"%>%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

R/autoplot-density.R

@@ -71,7 +71,8 @@ tidy_autoplot <- function(.data, .plot_type = "density", .line_size = .5, .point
         "tidy_gaussian", "tidy_poisson","tidy_gamma","tidy_beta","tidy_f",
         "tidy_hypergeometric","tidy_lognormal","tidy_cauchy","tidy_chisquare",
         "tidy_weibull","tidy_uniform","tidy_logistic","tidy_exponential",
-        "tidy_empirical","tidy_binomial","tidy_geometric","tidy_negative_binomial"
+        "tidy_empirical","tidy_binomial","tidy_geometric","tidy_negative_binomial",
+        "tidy_zero_truncated_poisson"
     )){
         rlang::abort("The data passed must come from a `tidy_` distribution function.")
     }
@@ -103,7 +104,7 @@ tidy_autoplot <- function(.data, .plot_type = "density", .line_size = .5, .point
             paste0("Shape: ", atb$.shape, " - Rate: ", atb$.rate)
         } else if(atb$tibble_type == "tidy_beta"){
             paste0("Shape1: ", atb$.shape1, " - Shape2: ", atb$.shape2, " - NCP: ", atb$.ncp)
-        } else if(atb$tibble_type == "tidy_poisson"){
+        } else if(atb$tibble_type %in% c("tidy_poisson","tidy_zero_truncated_poisson")){
             paste0("Lambda: ", atb$.lambda)
         } else if(atb$tibble_type == "tidy_f"){
             paste0("DF1: ", atb$.df1, " - DF2: ", atb$.df2, " - NCP: ", atb$.ncp)

R/random-tidy-zero-truc-poisson.R

@@ -0,0 +1,101 @@
+#' Tidy Randomly Generated Zero Truncated Poisson Distribution Tibble
+#'
+#' @family Data Generator
+#'
+#' @author Steven P. Sanderson II, MPH
+#'
+#' @seealso \url{https://openacttexts.github.io/Loss-Data-Analytics/C-SummaryDistributions.html}
+#'
+#' @details This function uses the underlying `actuar::rztpois()`, and its underlying
+#' `p`, `d`, and `q` functions. For more information please see [actuar::rztpois()]
+#'
+#' @description This function will generate `n` random points from a Poisson
+#' distribution with a user provided, `.lambda`, and number of
+#' random simulations to be produced. The function returns a tibble with the
+#' simulation number column the x column which corresponds to the n randomly
+#' generated points, the `d_`, `p_` and `q_` data points as well.
+#'
+#' The data is returned un-grouped.
+#'
+#' The columns that are output are:
+#'
+#' -  `sim_number` The current simulation number.
+#' -  `x` The current value of `n` for the current simulation.
+#' -  `y` The randomly generated data point.
+#' -  `dx` The `x` value from the [stats::density()] function.
+#' -  `dy` The `y` value from the [stats::density()] function.
+#' -  `p` The values from the resulting p_ function of the distribution family.
+#' -  `q` The values from the resulting q_ function of the distribution family.
+#'
+#' @param .n The number of randomly generated points you want.
+#' @param .lambda A vector of non-negative means.
+#' @param .num_sims The number of randomly generated simulations you want.
+#'
+#' @examples
+#' tidy_zero_truncated_poisson()
+#'
+#' @return
+#' A tibble of randomly generated data.
+#'
+#' @export
+#'
+
+tidy_zero_truncated_poisson <- function(.n = 50, .lambda = 1, .num_sims = 1){
+
+    # Tidyeval ----
+    n        <- as.integer(.n)
+    num_sims <- as.integer(.num_sims)
+    lambda <- as.numeric(.lambda)
+
+    # Checks ----
+    if(!is.integer(n) | n < 0){
+        rlang::abort(
+            "The parameters '.n' must be of class integer. Please pass a whole
+            number like 50 or 100. It must be greater than 0."
+        )
+    }
+
+    if(!is.integer(num_sims) | num_sims < 0){
+        rlang::abort(
+            "The parameter `.num_sims' must be of class integer. Please pass a
+            whole number like 50 or 100. It must be greater than 0."
+        )
+    }
+
+    if(!is.numeric(lambda) | lambda < 0){
+        rlang::abort(
+            "The parameter '.lambda' must be of class numeric.
+            Please pass a numer like 1 or 1.1 etc. and lambda >= 0."
+        )
+    }
+
+    x <- seq(1, num_sims, 1)
+
+    ps <- seq(-n, n-1, 2)
+    qs <- seq(0, 1, (1/(n-1)))
+
+    df <- dplyr::tibble(sim_number = as.factor(x)) %>%
+        dplyr::group_by(sim_number) %>%
+        dplyr::mutate(x = list(1:n)) %>%
+        dplyr::mutate(y = list(actuar::rztpois(n = n, lambda = lambda))) %>%
+        dplyr::mutate(d = list(density(unlist(y), n = n)[c("x","y")] %>%
+                                   purrr::set_names("dx","dy") %>%
+                                   dplyr::as_tibble())) %>%
+        dplyr::mutate(p = list(actuar::pztpois(ps, lambda = lambda))) %>%
+        dplyr::mutate(q = list(actuar::qztpois(qs, lambda = lambda))) %>%
+        tidyr::unnest(cols = c(x, y, d, p, q)) %>%
+        dplyr::ungroup()
+
+
+    # Attach descriptive attributes to tibble
+    attr(df, ".lambda") <- .lambda
+    attr(df, ".n") <- .n
+    attr(df, ".num_sims") <- .num_sims
+    attr(df, "tibble_type") <- "tidy_zero_truncated_poisson"
+    attr(df, "ps") <- ps
+    attr(df, "qs") <- qs
+
+    # Return final result as function output
+    return(df)
+
+}