R/leeg_distribution.R

In rdmatheus/leegarma:

#' @name leeg
#'
#' @title The Log-Extended Exponential-Geometric (LEEG) Distribution
#'
#' @description Density, distribution function,
#' quantile function, and random generation for the log-extended
#' explonential-geometric (LEEG) distribution with median \code{mu} and
#' dispersion parameter \code{delta}.
#'
#' @param x,q vector of quantiles.
#' @param p vector of probabilities.
#' @param n number of random values to return.
#' @param mu vector of medians.
#' @param delta vector of dispersion paramere.
#' @param lower.tail logical; if TRUE (default), probabilities are \code{P(X <= x)}, otherwise, \code{P(X > x)}.
#'
#' @return \code{dleeg} returns the probability function, \code{pleeg}
#' gives the distribution function, \code{qleeg} gives the quantile function,
#' and \code{rleeg} generates random observations.
#'
#' @details The LEEG distribution was proposed by Jodrá and Jiménez-Gameiro (2017).
#' This set of functions represents the density function, the cumulative distribution
#' function, quantile function and a random number generator for the LEEG distribution
#' parameterized in terms of its median and a dispersion parameter.
#'
##' Let X be a bounded random variable following a LEEG distribution
##' with median \code{mu} and dispersion parameter \code{delta}. The
##' density function of X is
#'
#'
#' @author Diego R. Canterle
#' @author Rodrigo M. R. Medeiros <\email{rodrigo.matheus@live.com}>
#'
#' @examples
#'
#' ### Density ###
#'
#' curve(dleeg(x, 0.15, 1), col = 2)
#' curve(dleeg(x, 0.12, 1.5), col = 3, add = TRUE)
#' curve(dleeg(x, 0.45, 4), col = 4, add = TRUE)
#' curve(dleeg(x, 0.5, 1), col = 1, add = TRUE)
#' curve(dleeg(x, 0.85, 15), col = 5, add = TRUE)
#' curve(dleeg(x, 0.9, 15), col = 6, add = TRUE)
#' curve(dleeg(x, 0.86, 1.25), col = 7, add = TRUE)
#'
NULL

#' @rdname leeg
#' @export
dleeg <- function(x, mu, delta){
  if (any(delta <= 0))
    stop("The dispersion parameter must be positive")
  if (any((mu <= 0) | (mu >= 1)))
    stop("The median parameter must be in the unit interval (0, 1)")

  d <- (delta * mu^(delta) * (1 - mu^delta) * x^(delta - 1)) /
       ((mu^delta + (1 - 2 * (mu^delta)) * x^delta)^2)

  return(d)
}

#' @rdname leeg
#' @export
pleeg <- function(q, mu, delta, lower.tail = TRUE){
  if (any(delta <= 0))
    stop("The dispersion parameter must be positive")
  if (any((mu <= 0) | (mu >= 1)))
    stop("The median parameter must be in the unit interval (0, 1)")


  prob <- rep(0, length(q))
  index <- which((0 < q) & (q < 1))

  ifelse(length(q) > 1, q <- q[index], q <- q)
  ifelse(length(mu) > 1, mu <- mu[index], mu <- mu)

  prob[index] <- ((1 - mu^delta) * q^delta) /
       (mu^delta + (1 - 2 * (mu^delta)) * q^delta)

  if (lower.tail == FALSE)
    prob[index] <- 1 - prob[index]

  return(prob)
}

#' @rdname leeg
#' @export
qleeg <- function(p, mu, delta, lower.tail = TRUE){
  if ((any(p < 0)) || (any(p > 1)))
    stop("p must be in the unit interval: (0, 1)")
  if (any(delta <= 0))
    stop("The dispersion parameter must be positive")
  if (any((mu <= 0) | (mu >= 1)))
    stop("The median parameter must be in the unit interval (0, 1)")

  if(lower.tail == FALSE)
    p <- 1 - p

  quanti <- mu * (p / (mu^delta + (1 - 2 * mu^delta) * (1-p)))^(1/delta)

  return(quanti)
}

#' @rdname leeg
#' @export
rleeg <- function(n, mu, delta){
  if (any(delta <= 0))
    stop("The dispersion parameter must be positive")
  if (any((mu <= 0) | (mu >= 1)))
    stop("The median parameter must be in the unit interval (0, 1)")

  u <- stats::runif(n)

  return(qleeg(u, mu, delta))
}