The tidydensity from spsanderson

tidy_rnorm <- function(.n = 50, .mean = 0, .sd = 1, .num_sims = 1){
  
  # Tidyeval ----
  n         <- as.integer(.n)
  num_sims <- as.integer(.num_sims)
  mu  <- as.numeric(.mean)
  std <- as.numeric(.sd)
  
  # 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(mu)){
    rlang::abort(
      "The parameters of '.mean' and '.sd' must be of class numeric.
            Please pass a numer like 1 or 1.1 etc."
    )
  }
  
  if(!is.numeric(std)){
    rlang::abort(
      "The parameters of '.mean' and '.sd' must be of class numeric.
            Please pass a numer like 1 or 1.1 etc."
    )
  }
  
  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(stats::rnorm(n, mu, std))) %>%
    dplyr::mutate(d_norm = list(stats::dnorm(unlist(y), mu, std))) %>%
    dplyr::mutate(p_norm = list(stats::pnorm(ps, mu, std))) %>%
    dplyr::mutate(q_norm = list(stats::qnorm(qs, mu, std))) %>%
    tidyr::unnest(cols = c(x, y, d_norm, p_norm, q_norm)) %>%
    dplyr::ungroup()
  
  
  # Attach descriptive attributes to tibble
  attr(df, ".mean") <- .mean
  attr(df, ".sd") <- .sd
  attr(df, ".n") <- .n
  attr(df, ".num_sims") <- .num_sims
  attr(df, "tibble_type") <- "tidy_gaussian"
  attr(df, "ps") <- ps
  attr(df, "qs") <- qs
  
  # Return final result as function output
  return(df)
  
}

Update `tidy_autoplot()`

update tidy_autoplot() to work with all tidy_ distribution functions.

Add other tidy_ distribution functions
Make sure the probability plot uses x = ps
Make sure the quantile plot uses x = qs

Add function `tidy_chisquare()`

Add function `get_tidy_distribution_stat()`

crayon dependency

Describe the bug

The dev version of pillar no longer imports the crayon package, coloring is now provided via the cli package. Please change to conditional use of crayon or switch to cli.

To Reproduce

Install the development version of pillar, and TidyDensity, into a clean library, try to load the package.

Update `tidy_autoplot()`

Update tidy_autoplot() to plot out the tidy_multi_ distribution functions.

  ggplot2::theme_minimal() +
  ggplot2::geom_smooth(aes(group = dist_type), color = "black", linetype = "dashed",
                      se = FALSE, size = 0.5, alpha = .382)

Drop cli crayon and rstudioapi

Make rlang or base msg

Release TidyDensity 0.0.1

First release:

usethis::use_cran_comments()
Update (aspirational) install instructions in README
Proofread Title: and Description:
Check that all exported functions have @return and @examples
Check that Authors@R: includes a copyright holder (role 'cph')
Check licensing of included files
Review https://github.com/DavisVaughan/extrachecks

Prepare for release:

devtools::build_readme()
urlchecker::url_check()
devtools::check(remote = TRUE, manual = TRUE)
devtools::check_win_devel()
rhub::check_for_cran()

Submit to CRAN:

usethis::use_version('patch')
devtools::submit_cran()
Approve email

Wait for CRAN...

Accepted 🎉
usethis::use_github_release()
usethis::use_dev_version()

Add function plotting functions

Add a function to plot the density of the tidy_distribution_tbl

Must find attributes(tn)$tibble_type == "tidy_qaussian"

plot_density()

tn <- tidy_rnorm(.num_sim = 3)
tn_grp_mean <- tn %>%
  group_by(sim_number) %>%
  summarise(grp_mean = mean(y, na.rm = TRUE)) %>%
  ungroup()

p1 <- tn %>%
  ggplot(aes(x = y, group = sim_number, color = sim_number)) +
  geom_density() + 
  geom_vline(data = tn_grp_mean, aes(xintercept = grp_mean, color = sim_number), 
                                     linetype ="dashed") +
  theme_minimal() + 
  theme(legend.position = "bottom") + 
  labs(
    title = "Density Distribution", 
    subtitle = paste0(
      "Simulations: ", attributes(tn)$.num_sims, 
      " - mu: ", attributes(tn)$.mean, 
      " - sd: ", attributes(tn)$.sd, 
      " - Random Points: ", attributes(tn)$.n
    ),
    color = "Simulation",
    x = "x",
    y = "Density"
  )

plot_probability()

need ps from tidy_rnorm()
x <- attributes(data)$ps
tn %>%
  ggplot(aes(
    x = x,
    y = p_norm,
    group = sim_number,
    color = sim_number
  )) +
  geom_point() + 
  geom_line() + 
  theme_minimal() + 
  theme(legend.position = "bottom") + 
  labs(
    title = "Probability Distribution", 
    subtitle = paste0(
      "Simulations: ", attributes(tn)$.num_sims, 
      " - mu: ", attributes(tn)$.mean, 
      " - sd: ", attributes(tn)$.sd, 
      " - Random Points: ", attributes(tn)$.n
    ),
    color = "Simulation",
    x = "x",
    y = "Probability"
  )

