Fixes #51

NAMESPACE

@@ -18,6 +18,7 @@ export(tidy_empirical)
 export(tidy_exponential)
 export(tidy_f)
 export(tidy_gamma)
+export(tidy_generalized_beta)
 export(tidy_generalized_pareto)
 export(tidy_geometric)
 export(tidy_hypergeometric)

NEWS.md

@@ -24,6 +24,7 @@ None
 18. Fix #48 - Add function `tidy_burr()`
 19. Fix #49 - Add function `tidy_inverse_burr()`
 20. Fix #50 - Add function `tidy_inverse_normal()`
+21. Fix #51 - Add function `tidy_generalized_beta()`
 
 ## Fixes and Minor Improvements
 1. Fix #30 - Move `crayon`, `rstudioapi`, and `cli` from Suggests to Imports due to `pillar`

R/autoplot-density.R

@@ -89,7 +89,7 @@ tidy_autoplot <- function(.data, .plot_type = "density", .line_size = .5,
     "tidy_pareto_single_parameter", "tidy_pareto", "tidy_inverse_pareto",
     "tidy_generalized_pareto","tidy_paralogistic", "tidy_inverse_exponential",
     "tidy_inverse_gamma","tidy_inverse_weibull","tidy_burr","tidy_inverse_burr",
-    "tidy_inverse_gaussian"
+    "tidy_inverse_gaussian","tidy_generalized_beta"
   )) {
     rlang::abort("The data passed must come from a `tidy_` distribution function.")
   }
@@ -178,6 +178,14 @@ tidy_autoplot <- function(.data, .plot_type = "density", .line_size = .5,
       paste0("Mean: ", atb$.mean, " - ",
              "Shape: ", atb$.shape, " - ",
              "Dispersion: ", atb$.dispersion)
+    } else if (atb$tibble_type == "tidy_generalized_beta"){
+      paste0(
+        "Shape1: ", atb$.shape1, " - ",
+        "Shape2: ", atb$.shape2, " - ",
+        "Shape3: ", atb$.shape3, " - ",
+        "Scale: ", atb$.scale, " - ",
+        "Rate: ", atb$.rate
+      )
     }
   )
 

R/autoplot-randomwalk.R

@@ -118,10 +118,18 @@ tidy_random_walk_autoplot <- function(.data, .line_size = 1, .geom_rug = FALSE,
                    "Scale: ", atb$all$.scale)
         } else if (atb$all$tibble_type == "tidy_inverse_exponential"){
             paste0("Rate: ", atb$all$.rate, " - Scale: ", atb$all$.scale)
-        }else if (atb$all$tibble_type == "tidy_inverse_gaussian"){
+        } else if (atb$all$tibble_type == "tidy_inverse_gaussian"){
             paste0("Mean: ", atb$all$.mean, " - ",
                    "Shape: ", atb$all$.shape, " - ",
                    "Dispersion: ", atb$all$.dispersion)
+        } else if (atb$all$tibble_type == "tidy_generalized_beta"){
+            paste0(
+                "Shape1: ", atb$all$.shape1, " - ",
+                "Shape2: ", atb$all$.shape2, " - ",
+                "Shape3: ", atb$all$.shape3, " - ",
+                "Scale: ", atb$all$.scale, " - ",
+                "Rate: ", atb$all$.rate
+            )
         }
     )
 

R/random-tidy-general-beta.R

