如何拟合R中<0的二次模型？

Question

I'm fitting a quadratic model to the diversity of bees along an elevational gradient. I'm supposing there will be a maximum somewhere along the gradient, thus my model should have a negative "a" coefficient. This is working for 3 genera, but with the fourth one ( Exaerete ) the "a" becomes positive. The graph below shows all 4 fits, and we can see that the blue line is the only one "incorrect":

Isolating this genus, we can see clearly why it's "incorrect":

There's a quadratic and a linear model together. The quadratic one makes sense given the data points, but not so much sense biologically. I want to force the command to generate a negative "a" (thus giving an "optimum" altitude probably much lower than the given in the first graph, ie 1193 m), how can I do that? The command in R used to generate the model was

fitEx2 <- lm(num~I(alt^2)+alt,data=Ex)

And the data is

Ex <- data.frame(alt=c(50,52,100,125,130,200,450,500,525,800,890,1140),
                 num=c(3,1,2,1,1,2,1,2,1,1,1,1))

Answer 1

We are dealing with a restricted estimation, which can be conveniently handled with, eg, nls . For instance,

x <- rnorm(100)
y <- rnorm(100) - 0.01 * x^2 + 0.1 * x

nls(y ~ -exp(a) * x^2 + b * x + c, start = list(a = log(0.01), b = 0.1, c = 0))
# Nonlinear regression model
#   model: y ~ -exp(a) * x^2 + b * x + c
#    data: parent.frame()
#        a        b        c 
# -4.66893 -0.03615 -0.01949 
#  residual sum-of-squares: 97.09
# 
# Number of iterations to convergence: 2 
# Achieved convergence tolerance: 3.25e-08

where using exp helps to impose the negativity constraint. Then your desired quadratic term coefficient is

-exp(-4.66893)
[1] -0.009382303

However, it is likely that, since lm estimates a positive coefficient, in your particular case nls will crash by approaching −∞ as to make the coefficient zero.

A more stable approach may be using, eg, optim :

set.seed(2)
x <- rnorm(100)
y <- rnorm(100) - 0.01 * x^2 + 0.1 * x
lm(y ~ x + I(x^2))

# Call:
# lm(formula = y ~ x + I(x^2))

# Coefficients:
# (Intercept)            x       I(x^2)  
#    -0.04359      0.04929      0.04343  

fun <- function(b) sum((y - b[1] * x^2 - b[2] * x - b[3])^2)
optim(c(-0.01, 0.1, 0), fun, method = "L-BFGS-B",
      lower = c(-Inf, -Inf, -Inf), upper = c(0, Inf, Inf))
# $par
# [1] 0.00000000 0.05222262 0.01441276
# 
# $value
# [1] 95.61239
# 
# $counts
# function gradient 
# 7        7 
# 
# $convergence
# [1] 0
# 
# $message
# [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"

which suggests a linear model. In fact, since your model is very simple, most likely that is indeed the theoretical optimum and you may want to rethink your approach. For instance, maybe you can consider some observations as outliers and alter the estimation accordingly?

Answer 2

The Optimization Task View lists several packages that solve least-squares problems, allowing (linear) constraints on the coefficients, for example minpack.lm .

library(minpack.lm)
x <- Ex$alt; y <- Ex$num
nlsLM(y ~ a*x^2 + b*x + c, 
      lower=c(-1, 0, 0), upper=c(0, Inf, Inf), 
      start=list(a=-0.01, b=0.1, c=0))
## Nonlinear regression model
##   model: y ~ a * x^2 + b * x + c
##    data: parent.frame()
##     a     b     c 
## 0.000 0.000 1.522 
##  residual sum-of-squares: 5.051
## 
## Number of iterations to convergence: 27 
## Achieved convergence tolerance: 1.49e-08

By the way, this function is also more reliable than nls and tries to avoid the "zero gradient".
Would be helpful if users will more often take advantage of the many CRAN Task Views.