foldsqrtlink.RdComputes the square root and folded square root transformations, including their inverse and their first two derivatives.
Numeric or character. See below for further details.
These are called \(L\), \(U\) and \(K\) below.
Details at Links.
Numeric, 2-vector c(c1, c0)
for a linear transformation.
The plain link is multiplied by c1
and then c0 is added so that c1 = 1:0 is
simply sqrt.
The default is intended to match
lcsloglink for poissonff
at lambda (theta) equal to 1.
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.
More general information
can be found at alogitlink.
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 sqrtlink with deriv = 0
and c10 = 1:0:
\(\sqrt{\theta}\)
when inverse = FALSE,
and if inverse = TRUE then the square
is returned.
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.
For foldsqrtlink,
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.
p <- seq(0.01, 0.99, by = 0.01)
foldsqrtlink(p)
#> [1] -1.26570337 -1.20000000 -1.14788985 -1.10279793 -1.06217711 -1.02472076
#> [7] -0.98965243 -0.95646600 -0.92480969 -0.89442719 -0.86512483 -0.83675197
#> [13] -0.80918864 -0.78233744 -0.75611792 -0.73046271 -0.70531468 -0.68062485
#> [19] -0.65635081 -0.63245553 -0.60890644 -0.58567464 -0.56273437 -0.54006248
#> [25] -0.51763809 -0.49544225 -0.47345767 -0.45166852 -0.43006022 -0.40861929
#> [31] -0.38733323 -0.36619038 -0.34517985 -0.32429140 -0.30351540 -0.28284271
#> [37] -0.26226469 -0.24177308 -0.22136002 -0.20101792 -0.18073954 -0.16051782
#> [43] -0.14034598 -0.12021737 -0.10012555 -0.08006418 -0.06002704 -0.04000801
#> [49] -0.02000100 0.00000000 0.02000100 0.04000801 0.06002704 0.08006418
#> [55] 0.10012555 0.12021737 0.14034598 0.16051782 0.18073954 0.20101792
#> [61] 0.22136002 0.24177308 0.26226469 0.28284271 0.30351540 0.32429140
#> [67] 0.34517985 0.36619038 0.38733323 0.40861929 0.43006022 0.45166852
#> [73] 0.47345767 0.49544225 0.51763809 0.54006248 0.56273437 0.58567464
#> [79] 0.60890644 0.63245553 0.65635081 0.68062485 0.70531468 0.73046271
#> [85] 0.75611792 0.78233744 0.80918864 0.83675197 0.86512483 0.89442719
#> [91] 0.92480969 0.95646600 0.98965243 1.02472076 1.06217711 1.10279793
#> [97] 1.14788985 1.20000000 1.26570337
max(abs(foldsqrtlink(foldsqrtlink(p), inverse = TRUE) - p)) # 0
#> [1] 1.110223e-16
p <- c(seq(-0.02, 0.02, by = 0.01), seq(0.97, 1.02, by = 0.01))
foldsqrtlink(p) # Has NAs
#> [1] NaN NaN -1.414214 -1.265703 -1.200000 1.147890 1.200000
#> [8] 1.265703 1.414214 NaN NaN
if (FALSE) { # \dontrun{
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)),
col = "blue", ylab = "transformation",
main = ifelse(d == 0, "Some probability links",
"First derivative"), type = "n", las = 1)
lines(p, logitlink(p, deriv = d), col = "green")
lines(p, probitlink(p, deriv = d), col = "blue")
lines(p, clogloglink(p, deriv = d), col = "red")
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("green", "blue",
"red", "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 = "blue", 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="green")
lines(y, probitlink(y, deriv=d, inverse=TRUE), col="blue")
lines(y, clogloglink(y, deriv=d, inverse=TRUE), col="red")
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("green", "blue", "red", "tan"))
}
}
par(lwd = 1)
} # }
# This is lucky to converge
fit.h <- vglm(agaaus ~ sm.bs(altitude),
binomialff("foldsqrtlink(mux = 5)"),
hunua, trace = TRUE)
#> Iteration 1: deviance = 390.01966
#> Iteration 2: deviance = 388.89021
#> Iteration 3: deviance = 388.78756
#> Iteration 4: deviance = 388.77251
#> Iteration 5: deviance = 388.76941
#> Iteration 6: deviance = 388.76865
#> Iteration 7: deviance = 388.76845
#> Iteration 8: deviance = 388.76839
#> Iteration 9: deviance = 388.76838
#> Iteration 10: deviance = 388.76837
#> Iteration 11: deviance = 388.76837
if (FALSE) { # \dontrun{
plotvgam(fit.h, se = TRUE, lcol = "orange", scol = "orange",
main = "Orange is Hunua, Blue is Waitakere") } # }
head(predict(fit.h, hunua, type = "response"))
#> [1] 0.2205809 0.2033924 0.1429702 0.1206420 0.1206420 0.1429702
if (FALSE) { # \dontrun{
# 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) } # }