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

```#' The Generalized Threshold Distribution
#'
#' @description Compute values for members of the generalized threshold
#'              distribution family. Members include distributions based
#'              on the normal distribution ("nor-gets"), the smallest-
#'              extreme value distribution ("sev-gets"), and the largest-
#'              extreme value distribution ("lev-gets").
#'
#' @param x The x
#' @param p The p
#' @param q The q
#' @param alpha The alpha
#' @param sigma The sigma
#' @param varzeta The varzeta
#' @param distribution The distribution on which the gets values are based
#'                     Either 'normal', 'lev', or 'sev'
#' @param smallsigma The small sigma value
#'
#' @rdname gets
#' @export
dgets <-
function (x,
alpha,
sigma,
varzeta,
distribution,
smallsigma = 2e-05)
{
return(exp(dlgets(x,
alpha,
sigma,
varzeta,
distribution,
smallsigma)))

}

dlgets <-
function (x,
alpha,
sigma,
varzeta,
distribution,
smallsigma = 2e-05)
{

maxlen <- max(length(x),
length(alpha),
length(sigma),
length(varzeta))

x       <- expand.vec(x, maxlen)
alpha   <- expand.vec(alpha, maxlen)
sigma   <- expand.vec(sigma, maxlen)
varzeta <- expand.vec(varzeta, maxlen)

z <- rep(NA, length(x))
locscale <- abs(sigma) < smallsigma

z <- (x - alpha)/varzeta

possigma <- sigma > smallsigma & z > -1/sigma
negsigma <- sigma < -smallsigma & z < -1/sigma
answerzero.right <- sigma > smallsigma & z < -1/sigma
answerzero.left <- sigma < -smallsigma & z > -1/sigma

if (any(!locscale)) {

onepsigz <- 1 + sigma[!locscale] * z[!locscale]
positive.onepsigz <- onepsigz > 0
logonepsigz <- rep(-Inf, length(onepsigz))
logonepsigz[positive.onepsigz] <- logb(onepsigz[positive.onepsigz])
the.arg <- logonepsigz / abs(sigma[!locscale])
logonepsigz - logb(varzeta[!locscale])

}
logb(varzeta[locscale])

}

#' @rdname gets
#' @export

pgets <-
function (q,
alpha,
sigma,
varzeta,
distribution,
smallsigma = 2e-05)

{
maxlen <- max(length(q),
length(alpha),
length(sigma),
length(varzeta))

q       <- expand.vec(q, maxlen)
alpha   <- expand.vec(alpha, maxlen)
sigma   <- expand.vec(sigma, maxlen)
varzeta <- expand.vec(varzeta, maxlen)
z <- rep(NA, length(q))
z <- (q - alpha)/varzeta
locscale <- abs(sigma) < smallsigma
possigma <- sigma > smallsigma & z > -1/sigma
negsigma <- sigma < -smallsigma & z < -1/sigma
answerzero <- sigma > smallsigma & z < -1/sigma
answerone <- sigma < -smallsigma & z > -1/sigma
the.arg <- rep(NA, length(q))
onepsigz <- 1 + sigma[!locscale] * z[!locscale]
positive.onepsigz <- onepsigz > 0
logonepsigz <- rep(-Inf, length(onepsigz))
logonepsigz[positive.onepsigz] <- logb(onepsigz[positive.onepsigz])
the.arg[!locscale] <- logonepsigz/abs(sigma[!locscale])
answer[negsigma] <- 1 - wqmf.phibf(the.arg[negsigma], distribution)

}

#' @rdname gets
#' @export

qgets <-
function (p,
alpha,
sigma,
varzeta,
distribution,
smallsigma = 1e-05)
{

maxlen <- max(length(p),
length(alpha),
length(sigma),
length(varzeta))

p       <- expand.vec(p, maxlen)
alpha   <- expand.vec(alpha, maxlen)
sigma   <- expand.vec(sigma, maxlen)
varzeta <- expand.vec(varzeta, maxlen)
pgood <- p > 0 & p < 1
locscale <- abs(sigma) <= smallsigma & pgood
possigma <- sigma > smallsigma & pgood
negsigma <- sigma < -smallsigma & pgood
distribution)) - 1)/sigma[possigma]
answer[negsigma] <- (exp(abs(sigma[negsigma]) * quant((1 -
p)[negsigma], distribution)) - 1)/sigma[negsigma]
}

#' @rdname gets
#' @export

sgets <-
function (x,
alpha,
sigma,
varzeta,
distribution,
smallsigma = 2e-05)
{

maxlen <- max(length(x),
length(alpha),
length(sigma),
length(varzeta))

x <- expand.vec(x, maxlen)
alpha <- expand.vec(alpha, maxlen)
sigma <- expand.vec(sigma, maxlen)
varzeta <- expand.vec(varzeta, maxlen)
z <- rep(NA, length(x))
locscale <- abs(sigma) < smallsigma
z <- (x - alpha)/varzeta
possigma <- sigma > smallsigma & z > -1/sigma
negsigma <- sigma < -smallsigma & z < -1/sigma
answerzero <- sigma > smallsigma & z < -1/sigma
answerone <- sigma < -smallsigma & z > -1/sigma
the.arg <- rep(NA, length(x))
onepsigz <- 1 + sigma[!locscale] * z[!locscale]
positive.onepsigz <- onepsigz > 0
logonepsigz <- rep(-Inf, length(onepsigz))
logonepsigz[positive.onepsigz] <- logb(onepsigz[positive.onepsigz])
the.arg[!locscale] <- logonepsigz/abs(sigma[!locscale])
answer[possigma] <- 1 - wqmf.phibf(the.arg[possigma], distribution)
answer[locscale] <- 1 - wqmf.phibf(z[locscale], distribution)

}
```

Try the teachingApps package in your browser

Any scripts or data that you put into this service are public.

teachingApps documentation built on July 1, 2020, 5:58 p.m.