Folded Square Root Link Function
Computes the folded square root transformation, including its inverse and the first two derivatives.
foldsqrtlink(theta, min = 0, max = 1, mux = sqrt(2),
inverse = FALSE, deriv = 0, short = TRUE, tag = FALSE)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 |
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.
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.
The default has, if theta is 0 or 1, the link function
value is -sqrt(2) and +sqrt(2) respectively.
These are finite values, therefore one cannot use this link function for
general modelling of probabilities because of numerical problem,
e.g., with binomialff, cumulative. See
the example below.
Thomas W. Yee
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)
## End(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")
## End(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)
## End(Not run)Please choose more modern alternatives, such as Google Chrome or Mozilla Firefox.