Fixes #471

NAMESPACE

@@ -147,6 +147,7 @@ export(util_weibull_param_estimate)
 export(util_weibull_stats_tbl)
 export(util_zero_truncated_poisson_aic)
 export(util_zero_truncated_poisson_param_estimate)
+export(util_zero_truncated_poisson_stats_tbl)
 export(util_ztn_binomial_param_estimate)
 export(util_ztn_binomial_stats_tbl)
 importFrom(data.table,.SD)

NEWS.md

@@ -7,7 +7,7 @@ None
 1. #468 - Add function `util_negative_binomial_aic()` to calculate the AIC for the negative binomial distribution.
 2. #470 - Add function `util_ztn_binomial_param_estimate()` and `util_rztnbinom_aic()` to estimate the parameters and calculate the AIC for the zero-truncated negative binomial distribution. Also added `util_ztn_binomial_stats_tbl()`
 3. #467 - Add function `util_zero_truncated_poisson_param_estimate()` to estimate
-the parameters of the zero-truncated Poisson distribution.
+the parameters of the zero-truncated Poisson distribution. Add function `util_zero_truncated_poisson_aic()` to calculate the AIC for the zero-truncated Poisson distribution. Add function `util_zero_truncated_poisson_stats_tbl()` to create a summary table of the zero-truncated Poisson distribution.
 4. #472 - Add function `util_f_param_estimate()` and `util_f_aic()` to estimate the parameters and calculate the AIC for the F distribution.
 
 ## Minor Improvements and Fixes

R/stats-ztpoisson-tbl.R

@@ -0,0 +1,86 @@
+#' Distribution Statistics
+#'
+#' @family Poisson
+#' @family Zero Truncated
+#' @family Distribution Statistics
+#'
+#' @author Steven P. Sanderson II, MPH
+#'
+#' @details This function will take in a tibble and returns the statistics
+#' of the given type of `tidy_` distribution. It is required that data be
+#' passed from a `tidy_` distribution function.
+#'
+#' @description Returns distribution statistics in a tibble.
+#'
+#' @param .data The data being passed from a `tidy_` distribution function.
+#'
+#' @examples
+#' library(dplyr)
+#'
+#' tidy_zero_truncated_poisson() |>
+#'   util_zero_truncated_poisson_stats_tbl() |>
+#'   glimpse()
+#'
+#' @return
+#' A tibble
+#'
+#' @name util_zero_truncated_poisson_stats_tbl
+NULL
+
+#' @export
+#' @rdname util_zero_truncated_poisson_stats_tbl
+
+util_zero_truncated_poisson_stats_tbl <- function(.data) {
+
+  # Immediate check for tidy_ distribution function
+  if (!"tibble_type" %in% names(attributes(.data))) {
+    rlang::abort(
+      message = "You must pass data from the 'tidy_dist' function.",
+      use_cli_format = TRUE
+    )
+  }
+
+  if (attributes(.data)$tibble_type != "tidy_zero_truncated_poisson") {
+    rlang::abort(
+      message = "You must use 'tidy_zero_truncated_poisson()'",
+      use_cli_format = TRUE
+    )
+  }
+
+  # Data
+  data_tbl <- dplyr::as_tibble(.data)
+
+  atb <- attributes(data_tbl)
+  l <- atb$.lambda
+
+  stat_mean <- l
+  stat_mode <- floor(l)
+  stat_sd <- sqrt(l)
+  stat_skewness <- 1 / sqrt(l)
+  stat_kurtosis <- 3 + (1 / l)
+  stat_coef_var <- 1 / sqrt(l)
+
+  # Data Tibble
+  ret <- dplyr::tibble(
+    tidy_function = atb$tibble_type,
+    function_call = atb$dist_with_params,
+    distribution = dist_type_extractor(atb$tibble_type),
+    distribution_type = atb$distribution_family_type,
+    points = atb$.n,
+    simulations = atb$.num_sims,
+    mean = stat_mean,
+    mode = stat_mode,
+    range = paste0("1 to Inf"),
+    std_dv = stat_sd,
+    coeff_var = stat_coef_var,
+    skewness = stat_skewness,
+    kurtosis = stat_kurtosis,
+    computed_std_skew = tidy_skewness_vec(data_tbl$y),
+    computed_std_kurt = tidy_kurtosis_vec(data_tbl$y),
+    ci_lo = ci_lo(data_tbl$y),
+    ci_hi = ci_hi(data_tbl$y)
+  )
+
+  # Return
+  return(ret)
+}