Skip to content

Commit

Permalink
made conversion function names clearer, relates #164
Browse files Browse the repository at this point in the history
  • Loading branch information
joshwlambert committed Aug 23, 2023
1 parent e17a16e commit e57f7d7
Show file tree
Hide file tree
Showing 11 changed files with 169 additions and 124 deletions.
4 changes: 2 additions & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,8 @@ export(calc_disc_dist_quantile)
export(cbind_epiparam)
export(clean_disease)
export(clean_epidist_name)
export(convert_params)
export(convert_summary_stats)
export(convert_params_to_summary_stats)
export(convert_summary_stats_to_params)
export(create_epidist_citation)
export(create_epidist_metadata)
export(create_epidist_method_assess)
Expand Down
12 changes: 6 additions & 6 deletions R/calc_dist_params.R
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@
#' prob_dist = "gamma",
#' prob_dist_params = NA,
#' summary_stats = create_epidist_summary_stats(
#' quantiles = c(q_2.5 = 0.2, q_97.5 = 9.2)
#' quantiles = c(q_2.5 = 0.2, q_97.5 = 9.2)
#' ),
#' sample_size = NA
#' )
Expand All @@ -55,7 +55,6 @@ calc_dist_params <- function(prob_dist,
prob_dist_params,
summary_stats,
sample_size = NA) {

# check input
checkmate::assert_string(prob_dist)
checkmate::assert_list(
Expand All @@ -67,7 +66,7 @@ calc_dist_params <- function(prob_dist,
stopifnot(
"probability distribution params must be a named vector or NA" =
anyNA(prob_dist_params) ||
!is.null(names(prob_dist_params))
!is.null(names(prob_dist_params))
)

# extract mean and sd to see if conversion is possible
Expand Down Expand Up @@ -101,11 +100,12 @@ calc_dist_params <- function(prob_dist,
"skewness", "ex_kurtosis", "dispersion"
)
summary_stats_ <- summary_stats_[idx]
# create flat list structure to be passed to ... in convert_summary_stats
# create flat list structure to be passed to ... in conversion
args <- unlist(list(prob_dist, as.list(summary_stats_)), recursive = FALSE)
prob_dist_params <- unlist(do.call(convert_summary_stats, args = args))
prob_dist_params <- unlist(do.call(
convert_summary_stats_to_params, args = args
))
} else if (!anyNA(percentiles)) {

# calculate the parameters from the percentiles
# percentiles required to be [0, 1] so divide by 100
prob_dist_params <- extract_param(
Expand Down
81 changes: 40 additions & 41 deletions R/convert_params.R
Original file line number Diff line number Diff line change
Expand Up @@ -35,13 +35,15 @@
#' @export
#'
#' @examples
#' convert_summary_stats(distribution = "lnorm", mean = 1, sd = 1)
#' convert_summary_stats(distribution = "weibull", mean = 2, var = 2)
#' convert_summary_stats(distribution = "geom", mean = 2)
convert_summary_stats <- function(distribution = c("lnorm", "gamma", "weibull",
"nbinom", "geom"),
...) {

#' convert_summary_stats_to_params(distribution = "lnorm", mean = 1, sd = 1)
#' convert_summary_stats_to_params(distribution = "weibull", mean = 2, var = 2)
#' convert_summary_stats_to_params(distribution = "geom", mean = 2)
convert_summary_stats_to_params <- function(distribution = c( # nolint
"lnorm", "gamma",
"weibull",
"nbinom", "geom"
),
...) {
# check input
distribution <- match.arg(distribution)
if (!checkmate::test_list(list(...), min.len = 1, names = "unique")) {
Expand Down Expand Up @@ -77,7 +79,7 @@ convert_summary_stats <- function(distribution = c("lnorm", "gamma", "weibull",
#' distributions in R, for example the lognormal distribution is `lnorm`,
#' and its parameters are `meanlog` and `sdlog`.
#'
#' @inheritParams convert_summary_stats
#' @inheritParams convert_summary_stats_to_params
#' @param ... `Numeric` named parameter(s) used to convert to summary
#' statistics. An example is the meanlog and sdlog parameters of the
#' lognormal (`lnorm`) distribution.
Expand All @@ -88,13 +90,20 @@ convert_summary_stats <- function(distribution = c("lnorm", "gamma", "weibull",
#' @export
#'
#' @examples
#' convert_params(distribution = "lnorm", meanlog = 1, sdlog = 2)
#' convert_params(distribution = "gamma", shape = 1, scale = 1)
#' convert_params(distribution = "nbinom", prob = 0.5, dispersion = 2)
convert_params <- function(distribution = c("lnorm", "gamma", "weibull",
"nbinom", "geom"),
...) {

#' convert_params_to_summary_stats(
#' distribution = "lnorm", meanlog = 1, sdlog = 2
#' )
#' convert_params_to_summary_stats(
#' distribution = "gamma", shape = 1, scale = 1
#' )
#' convert_params_to_summary_stats(
#' distribution = "nbinom", prob = 0.5, dispersion = 2
#' )
convert_params_to_summary_stats <- function(distribution = c( # nolint
"lnorm", "gamma", "weibull",
"nbinom", "geom"
),
...) {
# check input
distribution <- match.arg(distribution)
if (!checkmate::test_list(list(...), min.len = 1, names = "unique")) {
Expand Down Expand Up @@ -131,7 +140,7 @@ get_sd <- function(x) {
if ("sd" %in% names(x)) {
return(x)
}
if ("var" %in% names(x)) {
if ("var" %in% names(x)) {
x$sd <- sqrt(x$var)
} else if (all(c("mean", "cv") %in% names(x))) {
x$sd <- x$cv * x$mean
Expand Down Expand Up @@ -173,14 +182,13 @@ chk_ss <- function(x) {
#' distribution to a number of summary statistics which can be calculated
#' analytically given the lognormal parameters.
#'
#' @inheritParams convert_params
#' @inheritParams convert_params_to_summary_stats
#'
#' @return A list of eight elements including: mean, median, mode,
#' variance (`var`), standard deviation (`sd`), coefficient of variation (`cv`),
#' skewness, and excess kurtosis (`ex_kurtosis`).
#' @keywords internal
convert_params_lnorm <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -225,12 +233,11 @@ convert_params_lnorm <- function(...) {
#' @description Converts the summary statistics input into the meanlog and sdlog
#' parameters of the lognormal distribution.
#'
#' @inheritParams convert_summary_stats
#' @inheritParams convert_summary_stats_to_params
#'
#' @return A list of two elements, the meanlog and sdlog
#' @keywords internal
convert_summary_stats_lnorm <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -271,14 +278,13 @@ convert_summary_stats_lnorm <- function(...) {
#' analytically given the gamma parameters. One exception is the median which
#' is calculated using [`qgamma()`] as no analytical form is available.
#'
#' @inheritParams convert_params
#' @inheritParams convert_params_to_summary_stats
#'
#' @return A list of eight elements including: mean, median, mode,
#' variance (`var`), standard deviation (`sd`), coefficient of variation (`cv`),
#' skewness, and excess kurtosis (`ex_kurtosis`).
#' @keywords internal
convert_params_gamma <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -322,12 +328,11 @@ convert_params_gamma <- function(...) {
#' @description Converts the summary statistics input into the shape and scale
#' parameters of the gamma distribution.
#'
#' @inheritParams convert_summary_stats
#' @inheritParams convert_summary_stats_to_params
#'
#' @return A list of two elements, the shape and scale
#' @keywords internal
convert_summary_stats_gamma <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -357,14 +362,13 @@ convert_summary_stats_gamma <- function(...) {
#' analytically given the Weibull parameters. Note the conversion uses the
#' [`gamma()`] function.
#'
#' @inheritParams convert_params
#' @inheritParams convert_params_to_summary_stats
#'
#' @return A list of eight elements including: mean, median, mode,
#' variance (`var`), standard deviation (`sd`), coefficient of variation (`cv`),
#' skewness, and excess kurtosis (`ex_kurtosis`).
#' @keywords internal
convert_params_weibull <- function(...) {

# capture input
x <- list(...)

Expand All @@ -388,12 +392,12 @@ convert_params_weibull <- function(...) {
sd <- sqrt(var)
cv <- sd / mean
skewness <- (gamma(1 + 3 / shape) * scale^3 - 3 *
mean * sd^2 - mean^3) / (sd^3)
mean * sd^2 - mean^3) / (sd^3)
ex_kurtosis <- (gamma(1 + 4 / shape) * scale^4 - 4 * mean *
(gamma(1 + 3 / shape) * scale^3 - 3 * mean *
sd^2 - mean^3) -
6 * (mean^2 * sd^2 - gamma(1 + 2 / shape) *
scale^2) - mean^4) / (sd^4)
(gamma(1 + 3 / shape) * scale^3 - 3 * mean *
sd^2 - mean^3) -
6 * (mean^2 * sd^2 - gamma(1 + 2 / shape) *
scale^2) - mean^4) / (sd^4)


# return list of metrics
Expand All @@ -414,12 +418,11 @@ convert_params_weibull <- function(...) {
#' @description Converts the summary statistics input into the shape and scale
#' parameters of the Weibull distribution.
#'
#' @inheritParams convert_summary_stats
#' @inheritParams convert_summary_stats_to_params
#'
#' @return A list of two elements, the shape and scale
#' @keywords internal
convert_summary_stats_weibull <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -465,14 +468,13 @@ convert_summary_stats_weibull <- function(...) {
#' The parameters are `prob` and `dispersion` (which is also commonly
#' represented as *r*).
#'
#' @inheritParams convert_params
#' @inheritParams convert_params_to_summary_stats
#'
#' @return A list of eight elements including: mean, median, mode,
#' variance (`var`), standard deviation (`sd`), coefficient of variation (`cv`),
#' skewness, and ex_kurtosis.
#' @keywords internal
convert_params_nbinom <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -521,12 +523,11 @@ convert_params_nbinom <- function(...) {
#' distribution the parameters (`prob`) and (`dispersion`) of the negative
#' binomial distribution.
#'
#' @inheritParams convert_summary_stats
#' @inheritParams convert_summary_stats_to_params
#'
#' @return A list of two elements, the probability and dispersion parameters
#' @keywords internal
convert_summary_stats_nbinom <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -576,14 +577,13 @@ convert_summary_stats_nbinom <- function(...) {
#' number of failures before the first success (supported for zero). This is
#' the same form as used by base R and `distributional::dist_geometric()`.
#'
#' @inheritParams convert_params
#' @inheritParams convert_params_to_summary_stats
#'
#' @return A list of eight elements including: mean, median, mode,
#' variance (`var`), standard deviation (`sd`), coefficient of variation (`cv`),
#' skewness, and excess kurtosis (`ex_kurtosis`).
#' @keywords internal
convert_params_geom <- function(...) {

# capture input
x <- list(...)

Expand Down Expand Up @@ -629,12 +629,11 @@ convert_params_geom <- function(...) {
#' number of failures before the first success (supported for zero). This is
#' the same form as used by base R and `distributional::dist_geometric()`.
#'
#' @inheritParams convert_summary_stats
#' @inheritParams convert_summary_stats_to_params
#'
#' @return A list of one element, the probability parameter
#' @keywords internal
convert_summary_stats_geom <- function(...) {

# capture input
x <- list(...)

Expand Down
2 changes: 1 addition & 1 deletion R/create_prob_dist.R
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ create_prob_dist <- function(prob_dist,
),
nbinom = distributional::dist_negative_binomial(
size = prob_dist_params[["dispersion"]],
prob = convert_summary_stats(
prob = convert_summary_stats_to_params(
distribution = "nbinom",
mean = prob_dist_params[["mean"]],
dispersion = prob_dist_params[["dispersion"]]
Expand Down
2 changes: 1 addition & 1 deletion R/epidist_utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -665,7 +665,7 @@ clean_epidist_params.nbinom <- function(prob_dist_params) {
if (all(c("n", "p") %in% names(prob_dist_params))) {

# convert prob to mean
prob_dist_params[["p"]] <- convert_params(
prob_dist_params[["p"]] <- convert_params_to_summary_stats(
distribution = "nbinom",
prob = prob_dist_params[["p"]],
dispersion = prob_dist_params[["n"]]
Expand Down
2 changes: 1 addition & 1 deletion man/calc_dist_params.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 12 additions & 6 deletions man/convert_params.Rd → man/convert_params_to_summary_stats.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit e57f7d7

Please sign in to comment.