plot_quantile()

tn %>%
  ggplot(aes(
    x = x,
    y = q_norm,
    group = sim_number,
    color = sim_number
  )) +
  geom_point() + 
  geom_line() + 
  theme_minimal() + 
  theme(legend.position = "bottom") + 
  labs(
    title = "Quantile Distribution", 
    subtitle = paste0(
      "Simulations: ", attributes(tn)$.num_sims, 
      " - mu: ", attributes(tn)$.mean, 
      " - sd: ", attributes(tn)$.sd, 
      " - Random Points: ", attributes(tn)$.n
    ),
    color = "Simulation",
    x = "x",
    y = "Quantile"
  )

plot_qq()

tn %>%
  ggplot(aes(sample = y, group = sim_number, color = sim_number)) +
  stat_qq() + 
  stat_qq_line() +
  theme_minimal() + 
  theme(legend.position = "bottom") + 
  labs(
    title = "QQ-Plot", 
    subtitle = paste0(
      "Simulations: ", attributes(tn)$.num_sims, 
      " - mu: ", attributes(tn)$.mean, 
      " - sd: ", attributes(tn)$.sd, 
      " - Random Points: ", attributes(tn)$.n
    ),
    color = "Simulation",
    x = "Test-X",
    y = "Test-Y"
  )

plot_dot_density()

tn %>%
  ggplot(aes(x = y, y = d_norm, group = sim_number, color = sim_number)) +
  geom_point() + 
  geom_line() +
  theme_minimal() + 
  theme(legend.position = "bottom") + 
  labs(
    title = "Density Distribution", 
    subtitle = paste0(
      "Simulations: ", attributes(tn)$.num_sims, 
      " - mu: ", attributes(tn)$.mean, 
      " - sd: ", attributes(tn)$.sd, 
      " - Random Points: ", attributes(tn)$.n
    ),
    color = "Simulation",
    x = "x",
    y = "Density"
  )

Add function `tidy_logistic()`

Add function `tidy_hypergeometric()`

Add function `tidy_lognormal()`

Add link to `tidy_rnorm()` description

Is your feature request related to a problem? Please describe.
Make a function to generate randomly generated gaussian data. Add a parameter or .n for how many points should be generated and .num_walks for how many simulations should be run.

Describe the solution you'd like
A function to return the above, randomly generated gaussian data

rgenpaeto - {actuar}

Fix `tidy_chisquare()` example and possible fx

rinvgauss - {actuar}

Add function `tidy_rgamma()`

tidy_rgamma <- function(.n = 50, .shape = 1, .rate = 1, .num_sims = 1){
  
  # Tidyeval ----
  n        <- as.integer(.n)
  num_sims <- as.integer(.num_sims)
  shp <- .shape
  rte <- .rate
  
  # 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(shp) | shp < 0){
    rlang::abort(
      "The parameters of '.shapte' and '.rate' must be of class numeric.
            Please pass a numer like 1 or 1.1 etc. and must be greater than 0."
    )
  }
  
  if(!is.numeric(rte)){
    rlang::abort(
      "The parameters of '.shape' and '.rate' must be of class numeric.
            Please pass a numer like 1 or 1.1 etc."
    )
  }
  
  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(stats::rgamma(n = n, shape = shp, rate = rte))) %>%
    dplyr::mutate(d_gamma = list(stats::dgamma(unlist(y), shape = shp, rate = rte))) %>%
    dplyr::mutate(p_gamma = list(stats::pgamma(ps, shape = shp, rate = rte))) %>%
    dplyr::mutate(q_gamma = list(stats::qgamma(qs, shape = shp, rate = rte))) %>%
    tidyr::unnest(cols = c(x, y, d_gamma, p_gamma, q_gamma)) %>%
    dplyr::ungroup()
  
  
  # Attach descriptive attributes to tibble
  attr(df, ".shape") <- .shape
  attr(df, ".rate") <- .rate
  attr(df, ".n") <- .n
  attr(df, ".num_sims") <- .num_sims
  attr(df, "tibble_type") <- "tidy_gamma"
  attr(df, "ps") <- ps
  attr(df, "qs") <- qs
  
  # Return final result as function output
  return(df)
  
}

tidy_rgamma()

library(tidyverse)

