Triangular Stats tibble function

[spsanderson]

https://en.wikipedia.org/wiki/Triangular_distribution

https://www.mathworks.com/help/stats/triangular-distribution.html#

Function:

#' Distribution Statistics
#'
#' @family Triangular
#' @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_triangular() %>%
#'   util_triangular_stats_tbl() %>%
#'   glimpse()
#'
#' @return
#' A tibble
#' 
#' @name util_triangular_stats_tbl
NULL
#' @export
#' @rdname util_triangular_stats_tbl

util_triangular_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_triangular") {
    rlang::abort(
      message = "You must use 'tidy_chisquare()'",
      use_cli_format = TRUE
    )
  }
  
  # Data
  data_tbl <- dplyr::as_tibble(.data)
  
  atb <- attributes(data_tbl)
  
  a <- atb$.min
  b <- atb$.mode
  c <- atb$.max
  
  stat_mean <- (a + b + c) / 3
  stat_median <- if (c >= (a+b)/2) {
    (a + (sqrt((b-a)*(c-a))/2))
  } else {
    (b - (sqrt((b-1)*(b-c))/2))
  }
  stat_mode <- c
  stat_range <- range(data_tbl$y)
  stat_variance <- ((a^2) + (b^2) + (c^2) - (a*b) - (a*c) - (b*c)) / 18
  stat_skewness <- ((sqrt(2) * (a + b - (2*c))) * ((2*a) - b - c) * (a - 2*b +c)) / 5*(a^2 + b^2 + c^2 - a*b - a*c - b*c)^(3/2)
  stat_kurtosis <- -(3/5)
  stat_entropy <- 0.5 * log((b-a)/2)
  
  # 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,
    median = stat_median,
    mode = stat_mode,
    range_low = stat_range[[1]],
    range_high = stat_range[[2]],
    variance = stat_variance,
    skewness = stat_skewness,
    kurtosis = stat_kurtosis,
    entropy = stat_entropy,
    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)
}

Example:

> tidy_triangular() |> util_triangular_stats_tbl() |> dplyr::glimpse()
Rows: 1
Columns: 19
$ tidy_function     <chr> "tidy_triangular"
$ function_call     <chr> "Triangular c(0, 1, 0.5)"
$ distribution      <chr> "Triangular"
$ distribution_type <chr> "continuous"
$ points            <dbl> 50
$ simulations       <dbl> 1
$ mean              <dbl> 0.5
$ median            <dbl> 0.3535534
$ mode              <dbl> 1
$ range_low         <dbl> 0.1814176
$ range_high        <dbl> 0.8893206
$ variance          <dbl> 0.04166667
$ skewness          <dbl> 0
$ kurtosis          <dbl> -0.6
$ entropy           <dbl> -0.6931472
$ computed_std_skew <dbl> -0.1055638
$ computed_std_kurt <dbl> 2.274289
$ ci_lo             <dbl> 0.2210738
$ ci_hi             <dbl> 0.8385347