# R/distribution-geng.R In teachingApps: Apps for Teaching Statistics, R Programming, and Shiny App Development

```#' The Generalized Gamma Distribution
#'
#' @param x A numeric vector of observations
#' @param q A numeric vector of quantiles
#' @param p A numeric vector of probabilities
#' @param theta The theta parameter
#' @param delta The delta parameter
#' @param varrho The varrho parameter
#' @param smalldelta A numeric shift value
#' @param n The number of random observations
#' @export
#' @rdname Generalized-Gamma
dgeng <-
function (x, theta, delta, varrho)
{
return(exp(dlgeng(x, theta, delta, varrho)))
}

#

dlgeng <-
function (x, theta, delta, varrho)
{
return(dlgengl(logb(x), theta, delta, varrho) - logb(x))
}

dgengl <-
function (y, theta, delta, varrho, smalldelta)
{
return(exp(dlgengl(y, theta, delta, varrho)))
}

#' @importFrom stats dnorm
dlgengl <-
function (y, theta, delta, varrho)
{
logphislg <- function(w, delta, smalldelta = 2e-05) {
lognormal <- abs(delta) < smalldelta
delta.ok <- delta[!lognormal]
w.ok <- w[!lognormal]
answer[!lognormal] <- logb(abs(delta.ok)) + (1/delta.ok^2) *
logb(1/delta.ok^2) - lgamma(1/delta.ok^2) + w.ok/(delta.ok) -
exp(delta.ok * w.ok)/delta.ok^2
}
maxlen <- max(length(y), length(theta), length(delta), length(varrho))
y <- expand.vec(y, maxlen)
theta <- expand.vec(theta, maxlen)
delta <- expand.vec(delta, maxlen)
varrho <- expand.vec(varrho, maxlen)
mu <- logb(theta) + varrho/delta * logb(1/delta^2)
w <- (y - mu)/varrho
answer <- logphislg(w, delta) - logb(varrho)
}

#' @export
#' @rdname Generalized-Gamma

pgeng <-
function (q, theta, delta, varrho)
{
return(pgengl(logb(q), theta, delta, varrho))
}

#' @importFrom stats pnorm
pgengl <-
function (y, theta, delta, varrho)
{
phibgng <- function(w, delta, smalldelta = 0.001) {
lognormal <- abs(delta) < smalldelta
negdelta <- delta < -smalldelta
w.ok <- w[!lognormal]
delta.ok <- delta[!lognormal]
answer[!lognormal] <- pgamma((1/delta.ok^2) * exp(delta.ok *
w.ok), (1/delta.ok^2))
}
maxlen <- max(length(y), length(theta), length(delta),
length(varrho))
y <- expand.vec(y, maxlen)
theta <- expand.vec(theta, maxlen)
delta <- expand.vec(delta, maxlen)
varrho <- expand.vec(varrho, maxlen)
mu <- logb(theta) + varrho/delta * logb(1/delta^2)
w <- (y - mu)/varrho
}

#' @export
#' @rdname Generalized-Gamma

qgeng <-
function (p, theta, delta, varrho, smalldelta = 1e-05)
{
return(exp(qgengl(p, theta, delta, varrho, smalldelta)))
}

#' @importFrom stats qgamma qnorm
qgengl <-
function (p, theta, delta, varrho, smalldelta = 1e-05)
{
maxlen <- max(length(p), length(theta), length(delta),
length(varrho))
p <- expand.vec(p, maxlen)
theta <- expand.vec(theta, maxlen)
delta <- expand.vec(delta, maxlen)
varrho <- expand.vec(varrho, maxlen)
lognormal <- abs(delta) <= smalldelta
posdelta <- delta > smalldelta
negdelta <- delta < -smalldelta
answer[negdelta] <- logb(qgamma(1 - p[negdelta], 1/delta[negdelta]^2)^(1/delta[negdelta]))
}

#' @export
#' @rdname Generalized-Gamma
#' @importFrom stats runif

rgeng <-
function (n, theta, delta, varrho)
{
qgeng(runif(n), theta, delta, varrho)
}

sgeng <-
function (x, theta, delta, varrho, smalldelta = 1e-05)
{
return(sgengl(logb(x), theta, delta, varrho, smalldelta))
}

#' @importFrom stats pgamma pnorm
sgengl <-
function (y, theta, delta, varrho, smalldelta = 1e-05)
{
phiblg <- function(w, delta) {
pgamma(w, (1/delta^2))
}
maxlen <- max(length(y), length(theta), length(delta),
length(varrho))
y <- expand.vec(y, maxlen)
theta <- expand.vec(theta, maxlen)
delta <- expand.vec(delta, maxlen)
varrho <- expand.vec(varrho, maxlen)
w <- rep(NA, length(y))
lognormal <- abs(delta) < smalldelta
mulognormal <- logb(theta[lognormal]) + (varrho[lognormal]/delta[lognormal]) *
logb(1/delta[lognormal]^2)
w <- (delta * (y - logb(theta)))/varrho
posdelta <- delta > smalldelta
answer[posdelta] <- 1 - phiblg(exp(w[posdelta]), delta[posdelta])
negdelta <- delta < -smalldelta