tidy_multi_normal <- function(.n = 50, .mean = c(-1,0,1), .sd = c(1), .num_sims = 2){
  
  # Tidyeval ----
  n <- as.integer(.n)
  mu <- as.numeric(.mean)
  std <- as.numeric(.sd)
  num_sims <- as.integer(.num_sims)
  
  # Checks ----
  if(!is.integer(n) | n <= 0){
    rlang::abort(
      "The .n parameter must be an integer and greater than 0"
    )
  }
  
  if(!is.integer(num_sims) | num_sims <= 1){
    rlang::abort(
      "The .num_sims parameter must be an integer grater than 1."
    )
  }
  
  if(!is.numeric(mu)){
    rlang::abort(
      "The .mean parameter must be numeric."
    )
  }
  
  if(!is.numeric(std)){
    rlang::abort(
      "The .sd parameter must be numeric"
    )
  }
  
  x <- seq(1, num_sims, 1)
  
  ps <- seq(-n, n-1, 2)
  qs <- seq(0, 1, (1/(n-1)))
  
  df <- expand_grid(
    sim_number = x,
    mu = mu,
    std = std
  )
  
  df <- df %>%
    mutate(sim_number = as.factor(sim_number)) %>%
    dplyr::group_by(sim_number, mu, std) %>%
    dplyr::mutate(x = list(1:n)) %>%
    dplyr::mutate(y = list(stats::rnorm(n, mu, std))) %>%
    dplyr::mutate(d = list(density(unlist(y), n = n)[c("x","y")] %>%
                             purrr::set_names("dx","dy") %>%
                             dplyr::as_tibble())) %>%
    dplyr::mutate(p = list(stats::pnorm(ps, mu, std))) %>%
    dplyr::mutate(q = list(stats::qnorm(qs, mu, std))) %>%
    tidyr::unnest(cols = c(x, y, d, p, q)) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(dist_type = paste0("Gaussian: c(", mu, ", ", std, ")")) %>%
    dplyr::mutate(dist_type = as.factor(dist_type)) %>%
    dplyr::select(
      sim_number, dist_type, dplyr::everything()
    ) %>%
    dplyr::arrange(sim_number, dist_type)
  
  # Attach attributes ----
  attr(df, ".n") <- .n
  attr(df, ".mean") <- .mean
  attr(df, ".sd") <- .sd
  attr(df, ".num_sims") <- .num_sims
  attr(df, "tibble_type") <- "tidy_multi_gaussian"
  attr(df, "ps") <- ps
  attr(df, "qs") <- qs
  
  # Return ----
  return(df)
  
}

tn <- tidy_multi_normal(.n = 500,.num_sims = 5)

atb <- attributes(tn)
n <- atb$.n
sims <- atb$.num_sims
dist_type = stringr::str_remove(atb$tibble_type, "tidy_multi_") %>%
  stringr::str_to_title()
sub_title = paste0(
  "Grouped Gaussian - Data Points: ", n, " - ",
  "Simulations: ", sims, "\n",
  "Distribution Family: ", dist_type, "\n",
  "Parameters: ", if(atb$tibble_type == "tidy_multi_gaussian"){
    paste0("Mean: c(", paste0(toString(atb$.mean), ")", " - SD: c(", toString(atb$.sd), ")"))
  }
)

tn %>%
  ggplot2::ggplot(ggplot2::aes(
    x = dx, 
    y = dy, 
    group = interaction(dist_type, sim_number), 
    color = dist_type)) +
  ggplot2::geom_line() +
  ggplot2::theme_minimal() +
  ggplot2::theme(legend.position = "bottom") +
  ggplot2::labs(
    title = "Density Plot",
    subtitle = sub_title,
    x = "",
    y = "Density",
    col

> tn %>%
+   group_by(dist_type, sim_number) %>%
+   summarise(mean_mu = mean(y))
`summarise()` has grouped output by 'dist_type'. You can override using the `.groups` argument.
# A tibble: 15 x 3
# Groups:   dist_type [3]
   dist_type          sim_number  mean_mu
   <fct>              <fct>         <dbl>
 1 Gaussian: c(-1, 1) 1          -0.947  
 2 Gaussian: c(-1, 1) 2          -0.971  
 3 Gaussian: c(-1, 1) 3          -1.03   
 4 Gaussian: c(-1, 1) 4          -0.959  
 5 Gaussian: c(-1, 1) 5          -0.981  
 6 Gaussian: c(0, 1)  1           0.00196
 7 Gaussian: c(0, 1)  2           0.00435
 8 Gaussian: c(0, 1)  3           0.0225 
 9 Gaussian: c(0, 1)  4          -0.0188 
10 Gaussian: c(0, 1)  5          -0.0652 
11 Gaussian: c(1, 1)  1           0.936  
12 Gaussian: c(1, 1)  2           0.971  
13 Gaussian: c(1, 1)  3           1.01   
14 Gaussian: c(1, 1)  4           0.916  
15 Gaussian: c(1, 1)  5           0.913  
> tn %>%
+   group_by(dist_type) %>%
+   summarise(mean_mu = mean(y))
# A tibble: 3 x 2
  dist_type          mean_mu
  <fct>                <dbl>
1 Gaussian: c(-1, 1) -0.978 
2 Gaussian: c(0, 1)  -0.0110
3 Gaussian: c(1, 1)   0.950

spsanderson / tidydensity Goto Github PK

tidydensity's Introduction

TidyDensity

Installation

Example

tidydensity's People

Contributors

Stargazers

Watchers

Forkers

tidydensity's Issues

Recommend Projects

Recommend Topics

Recommend Org