Fixes #348

NAMESPACE

@@ -88,6 +88,7 @@ export(util_beta_stats_tbl)
 export(util_binomial_param_estimate)
 export(util_binomial_stats_tbl)
 export(util_burr_param_estimate)
+export(util_burr_stats_tbl)
 export(util_cauchy_param_estimate)
 export(util_cauchy_stats_tbl)
 export(util_chisquare_stats_tbl)

NEWS.md

@@ -4,9 +4,10 @@
 None
 
 ## New Features
-1. Fix #351 - Add function `convert_to_ts()` which will convet a `tidy_` distribution
+1. Fix #351 - Add function `convert_to_ts()` which will convert a `tidy_` distribution
 into a time series in either `ts` format or `tibble` you can also have it set to 
 wide or long by using `.pivot_longer` set to TRUE and `.ret_ts` set to FALSE
+2. Fix #348 - Add function `util_burr_stats_tbl()`
 
 ## Minor Fixes and Improvements
 None

R/stats-burr-tbl.R

@@ -0,0 +1,87 @@
+#' Distribution Statistics
+#'
+#' @family Burr
+#' @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_burr() %>%
+#'   util_burr_stats_tbl() %>%
+#'   glimpse()
+#'
+#' @return
+#' A tibble
+#'
+#' @name util_burr_stats_tbl
+NULL
+
+#' @export
+#' @rdname util_burr_stats_tbl
+
+util_burr_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_burr") {
+        rlang::abort(
+            message = "You must use 'tidy_burr()'",
+            use_cli_format = TRUE
+        )
+    }
+
+    # Data
+    data_tbl <- dplyr::as_tibble(.data)
+
+    atb <- attributes(data_tbl)
+    s1 <- atb$.shape1
+    s2 <- atb$.shape2
+    r  <- atb$.rate
+    sc <- 1/r
+
+    stat_mean <- s2 + sc * (s1 / (s1 + 1))
+    stat_mode <- ((s2 - 1)/((s1*s2) + 1))^(1/s2)
+    stat_median <- sc * actuar::qburr(p = 0.5, shape1 = s1, shape2 = 1)
+    stat_skewness <- (4 * sqrt(6) * (s1 + 2)) / (s1 * pi ^ (3/2)*(s1 + 3))
+    stat_kurtosis <- 3 * (s1^2 + 6 * s1 + 5) / (s1 * (s1 + 1)^2)
+    stat_coef_var <- (-1 * stat_mean^2) + stat_mean
+
+    # 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,
+        median = stat_median,
+        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)
+}