foldsqrtlink | R Documentation |
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 |
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
Links
.
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
## 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)), 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)
## End(Not run)
# This is lucky to converge
fit.h <- vglm(agaaus ~ sm.bs(altitude),
binomialff(foldsqrtlink(mux = 5)),
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(foldsqrtlink(mux = 10), par = TRUE, rev = TRUE),
data = pneumo, trace = TRUE, maxit = 200)
## End(Not run)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.