https://github.com/cran/bayestestR
Raw File
Tip revision: e1fa15d202de277bb07e58bb3013557724072b2b authored by Dominique Makowski on 22 September 2019, 15:30 UTC
version 0.3.0
Tip revision: e1fa15d
distribution.R
#' Empirical Distributions
#'
#' Generate a sequence of n-quantiles, i.e., a sample of size \code{n} with a near-perfect distribution.
#'
#' @param type Can be \code{"normal"} (default), \code{"cauchy"}, \code{"poisson"}, \code{"gamma"}, \code{"chisquared"}, \code{"uniform"}, \code{"student"} or \code{"beta"}.
#' @param random Generate near-perfect or random (simple wrappers for the base R \code{r*} functions) distributions.
#' @param ... Arguments passed to or from other methods.
#'
#' @examples
#' library(bayestestR)
#' x <- distribution(n = 10)
#' plot(density(x))
#' @export
distribution <- function(type = "normal", ...) {
  switch(
    match.arg(arg = type, choices = c("normal", "cauchy", "poisson", "gamma", "student", "chisquared", "uniform", "beta")),
    "normal" = distribution_normal(...),
    "cauchy" = distribution_cauchy(...),
    "poisson" = distribution_poisson(...),
    "gamma" = distribution_gamma(...),
    "student" = distribution_student(...),
    "chisquared" = distribution_chisquared(...),
    "uniform" = distribution_uniform(...),
    "beta" = distribution_beta(...),
    distribution_custom(type = type, ...)
  )
}





#' @rdname distribution
#' @inheritParams stats::rnorm
#' @importFrom stats qnorm rnorm
#' @export
distribution_normal <- function(n, mean = 0, sd = 1, random = FALSE, ...) {
  if (random) {
    stats::rnorm(n, mean, sd)
  } else {
    stats::qnorm(seq(1 / n, 1 - 1 / n, length.out = n), mean, sd, ...)
  }
}


#' @rdname distribution
#' @inheritParams stats::rcauchy
#' @importFrom stats rcauchy qcauchy
#' @export
distribution_cauchy <- function(n, location = 0, scale = 1, random = FALSE, ...) {
  if (random) {
    stats::rcauchy(n, location, scale)
  } else {
    stats::qcauchy(seq(1 / n, 1 - 1 / n, length.out = n), location, scale, ...)
  }
}


#' @rdname distribution
#' @inheritParams stats::rpois
#' @importFrom stats rpois qpois
#' @export
distribution_poisson <- function(n, lambda = 1, random = FALSE, ...) {
  if (random) {
    stats::rpois(n, lambda)
  } else {
    stats::qpois(seq(1 / n, 1 - 1 / n, length.out = n), lambda, ...)
  }
}


#' @rdname distribution
#' @inheritParams stats::rt
#' @importFrom stats rt qt
#' @export
distribution_student <- function(n, df, ncp, random = FALSE, ...) {
  if (random) {
    stats::rt(n, df, ncp)
  } else {
    stats::qt(seq(1 / n, 1 - 1 / n, length.out = n), df, ncp, ...)
  }
}


#' @rdname distribution
#' @inheritParams stats::rchisq
#' @importFrom stats rchisq qchisq
#' @export
distribution_chisquared <- function(n, df, ncp = 0, random = FALSE, ...) {
  if (random) {
    stats::rchisq(n, df, ncp)
  } else {
    stats::qchisq(seq(1 / n, 1 - 1 / n, length.out = n), df, ncp, ...)
  }
}


#' @rdname distribution
#' @inheritParams stats::runif
#' @importFrom stats runif qunif
#' @export
distribution_uniform <- function(n, min = 0, max = 1, random = FALSE, ...) {
  if (random) {
    stats::runif(n, min, max)
  } else {
    stats::qunif(seq(1 / n, 1 - 1 / n, length.out = n), min, max, ...)
  }
}




#' @rdname distribution
#' @inheritParams stats::rbeta
#' @importFrom stats rbeta qbeta
#' @export
distribution_beta <- function(n, shape1, shape2, ncp = 0, random = FALSE, ...) {
  if (random) {
    stats::rbeta(n, shape1, shape2, ncp = ncp)
  } else {
    stats::qbeta(seq(1 / n, 1 - 1 / n, length.out = n), shape1, shape2, ncp = ncp, ...)
  }
}


#' @rdname distribution
#' @inheritParams stats::rgamma
#' @importFrom stats rgamma qgamma
#' @export
distribution_gamma <- function(n, shape, scale = 1, random = FALSE, ...) {
  if (random) {
    stats::rgamma(n = n, shape = shape, scale = scale)
  } else {
    stats::qgamma(p = seq(1 / n, 1 - 1 / n, length.out = n), shape = shape, scale = scale)
  }
}


#' @rdname distribution
#' @inheritParams distribution
#' @export
distribution_custom <- function(n, type = "norm", ..., random = FALSE) {
  if (random) {
    f <- match.fun(paste0("r", type))
    f(n, ...)
  } else {
    f <- match.fun(paste0("q", type))
    f(seq(1 / n, 1 - 1 / n, length.out = n), ...)
  }
}



#' @rdname distribution
#' @inheritParams stats::rnorm
#' @importFrom stats rbeta qbeta
#' @export
distribution_mixture_normal <- function(n, mean = c(-3, 3), sd = 1, random = FALSE, ...) {
  n <- round(n / length(mean))
  sd <- c(sd)
  if (length(sd) != length(mean)) {
    sd <- rep(sd, length.out = length(mean))
  }


  x <- c()
  for (i in 1:length(mean)) {
    x <- c(x, distribution_normal(n = n, mean = mean[i], sd = sd[i], random = random))
  }
  x
}




#' @rdname distribution
#' @inheritParams stats::rnorm
#' @importFrom stats qnorm
#' @export
rnorm_perfect <- function(n, mean = 0, sd = 1) {
  .Deprecated("distribution_normal")
  stats::qnorm(seq(1 / n, 1 - 1 / n, length.out = n), mean, sd)
}
back to top