Nothing
#' Binomial distribution of rolling a dice.
#'
#' Generates a tibble containing the binomial distribution of rolling the dice
#' using dbinom().
#'
#' @param times How many times a dice is rolled (or how many dice are rolled at the same time)
#' @param success Which result is a success (default = 6)
#' @param sides Number of sides of the dice (default = 6)
#' @return Binomial distribution as a tibble
#' @examples
#' binom_dice(times = 10)
#' @export
binom_dice <- function(times, sides = 6, success = 6) {
# check if meaningful parameters
assertthat::assert_that(is.numeric(times), msg = "times must be numeric")
assertthat::assert_that(is.numeric(sides), msg = "sides must be numeric")
assertthat::assert_that(is.numeric(success), msg = "success must be numeric")
assertthat::assert_that(length(times) == 1)
assertthat::assert_that(length(sides) == 1)
assertthat::assert_that(times > 0, msg = "times must be greater than 0")
assertthat::assert_that(sides > 0, msg = "sides must be greater than 0")
# make sure that parameters are integer
times <- floor(times)
sides <- floor(sides)
success <- floor(success)
# prepare binomial
n_success <- sum(success <= sides)
# binomial distribution
x_seq <- 0:times
#p <- purrr::map_dbl(x_seq, ~dbinom(size = times, x = .x, p = n_success/sides))
p <- stats::dbinom(size = times, x = x_seq, prob = n_success/sides)
tbl <- tibble::tibble(success = x_seq, p = p, pct = p *100)
# return result
tbl
} # binom_dice
#' Binomial distribution of flipping a coin.
#'
#' Generates a tibble containing the binomial distribution of flipping a coin
#' using dbinom().
#'
#' @param times how many times a coin is flipped (or how many coins are flipped at the same time)
#' @param success which result is a success (default = 2)
#' @param sides number of sides of the coin (default = 2)
#' @return binomial distribution as a tibble
#' @examples
#' binom_coin(times = 10)
#' @export
binom_coin <- function(times, sides = 2, success = 2) {
binom_dice(times, sides, success)
} # binom_coin
#' Binomial distribution as table.
#'
#' Generates a tibble containing the binomial distribution using dbinom().
#'
#' @param times number of trials
#' @param prob_success probability of success (number between 0 and 1)
#' @return Binomial distribution as a tibble
#' @examples
#' binom(times = 10, prob_success = 1/10)
#' @export
binom <- function(times, prob_success) {
# check if meaningful parameters
assertthat::assert_that(is.numeric(times), msg = "times must be numeric")
assertthat::assert_that(is.numeric(prob_success), msg = "prob_success must be numeric")
assertthat::assert_that(length(times) == 1)
assertthat::assert_that(length(prob_success) == 1)
assertthat::assert_that(times > 0)
assertthat::assert_that(prob_success >= 0)
# make sure that parameters are integer
times <- floor(times)
# binomial distribution
x_seq <- 0:times
p <- stats::dbinom(size = times, x = x_seq, prob = prob_success)
tbl <- tibble::tibble(success = x_seq, p = p, pct = p *100)
# return result
tbl
} # binom
#' Plot a binomial distribution.
#'
#' Plot a binomial distribution generated with binom_dice() or binom_coin()
#'
#' @param data data containing values for binomial distribution
#' @param title title of the plot
#' @param color color of bars
#' @param color_highlight color of highlighted bars
#' @param label add labels to plot?
#' @param label_size size of label
#' @param min_pct surpress values < min_pct
#' @param highlight vector of values to be highlighted
#' @return ggplot object
#' @importFrom magrittr "%>%"
#' @import dplyr
#' @import ggplot2
#' @examples
#' plot_binom(data = binom_dice(times = 10))
#' @export
plot_binom <- function(data , title = "Binomial distribution", color = "darkgrey", color_highlight = "coral", label = NULL, label_size = 3, min_pct = 0.05, highlight = NULL) {
assertthat::assert_that("success" %in% names(data), msg = "success not found in data")
assertthat::assert_that("pct" %in% names(data), msg = "pct not found in data")
# define variables to pass CRAN checks
pct <- NULL
pct_label <- NULL
success <- NULL
# drop if pct < 0.05
data <- data %>% filter(pct >= min_pct)
# add highlight
if (missing(highlight)) {
data <- data %>% mutate(highlight = TRUE)
} else {
data <- data %>%
mutate(highlight = ifelse (success %in% highlight, TRUE, FALSE))
pct_sum <- data %>%
filter(highlight == TRUE) %>%
summarise(pct_sum = sum(pct)) %>%
pull()
} # if
# label?
if (is.null(label)) {
if (nrow(data) < 50) {
label <- TRUE
} else {
label <- FALSE
}
}
# format label
if (nrow(data) > 30) {
data <- data %>% mutate(pct_label = ifelse(pct >= 10, round(pct,1), round(pct,1)))
} else {
data <- data %>% mutate(pct_label = ifelse(pct >= 10, round(pct,1), round(pct,2)))
}
if (missing(highlight)) {
p <- data %>%
ggplot(aes(success, pct)) +
geom_col(fill = color)
} else {
p <- data %>%
ggplot(aes(success, pct, fill=highlight)) +
geom_col() +
scale_fill_manual(values = c(color, color_highlight))
}
# plot
p <- p +
ylim(0, max(data$pct * 1.1)) +
ylab("percent (0-100)") +
theme_light()
# label
if (label) {
p <- p + geom_text(aes(x = success, y = pct, label = pct_label),
size = label_size, vjust = 0, nudge_y = 0.1)
}
# add title
if (missing(highlight)) {
p <- p + ggtitle(title)
} else {
p <- p + ggtitle(title,
subtitle = paste0("Highlighted = ",
round(pct_sum,2),"%"))
}
# return result
p
} # plot_binom
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.