R/stats-zt-geometric-tbl.R

In spsanderson/TidyDensity: Functions for Tidy Analysis and Generation of Random Data

#' Distribution Statistics for Zero-Truncated Geometric
#'
#' @family Zero-Truncated Geometric
#' @family Distribution Statistics
#'
#' @details This function takes in a tibble generated by a `tidy_ztgeom`
#' distribution function and returns the relevant statistics for a Zero-Truncated
#' Geometric distribution. It requires data to be passed from a `tidy_ztgeom`
#' distribution function.
#'
#' @description Returns distribution statistics for Zero-Truncated Geometric
#' distribution in a tibble.
#'
#' @param .data The data being passed from a `tidy_ztgeom` distribution function.
#'
#' @examples
#' library(dplyr)
#'
#' set.seed(123)
#' tidy_zero_truncated_geometric(.prob = 0.1) |>
#'   util_zero_truncated_geometric_stats_tbl() |>
#'   glimpse()
#'
#' @return
#' A tibble
#'
#' @name util_zero_truncated_geometric_stats_tbl
NULL

#' @export
#' @rdname util_zero_truncated_geometric_stats_tbl

util_zero_truncated_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 a 'tidy_dist' function.",
      use_cli_format = TRUE
    )
  }

  if (attributes(.data)$tibble_type != "tidy_zero_truncated_geometric") {
    rlang::abort(
      message = "You must use 'tidy_zero_truncated_geometric()'",
      use_cli_format = TRUE
    )
  }

  # Extract attributes
  data_tbl <- dplyr::as_tibble(.data)
  atb <- attributes(data_tbl)
  p <- atb$.prob

  # Zero-Truncated Geometric Statistics Calculation
  stat_mean <- (1 - p) / p + 1
  stat_mode <- 1
  stat_sd <- sqrt((1 - p) / (p * p))
  stat_skewness <- (2 + p) / sqrt(1 - p)
  stat_kurtosis <- 6 + (p * (p - 2)) / (1 - p)
  stat_coef_var <- stat_sd / stat_mean

  # Generate data table with calculated statistics
  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 = "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 the data table
  return(ret)
}