@@ -0,0 +1,134 @@
+#' Tidy Randomly Generated Generalized Beta Distribution Tibble
+#'
+#' @family Continuous Distribution
+#' @family Beta
+#'
+#' @author Steven P. Sanderson II, MPH
+#'
+#' @seealso \url{https://statisticsglobe.com/beta-distribution-in-r-dbeta-pbeta-qbeta-rbeta}
+#' @seealso \url{https://en.wikipedia.org/wiki/Beta_distribution}
+#' @seealso \url{https://openacttexts.github.io/Loss-Data-Analytics/C-SummaryDistributions.html}
+#'
+#' @details This function uses the underlying `stats::rbeta()`, and its underlying
+#' `p`, `d`, and `q` functions. For more information please see [stats::rbeta()]
+#'
+#' @description This function will generate `n` random points from a generalized beta
+#' distribution with a user provided, `.shape1`, `.shape2`, `.shape3`, `.rate`, and/or
+#' `.sclae`, and number of random simulations to be produced. The function returns a tibble with the
+#' simulation number column the x column which corresponds to the n randomly
+#' generated points, the `d_`, `p_` and `q_` data points as well.
+#'
+#' The data is returned un-grouped.
+#'
+#' The columns that are output are:
+#'
+#' -  `sim_number` The current simulation number.
+#' -  `x` The current value of `n` for the current simulation.
+#' -  `y` The randomly generated data point.
+#' -  `dx` The `x` value from the [stats::density()] function.
+#' -  `dy` The `y` value from the [stats::density()] function.
+#' -  `p` The values from the resulting p_ function of the distribution family.
+#' -  `q` The values from the resulting q_ function of the distribution family.
+#'
+#' @param .n The number of randomly generated points you want.
+#' @param .shape1 A non-negative parameter of the Beta distribution.
+#' @param .shape2 A non-negative parameter of the Beta distribution.
+#' @param .shape3 A non-negative parameter of the Beta distribution.
+#' @param .scale Must be strictly positive.
+#' @param .rate An alternative way to specify the `.scale` parameter.
+#' @param .ncp The `non-centrality parameter` of the Beta distribution.
+#' @param .num_sims The number of randomly generated simulations you want.
+#'
+#' @examples
+#' tidy_generalized_beta()
+#' @return
+#' A tibble of randomly generated data.
+#'
+#' @export
+#'
+
+tidy_generalized_beta <- function(.n = 50, .shape1 = 1, .shape2 = 1,
+                                  .shape3 = 1, .rate = 1, .scale = 1/.rate,
+                                  .num_sims = 1) {
+
+    # Tidyeval ----
+    n <- as.integer(.n)
+    num_sims <- as.integer(.num_sims)
+    shape1 <- as.numeric(.shape1)
+    shape2 <- as.numeric(.shape2)
+    shape3 <- as.numeric(.shape3)
+    rate <- as.numeric(.rate)
+    scl <- as.numeric(.scale)
+
+    # Checks ----
+    if (!is.integer(n) | n < 0) {
+        rlang::abort(
+            "The parameters '.n' must be of class integer. Please pass a whole
+            number like 50 or 100. It must be greater than 0."
+        )
+    }
+
+    if (!is.integer(num_sims) | num_sims < 0) {
+        rlang::abort(
+            "The parameter `.num_sims' must be of class integer. Please pass a
+            whole number like 50 or 100. It must be greater than 0."
+        )
+    }
+
+    if (!is.numeric(shape1) | !is.numeric(shape2) | !is.numeric(shape3) |
+        !is.numeric(scl) | !is.numeric(rate)) {
+        rlang::abort(
+            "The parameters of '.shape1', '.shape2', '.shape3', '.rate', and '.scale'
+            must be of class numeric."
+        )
+    }
+
+    if (shape1 <= 0 | shape2 <= 0 | shape3 <= 0 | scl <= 0 | rate <= 0){
+        rlang::abort(
+            "The parameters of '.shape1', '.shape2', '.shape3', '.rate', and '.scale'
+            must be strictly positive."
+        )
+    }
+
+    x <- seq(1, num_sims, 1)
+
+    ps <- seq(-n, n - 1, 2)
+    qs <- seq(0, 1, (1 / (n - 1)))
+
+    df <- dplyr::tibble(sim_number = as.factor(x)) %>%
+        dplyr::group_by(sim_number) %>%
+        dplyr::mutate(x = list(1:n)) %>%
+        dplyr::mutate(y = list(actuar::rgenbeta(n = n, shape1 = shape1,
+                                                shape2 = shape2,
+                                                shape3 = shape3,
+                                                rate = rate, scale = scl))) %>%
+        dplyr::mutate(d = list(density(unlist(y), n = n)[c("x", "y")] %>%
+                                   purrr::set_names("dx", "dy") %>%
+                                   dplyr::as_tibble())) %>%
+        dplyr::mutate(p = list(actuar::pgenbeta(ps, shape1 = shape1,
+                                            shape2 = shape2,
+                                            shape3 = shape3,
+                                            rate = rate, scale = scl))) %>%
+        dplyr::mutate(q = list(actuar::qgenbeta(qs, shape1 = shape1,
+                                            shape2 = shape2,
+                                            shape3 = shape3,
+                                            rate = rate, scale = scl))) %>%
+        tidyr::unnest(cols = c(x, y, d, p, q)) %>%
+        dplyr::ungroup()
+
+
+    # Attach descriptive attributes to tibble
+    attr(df, ".shape1") <- .shape1
+    attr(df, ".shape2") <- .shape2
+    attr(df, ".shape3") <- .shape3
+    attr(df, ".rate") <- .rate
+    attr(df, ".scale") <- .scale
+    attr(df, ".n") <- .n
+    attr(df, ".num_sims") <- .num_sims
+    attr(df, "tibble_type") <- "tidy_generalized_beta"
+    attr(df, "ps") <- ps
+    attr(df, "qs") <- qs
+
+    # Return final result as function output
+    return(df)
+}

R/random-tidy-general-pareto.R

@@ -123,7 +123,7 @@ tidy_generalized_pareto <- function(.n = 50, .shape1 = 1, .shape2 = 1,
   # Attach descriptive attributes to tibble
   attr(df, ".shape1") <- .shape1
   attr(df, ".shape2") <- .shape2
-  attr(df, "rate") <- .rate
+  attr(df, ".rate") <- .rate
   attr(df, ".scale") <- .scale
   attr(df, ".n") <- .n
   attr(df, ".num_sims") <- .num_sims

R/tidy-random-walk.R

@@ -43,7 +43,7 @@
 #'
 
 tidy_random_walk <- function(.data, .initial_value = 0, .sample = FALSE,
-                             .replace = FALSE, .value_type = "cum_sum") {
+                             .replace = FALSE, .value_type = "cum_prod") {
 
   # Tidyeval ----
   initial_value <- as.numeric(.initial_value)

docs/pkgdown.yml

@@ -3,7 +3,7 @@ pkgdown: 2.0.2
 pkgdown_sha: ~
 articles:
   getting-started: getting-started.html
-last_built: 2022-02-11T19:10Z
+last_built: 2022-02-14T15:17Z
 urls:
   reference: https://github.com/spsanderson/TidyDensity/reference
   article: https://github.com/spsanderson/TidyDensity/articles