VGAM (version 1.1-4)

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)

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.

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.

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

# NOT RUN {
p <- seq(0.01, 0.99, by = 0.01)
foldsqrtlink(p)
max(abs(foldsqrtlink(foldsqrtlink(p), inverse = TRUE) - p))  # Should be 0

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

# }
# NOT RUN {
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)),
          type = "n", col = "purple", ylab = "transformation", las = 1,
          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)
# }
# NOT RUN {
# This is lucky to converge
fit.h <- vglm(agaaus ~ sm.bs(altitude), binomialff(link = foldsqrtlink(mux = 5)),
              data = hunua, trace = TRUE)
# }
# NOT RUN {
plotvgam(fit.h, se = TRUE, lcol = "orange", scol = "orange",
         main = "Orange is Hunua, Blue is Waitakere") 
# }
# NOT RUN {
head(predict(fit.h, hunua, type = "response"))


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