|
| 1 | +# Temporary code to supplement distributional to plot distributions using chart() |
| 2 | + |
| 3 | +#library(distributional) |
| 4 | +#N1 <- dist_normal(mu = 1, sigma = 1.5) |
| 5 | +#N1 |
| 6 | +#class(N1) |
| 7 | +#family(N1) |
| 8 | +#mean(N1) |
| 9 | +#sqrt(variance(N1)) |
| 10 | +#stddev(N1) |
| 11 | +#stddev <- function(x, ...) |
| 12 | +# UseMethod("stddev") |
| 13 | +# |
| 14 | +#stddev.default <- function(x, ...) { |
| 15 | +# stop("The stddev() method is not supported for objects of type ", |
| 16 | +# paste(deparse(class(x)), collapse = "")) |
| 17 | +#} |
| 18 | +# |
| 19 | +#stddev.distribution <- function(x, ...) |
| 20 | +# sqrt(variance(x, ...)) |
| 21 | +# |
| 22 | +# TODO: also tidy() and glance() |
| 23 | +#augment.distribution <- function(x, at = NULL, ...) { |
| 24 | +# if (is.null(at)) { |
| 25 | +# range <- quantile(x, c(0.001, 0.999)) |> unlist() |> range() |
| 26 | +# # If range[1] is very close to 0, put it at zero |
| 27 | +# if (range[1] > 0 && range[1] < 0.001) |
| 28 | +# range[1] <- 0 |
| 29 | +# at <- seq(from = range[1], to = range[2], length.out = 100L) |
| 30 | +# } |
| 31 | +# dens <- density(x, at = at) |> as_dtf() |
| 32 | +# l <- length(dens) |
| 33 | +# if (l == 1) { |
| 34 | +# names(dens) <- "density" |
| 35 | +# } else { |
| 36 | +# names(dens) <- paste0("density", c("", 2:l)) |
| 37 | +# } |
| 38 | +# |
| 39 | +# attr(dens, "dist") <- format(x) |
| 40 | +# dtx(quantile = at, dens) |
| 41 | +#} |
| 42 | + |
| 43 | +#' Create and plot density functions for distribution objects |
| 44 | +#' |
| 45 | +#' The **distribution** objects represnet one or more statistical distributions. |
| 46 | +#' The functions [dfun()] and [geom_funfill()], together with [chart()] allow to |
| 47 | +#' plot them. |
| 48 | +#' |
| 49 | +#' @param object A **distribution** object, as from the {distributional} package. |
| 50 | +#' @param i The distribution to use from the list (first one by default) |
| 51 | +#' @param n The number of points to use to draw the density functions (500 by |
| 52 | +#' default) of continuous distributions. |
| 53 | +#' @param xlim Two numbers that limit the X axis. |
| 54 | +#' @param size If `xlim=` is not provided, it is automatically calculated using |
| 55 | +#' the size of the CI between 0 and 100 (99.5 by default) for continuous |
| 56 | +#' distributions. |
| 57 | +#' @param xlab The label of the X axis ("Quantile" by default). |
| 58 | +#' @param ylab The label of the Y axis ("Probability density" or "Cumulative probability density" by default). |
| 59 | +#' @param plot.it Should the densities be plotted for all the distributions |
| 60 | +#' (`TRUE` by default)? |
| 61 | +#' @param use.chart Should [chart()] be used (`TRUE` by default)? Otherwise, |
| 62 | +#' [ggplot()] is used. |
| 63 | +#' @param type The type of plot ("density" by default, or "cumulative"). |
| 64 | +#' @param theme The theme for the plot (ignored for now). |
| 65 | +#' @param env The environment to use to evaluate expressions. |
| 66 | +#' @param ... Further arguments to [stat_function()]. |
| 67 | +#' @param mapping the mapping to use (`NULL` by default. |
| 68 | +#' @param data The data frame to use (`NULL` by default). |
| 69 | +#' @param fun The function to use (could be `dfun(distribution_object)`). |
| 70 | +#' @param from The first quantile to delimit the filled area. |
| 71 | +#' @param to The second quantile to delimit the filled area. |
| 72 | +#' @param geom The geom to use (`"area"` by default). |
| 73 | +#' @param fill The color to fill the area (`"salmon"` by default). |
| 74 | +#' @param alpha The alpha transparency to apply, 0.5 by default. |
| 75 | +#' |
| 76 | +#' @return Either a function or a ggplot object. |
| 77 | +#' @export |
| 78 | +#' |
| 79 | +#' @examples |
| 80 | +#' library(distributional) |
| 81 | +#' library(chart) |
| 82 | +#' di1 <- dist_normal(mu = 1, sigma = 1.5) |
| 83 | +#' chart(di1) + |
| 84 | +#' geom_funfill(fun = dfun(di1), from = -5, to = 1) |
| 85 | +#' |
| 86 | +#' # With two distributions |
| 87 | +#' di2 <- c(dist_normal(10, 1), dist_student_t(df = 3, 13, 1)) |
| 88 | +#' chart(di2) + |
| 89 | +#' geom_funfill(fun = dfun(di2, 1), from = -5, to = 0) + |
| 90 | +#' geom_funfill(fun = dfun(di2, 2), from = 2, to = 6, fill = "turquoise3") |
| 91 | +#' chart$cumulative(di2) |
| 92 | +#' # A discrete distribution |
| 93 | +#' di3 <- dist_binomial(size = 7, prob = 0.5) |
| 94 | +#' chart(di3) |
| 95 | +#' chart$cumulative(di3) |
| 96 | +#' # A continuous together with a discrete distribution |
| 97 | +#' di4 <- c(dist_normal(mu = 4, sigma = 2), dist_binomial(size = 8, prob = 0.5)) |
| 98 | +#' chart(di4) |
| 99 | +#' chart$cumulative(di4) |
| 100 | +dfun <- function(object, i = 1) { |
| 101 | + function(x) density(object[[i]], at = x)[[1]] |
| 102 | +} |
| 103 | + |
| 104 | +#' @export |
| 105 | +#' @rdname dfun |
| 106 | +cdfun <- function(object, i = 1) { |
| 107 | + function(x) cdf(object[[i]], q = x)[[1]] |
| 108 | +} |
| 109 | + |
| 110 | +#' @export |
| 111 | +#' @rdname dfun |
| 112 | +autoplot.distribution <- function(object, n = 500, xlim = NULL, size = 99.5, |
| 113 | +xlab = "Quantile", ylab = if (type == "density") "Probability density" else "Cumulative probability density", |
| 114 | +plot.it = TRUE, use.chart = FALSE, ..., type = "density", theme = NULL) { |
| 115 | + if (is.null(xlim)) { |
| 116 | + #xlim <- unclass(hilo(object, size = size))[1:2] |> unlist() |> range() |
| 117 | + xlim <- quantile(object, |
| 118 | + p = c((1 - size/100) / 2, 1 - (1 - size/100) / 2)) |> unlist() |> range() |
| 119 | + xlim2 <- unclass(support(object))$lim |> unlist() |
| 120 | + xlim2 <- xlim2[is.finite(xlim2)] |
| 121 | + if (length(xlim2)) { |
| 122 | + xlim2 <- range(xlim2) |
| 123 | + xlim <- range(c(xlim, xlim2[1] - 1, xlim2[2] + 1)) |
| 124 | + } |
| 125 | + } |
| 126 | + if (isTRUE(use.chart)) { |
| 127 | + fun <- chart::chart |
| 128 | + } else { |
| 129 | + fun <- ggplot2::ggplot |
| 130 | + } |
| 131 | + if (type == "density") { |
| 132 | + densfun <- dfun |
| 133 | + dens <- density |
| 134 | + } else if (type == "cumulative") { |
| 135 | + densfun <- cdfun |
| 136 | + dens <- function(x, at, ...) cdf(x, q = at, ...) |
| 137 | + } else stop("type must be 'density' or 'cumulative'") |
| 138 | + res <- fun(data = NULL, mapping = aes()) + |
| 139 | + xlim(xlim[1], xlim[2]) + |
| 140 | + xlab(xlab) + |
| 141 | + ylab(ylab) |
| 142 | + if (isTRUE(plot.it)) { |
| 143 | + prob <- NULL # This is to avoid an error in R CMD check |
| 144 | + l <- length(object) |
| 145 | + if (l == 1) { |
| 146 | + dist_sup <- unclass(support(object)) |
| 147 | + dist_discrete <- is.integer(dist_sup$x[[1]]) |
| 148 | + if (dist_discrete) { |
| 149 | + dist_range <- dist_sup$lim[[1]] |
| 150 | + if (!is.finite(dist_range[1])) |
| 151 | + dist_range[1] <- xlim[1] |
| 152 | + if (!is.finite(dist_range[2])) |
| 153 | + dist_range[2] <- xlim[2] |
| 154 | + # Generate a table with quantiles and probabilities |
| 155 | + dist_data <- data.frame(quantile = |
| 156 | + seq(from = dist_range[1], to = dist_range[2])) |
| 157 | + dist_data$prob <- dens(object, at = dist_data$quantile)[[1]] |
| 158 | + res <- res + geom_segment(aes(x = quantile, xend = quantile, y = 0, |
| 159 | + yend = prob), data = dist_data) |
| 160 | + } else {# Continuous distribution |
| 161 | + res <- res + geom_function(fun = densfun(object), n = n, ...) |
| 162 | + } |
| 163 | + } else { |
| 164 | + dist_names <- format(object) |
| 165 | + dist_sup <- unclass(support(object)) |
| 166 | + for (i in 1:length(object)) { |
| 167 | + dist <- dist_names[[i]] |
| 168 | + # Is the distribution discrete or continuous? |
| 169 | + dist_discrete <- is.integer(dist_sup$x[[i]]) |
| 170 | + if (dist_discrete) { |
| 171 | + dist_range <- dist_sup$lim[[i]] |
| 172 | + if (!is.finite(dist_range[1])) |
| 173 | + dist_range[1] <- xlim[1] |
| 174 | + if (!is.finite(dist_range[2])) |
| 175 | + dist_range[2] <- xlim[2] |
| 176 | + # Generate a table with quantiles and probabilities |
| 177 | + dist_data <- data.frame(quantile = |
| 178 | + seq(from = dist_range[1], to = dist_range[2])) |
| 179 | + dist_data$prob <- dens(object[[i]], at = dist_data$quantile)[[1]] |
| 180 | + res <- res + geom_segment(aes(x = quantile, xend = quantile, y = 0, |
| 181 | + yend = prob, colour = {{dist}}), data = dist_data) |
| 182 | + |
| 183 | + } else {# Continuous distribution |
| 184 | + dist_fun <- densfun(object, i) |
| 185 | + # This is needed to force evaluation of the function at each step |
| 186 | + dist_fun(0) |
| 187 | + res <- res + geom_function(aes(colour = {{dist}}), fun = dist_fun, |
| 188 | + n = n, ...) |
| 189 | + } |
| 190 | + } |
| 191 | + } |
| 192 | + } |
| 193 | + res |
| 194 | +} |
| 195 | + |
| 196 | +#' @export |
| 197 | +#' @rdname dfun |
| 198 | +chart.distribution <- function(data, ..., type = "density", env = parent.frame()) |
| 199 | + autoplot(data, type = type, theme = theme_sciviews(), use.chart = TRUE, ...) |
| 200 | + |
| 201 | +#' @export |
| 202 | +#' @rdname dfun |
| 203 | +geom_funfill <- function(mapping = NULL, data = NULL, fun, from, to, |
| 204 | + geom = "area", fill = "salmon", alpha = 0.5, ...) { |
| 205 | + stat_function(mapping = mapping, data = data, fun = fun, geom = geom, |
| 206 | + xlim = c(from, to), fill = fill, alpha = alpha, ...) |
| 207 | +} |
0 commit comments