foldsqrtlink {VGAM} | R Documentation

## 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`.

### 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`.

### 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.

### Note

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.

### Author(s)

Thomas W. Yee

### See Also

`Links`.

### Examples

    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)

[Package VGAM version 1.1-1 Index]