plot_dist.R

## plot_dist.R
# plot_dist.R: convenience function for plotting distribution shapes.

# Ilari Scheinin
# firstname.lastname@gmail.com
# 2016-11-17
# MIT License

# distribution: a density or distribution function, such as dnorm, pbeta, ...
# parameters:   a (possibly named) vector of parameters for the
#               density/distribution function
# from, to:     the range over which the function will be plotted.
# n:            the number of x values at which to evaluate.
#               for PMFs, should be set to n=to-from+1 to avoid warnings.
# ...:          further arguments to be passed to curve().

plot_dist <- function(distribution, parameters,
                      from = NULL, to = NULL, n = 101L,
                      xlab = "", ylab = NULL, legend = NULL,
                      legend.x = "topright", legend.y = NULL,
                      legend.move = c("down", "up", "no"),
                      col = par("col"), add = FALSE, ...) {

  distribution_name <- as.character(substitute(distribution))
  # if no ylab was given, try to infer density/probability from function name
  if (is.null(ylab)) {
    letter <- substr(distribution_name, start=1L, stop=1L)
    if (letter == "d") {
      ylab = "density"
    } else if (letter == "p") {
      ylab = "probability"
    } else {
      ylab = ""
    }
  }
  # if no legend was given, use function name and parameter values
  if (is.null(legend)) {
    # for named parameters, include an equal sign
    sep <- ifelse(names(parameters) != "", "=", "")
    legend <- paste0(distribution_name, "(",
      paste(paste0(names(parameters), sep, parameters), collapse = ", "),
      ")")
  }
  distribution <- match.fun(distribution)
  legend.move <- match.arg(legend.move)
  value <- curve(do.call(distribution, c(list(x), as.list(parameters))),
    from = from, to = to, n = n, xlab = xlab, ylab = ylab, col = col,
    add = add, ...)
  # add legend, and shift down/up if adding to an existing plot
  legend_location <- paste(legend.x, legend.y)
  if (add) {
    legends <- getOption("plot_dist::legends", default = list())
  } else {
    legends <- list()
  }
  if (is.null(legends[[legend_location]])) {
    legends[[legend_location]] <- 0L
  }
  if (legend.move == "down") {
    legend <- c(rep("", times = legends[[legend_location]]), legend)
  } else if (legend.move == "up") {
    legend <- c(legend, rep("", times = legends[[legend_location]]))
  }
  legend(legend.x, legend.y, legend = legend, text.col = col, bty = "n")
  legends[[legend_location]] <- legends[[legend_location]] + 1L
  options("plot_dist::legends" = legends)
  invisible(value)
}

# EOF

## plot_dist_examples.R
# simplest case
plot_dist(dbeta, c(2, 2))

# with named parameters
plot_dist(pnorm, c(mean=0, sd=1), from=-3, to=3,
  main="Normal CDF", legend.x="bottomright")

# https://en.wikipedia.org/wiki/File:Beta_distribution_pdf.svg
plot_dist(dbeta, c(shape1=0.5, shape2=0.5), legend.x="top", col="red",
  ylim=c(0, 2.5), main="Beta PDF")
plot_dist(dbeta, c(shape1=5, shape2=1), legend.x="top", col="blue", add=TRUE)
plot_dist(dbeta, c(shape1=1, shape2=3), legend.x="top", col="green", add=TRUE)
plot_dist(dbeta, c(shape1=2, shape2=2), legend.x="top", col="purple", add=TRUE)
plot_dist(dbeta, c(shape1=2, shape2=5), egend.x="top", col="orange", add=TRUE)

# https://en.wikipedia.org/wiki/File:Beta_distribution_cdf.svg
plot_dist(pbeta, c(shape1=0.5, shape2=0.5), legend.x="topleft", col="red",
  main="Beta CDF")
plot_dist(pbeta, c(shape1=5, shape2=1), legend.x="topleft", col="blue",
  add=TRUE)
plot_dist(pbeta, c(shape1=1, shape2=3), legend.x="topleft", col="green",
  add=TRUE)
plot_dist(pbeta, c(shape1=2, shape2=2), legend.x="topleft", col="purple",
  add=TRUE)
plot_dist(pbeta, c(shape1=2, shape2=5), legend.x="topleft", col="orange",
  add=TRUE)

# https://en.wikipedia.org/wiki/File:Binomial_distribution_pmf.svg
plot_dist(dbinom, c(p=0.5, size=20), from=0, to=40, n=41, type="p", pch=19,
  col="blue", ylim=c(0, 0.25), main="Binomial PMF")
plot_dist(dbinom, c(p=0.7, size=20), n=41, type="p", pch=19,
  col="green", add=TRUE)
plot_dist(dbinom, c(p=0.5, size=40), n=41, type="p", pch=19,
  col="red", add=TRUE)

# https://en.wikipedia.org/wiki/File:Binomial_distribution_cdf.svg
plot_dist(pbinom, c(p=0.5, size=40), from=0, to=40, type="p", pch=19,
  legend.x="bottomright", col="red", main="Binomial CDF")
plot_dist(pbinom, c(p=0.7, size=20), type="p", pch=19,
  legend.x="bottomright", legend.move="up", col="green", add=TRUE)
plot_dist(pbinom, c(p=0.5, size=20), type="p", pch=19,
  legend.x="bottomright", legend.move="up", col="blue", add=TRUE)

# https://en.wikipedia.org/wiki/File:Poisson_pmf.svg
plot_dist(dpois, c(lambda=1), from=0, to=20, n=21, type="b", pch=19,
  col="orange", main="Poisson PMF")
plot_dist(dpois, c(lambda=4), n=21, type="b", pch=19,
  col="purple", add=TRUE)
plot_dist(dpois, c(lambda=10), n=21, type="b", pch=19,
  col="lightblue", add=TRUE)

# https://en.wikipedia.org/wiki/File:Poisson_cdf.svg
plot_dist(ppois, c(lambda=10), from=0, to=20, type="b", pch=19,
  legend.x="bottomright", col="lightblue", main="Poisson CDF")
plot_dist(ppois, c(lambda=4), type="b", pch=19,
  legend.x="bottomright", legend.move="up", col="purple", add=TRUE)
plot_dist(ppois, c(lambda=1), type="b", pch=19,
  legend.x="bottomright", legend.move="up", col="orange", add=TRUE)

# https://en.wikipedia.org/wiki/File:Normal_Distribution_PDF.svg
plot_dist(dnorm, c(mean=0, sd=sqrt(0.2)), from=-5, to=5, col="blue",
  main="Normal PDF")
plot_dist(dnorm, c(mean=0, sd=sqrt(1.0)), col="red", add=TRUE)
plot_dist(dnorm, c(mean=0, sd=sqrt(5.0)), col="orange", add=TRUE)
plot_dist(dnorm, c(mean=-2, sd=sqrt(0.5)), col="darkgreen", add=TRUE)

# https://en.wikipedia.org/wiki/File:Normal_Distribution_CDF.svg
plot_dist(pnorm, c(mean=0, sd=sqrt(0.2)), from=-5, to=5, legend.x="topleft",
  col="blue", main="Normal CDF")
plot_dist(pnorm, c(mean=0, sd=sqrt(1.0)), legend.x="topleft", col="red",
  add=TRUE)
plot_dist(pnorm, c(mean=0, sd=sqrt(5.0)), legend.x="topleft", col="orange",
  add=TRUE)
plot_dist(pnorm, c(mean=-2, sd=sqrt(0.5)), legend.x="topleft", col="darkgreen",
  add=TRUE)

# EOF