Fixes #150

NAMESPACE

@@ -61,6 +61,7 @@ export(util_cauchy_param_estimate)
 export(util_exponential_param_estimate)
 export(util_gamma_param_estimate)
 export(util_geometric_param_estimate)
+export(util_geometric_stats_tbl)
 export(util_hypergeometric_param_estimate)
 export(util_logistic_param_estimate)
 export(util_lognormal_param_estimate)

NEWS.md

@@ -11,6 +11,7 @@ qq, quantile and probability plots to a single graph.
 4. Fix #127 - Add function `util_cauchy_param_estimate()`
 5. Fix #130 - Add function `tidy_t()` - Also add to plotting functions.
 6. Fix #151 - Add function `tidy_mixture_density()`
+7. Fix #150 - Add function `util_geometric_stats_tbl()`
 
 ## Minor Fixes and Improvements
 1. Fix #110 - Bug fix, correct the `p` calculation in `tidy_poisson()` that will

R/stats-geometric-tbl.R

@@ -0,0 +1,83 @@
+#' Distribution Statistics
+#'
+#' @family Geometric
+#' @fmaily 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
+#' tidy_geometric() %>%
+#'   util_geometric_stats_tbl()
+#'
+#' @return
+#' A tibble
+#'
+#' @export
+#'
+
+util_geometric_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_geometric"){
+        rlang::abort(
+            message = "You must use 'tidy_geometric()'",
+            use_cli_format = TRUE
+        )
+    }
+
+    # Data
+    data_tbl <- tibble::as_tibble(.data)
+
+    atb <- attributes(data_tbl)
+    p <- atb$.prob
+
+    stat_mean   <- (1 - p)/p
+    stat_mode   <- data_tbl %>%
+        dplyr::filter(p == max(p)) %>%
+        dplyr::pull(y) %>%
+        max()
+    stat_sd <- sqrt((1 - p)/p)
+    stat_skewness <- (2 - p)/sqrt(1 - p)
+    stat_kurtosis <- 6 + ((p*p)/(1 - p))
+    stat_coef_var <- (1-p)/(p * p)
+
+    # Data Tibble
+    ret <- tibble::tibble(
+        tidy_function = atb$tibble_type,
+        function_call = atb$dist_with_params,
+        distribution = atb$tibble_type %>%
+            stringr::str_remove("tidy_") %>%
+            stringr::str_to_title(),
+        distribution_type = atb$distribution_family_type,
+        points = atb$.n,
+        simulations = atb$.num_sims,
+        mean = stat_mean,
+        mode = stat_mode,
+        range = paste0("0 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)
+    )
+
+    # Return
+    return(ret)
+
+}