# SSfpl

0th

Percentile

##### Self-Starting Nls Four-Parameter Logistic Model

This selfStart model evaluates the four-parameter logistic function and its gradient. It has an initial attribute computing initial estimates of the parameters A, B, xmid, and scal for a given set of data.

Keywords
models
##### Usage
SSfpl(input, A, B, xmid, scal)
##### Arguments
input

a numeric vector of values at which to evaluate the model.

A

a numeric parameter representing the horizontal asymptote on the left side (very small values of input).

B

a numeric parameter representing the horizontal asymptote on the right side (very large values of input).

xmid

a numeric parameter representing the input value at the inflection point of the curve. The value of SSfpl will be midway between A and B at xmid.

scal

a numeric scale parameter on the input axis.

##### Value

a numeric vector of the same length as input. It is the value of the expression A+(B-A)/(1+exp((xmid-input)/scal)). If all of the arguments A, B, xmid, and scal are names of objects, the gradient matrix with respect to these names is attached as an attribute named gradient.

nls, selfStart
library(stats) # NOT RUN { Chick.1 <- ChickWeight[ChickWeight$Chick == 1, ] SSfpl(Chick.1$Time, 13, 368, 14, 6) # response only local({ A <- 13; B <- 368; xmid <- 14; scal <- 6 SSfpl(Chick.1\$Time, A, B, xmid, scal) # response _and_ gradient }) print(getInitial(weight ~ SSfpl(Time, A, B, xmid, scal), data = Chick.1), digits = 5) ## Initial values are in fact the converged values fm1 <- nls(weight ~ SSfpl(Time, A, B, xmid, scal), data = Chick.1) summary(fm1) ## Visualizing the SSfpl() parametrization xx <- seq(-0.5, 5, len = 101) yy <- 1 + 4 / (1 + exp((2-xx))) # == SSfpl(xx, *) : stopifnot( all.equal(yy, SSfpl(xx, A = 1, B = 5, xmid = 2, scal = 1)) ) require(graphics) op <- par(mar = c(0, 0, 3.5, 0)) plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5), xlab = "", ylab = "", lwd = 2, main = "Parameters in the SSfpl model") mtext(quote(list(phi == "A", phi == "B", phi == "xmid", phi == "scal"))) usr <- par("usr") arrows(usr, 0, usr, 0, length = 0.1, angle = 25) arrows(0, usr, 0, usr, length = 0.1, angle = 25) text(usr - 0.2, 0.1, "x", adj = c(1, 0)) text( -0.1, usr, "y", adj = c(1, 1)) abline(h = c(1, 5), lty = 3) arrows(-0.8, c(2.1, 2.9), -0.8, c(0, 5 ), length = 0.1, angle = 25) text (-0.8, 2.5, quote(phi)) arrows(-0.3, c(1/4, 3/4), -0.3, c(0, 1 ), length = 0.07, angle = 25) text (-0.3, 0.5, quote(phi)) text(2, -.1, quote(phi)) segments(c(2,3,3), c(0,3,4), # SSfpl(x = xmid = 2) = 3 c(2,3,2), c(3,4,3), lty = 2, lwd = 0.75) arrows(c(2.3, 2.7), 3, c(2.0, 3 ), 3, length = 0.08, angle = 25) text( 2.5, 3, quote(phi)); text(3.1, 3.5, "1") par(op) # }