VGAM (version 1.1-8)

foldsqrtlink: Folded Square Root Link Function

Description

Computes the folded square root transformation, including its inverse and the first two derivatives.

Usage

foldsqrtlink(theta, min = 0, max = 1, mux = sqrt(2),
     inverse = FALSE, deriv = 0, short = TRUE, tag = FALSE)

Value

For foldsqrtlink with deriv = 0:

\(K (\sqrt{\theta-L} - \sqrt{U-\theta})\)

or

mux * (sqrt(theta-min) - sqrt(max-theta))

when inverse = FALSE, and if inverse = TRUE then some more complicated function that returns a NA unless

theta is between -mux*sqrt(max-min) and

mux*sqrt(max-min).

For deriv = 1, then the function returns

d

eta / d

theta as a function of theta

if inverse = FALSE, else if inverse = TRUE then it returns the reciprocal.

Arguments

theta

Numeric or character. See below for further details.

min, max, mux

These are called \(L\), \(U\) and \(K\) below.

inverse, deriv, short, tag

Details at Links.

Author

Thomas W. Yee

Details

The folded square root link function can be applied to parameters that lie between \(L\) and \(U\) inclusive. Numerical values of theta out of range result in NA or NaN.

See Also

Links.

Examples

p <- seq(0.01, 0.99, by = 0.01)
foldsqrtlink(p)
max(abs(foldsqrtlink(foldsqrtlink(p), inverse = TRUE) - p))  # 0

p <- c(seq(-0.02, 0.02, by = 0.01), seq(0.97, 1.02, by = 0.01))
foldsqrtlink(p)  # Has NAs

if (FALSE) {
p <- seq(0.01, 0.99, by = 0.01)
par(mfrow = c(2, 2), lwd = (mylwd <- 2))
y <- seq(-4, 4, length = 100)
for (d in 0:1) {
  matplot(p, cbind(logitlink(p, deriv = d),
                foldsqrtlink(p, deriv = d)), las = 1,
          type = "n", col = "purple", ylab = "transformation",
          main = if (d == 0) "Some probability link functions"
          else "First derivative")
  lines(p, logitlink(p, deriv = d), col = "limegreen")
  lines(p, probitlink(p, deriv = d), col = "purple")
  lines(p, clogloglink(p, deriv = d), col = "chocolate")
  lines(p, foldsqrtlink(p, deriv = d), col = "tan")
  if (d == 0) {
    abline(v = 0.5, h = 0, lty = "dashed")
    legend(0, 4.5, c("logitlink", "probitlink",
                     "clogloglink", "foldsqrtlink"),
           lwd = 2, col = c("limegreen", "purple",
                            "chocolate", "tan"))
  } else
    abline(v = 0.5, lty = "dashed")
}

for (d in 0) {
  matplot(y, cbind(logitlink(y, deriv = d, inverse = TRUE),
                   foldsqrtlink(y, deriv = d, inverse = TRUE)),
          type = "n", col = "purple", xlab = "transformation",
          ylab = "p", lwd = 2, las = 1, main = if (d == 0)
          "Some inverse probability link functions" else
          "First derivative")
  lines(y, logitlink(y, deriv=d, inverse=TRUE), col = "limegreen")
  lines(y, probitlink(y, deriv=d, inverse=TRUE), col = "purple")
  lines(y, clogloglink(y, deriv=d, inverse=TRUE), col = "chocolate")
  lines(y, foldsqrtlink(y, deriv=d, inverse = TRUE), col = "tan")
  if (d == 0) {
    abline(h = 0.5, v = 0, lty = "dashed")
    legend(-4, 1, c("logitlink", "probitlink",
                    "clogloglink", "foldsqrtlink"), lwd = 2, 
           col = c("limegreen", "purple", "chocolate", "tan"))
  }
}
par(lwd = 1)
}

# This is lucky to converge
fit.h <- vglm(agaaus ~ sm.bs(altitude),
              binomialff(foldsqrtlink(mux = 5)),
              hunua, trace = TRUE)
if (FALSE) {
plotvgam(fit.h, se = TRUE, lcol = "orange", scol = "orange",
         main = "Orange is Hunua, Blue is Waitakere") }
head(predict(fit.h, hunua, type = "response"))

if (FALSE) {
# The following fails.
pneumo <- transform(pneumo, let = log(exposure.time))
fit <- vglm(cbind(normal, mild, severe) ~ let,
       cumulative(foldsqrtlink(mux = 10), par = TRUE, rev = TRUE),
       data = pneumo, trace = TRUE, maxit = 200) }