Searching for a function from this plot

Question

I'm looking for the simplest function that can model this graph:

The source is predicted speed figure by age. I've tried wolfram alpha for polynomial interpolation:

InterpolatingPolynomial[{{2, 45}, {3, 60}, {4, 70}, {5, 70}, {6, 69}, {7, 67}}, x]

And excel trend charts, both being unsatisfactory. Specifically the 'kinks' that come from polynomials. It feels like a composition of log/exponential functions however I'm not familiar with using non-linear regression (attempting to use R).

Log gamma is the closest I've found so far - is there a simpler function that could match?

Answer 1

Try the spline approximation. In maths simple does not always mean good. Splines are excellent, easy to differentiate, integrate and so on.

With Maxima CAS the graph of a cubic spline is

The formula for this spline is

$$ s(x)=\begin{cases} \displaystyle\frac{207}{11}+8\cdot x+\frac{42\cdot {{x}^{2}}}{11}-\frac{7\cdot {{x}^{3}}}{11}&\text{for }x<3\\ \displaystyle\frac{558}{11}-\frac{263\cdot x}{11}+\frac{159\cdot {{x}^{2}}}{11}-\frac{20\cdot {{x}^{3}}}{11}&\text{for }3\le x<4\\ \displaystyle-\frac{2770}{11}+203\cdot x-\frac{465\cdot {{x}^{2}}}{11}+\frac{32\cdot {{x}^{3}}}{11}&\text{for }4\le x<5\\ \displaystyle\frac{2355}{11}-\frac{842\cdot x}{11}+\frac{150\cdot {{x}^{2}}}{11}-\frac{9\cdot {{x}^{3}}}{11}&\text{for }5\le x<6\\ \displaystyle-\frac{453}{11}+\frac{562\cdot x}{11}-\frac{84\cdot {{x}^{2}}}{11}+\frac{4\cdot {{x}^{3}}}{11}&\text{for }x\ge 6 \end{cases} $$

But... polynomial interpolant is also not so bad (dashed red line).

Answer 2

According to the paper you've cited, the graph displays the fit for a four-parameter model consisting of two parabolas joined at their peak. The parameters are the height $H$ of the peak, the leading coefficients $a$, $b$, of the parabolas, and the $x$-value $\delta$ where the parabolas are glued together: $$ f(x)=\begin{cases} H - a(x-\delta)^2&\text{if $x\le\delta$}\\ H - b(x-\delta)^2&\text{if $x>\delta$} \end{cases} $$ Here's an implementation in R. The starting parameter values were obtained by eyeballing the graph.

model <- function(x, H, delta, a, b) {
    ifelse (x < delta, H - a * (x-delta)^2, H - b * (x-delta)^2)
}

x <- c(2, 3, 4, 5, 6, 7)
y <- c(45, 60, 70, 70, 69, 67)

nlsfit <- nls( y ~ model(x, H, delta, a, b), start=list(H=70, delta=5, a=5, b=1) )

plot(x, y, type="p")
xnew <- 0:100/10
lines(xnew, predict(nlsfit, list(x=xnew)))

with result:

Nonlinear regression model
  model: y ~ model(x, H, delta, a, b)
   data: parent.frame()
      H   delta       a       b 
70.3935  4.5882  3.8255  0.5969 
 residual sum-of-squares: 1.606

Number of iterations to convergence: 7 
Achieved convergence tolerance: 9.248e-06

Answer 3

This seems to work - after some parameters