Search code examples
rsplinesmoothing

Identify all local extrema of a fitted smoothing spline via R function 'smooth.spline'


I have a 2-dimensional data set.

I use the R's smooth.spline function to smooth my points graph following an example in this article:

https://stat.ethz.ch/R-manual/R-devel/library/stats/html/predict.smooth.spline.html

So that I get the spline graph similar to the green line on this picture

enter image description here

I'd like to know the X values, where the first derivative of the smoothing spline equals zero (to determine exact minimum or maximum).

My problem is that my initial dataset (or a dataset that I could auto-generate) to feed into the predict() function does not contain such exact X values that correspond to the smoothing spline extrema.

How can I find such X values?

Here is the picture of the first derivative of the green spline line above

enter image description here

But exact X coordinate of extremums are still not exact.

My approximate R script to generate the pictures looks like the following

sp1 <- smooth.spline(df)

pred.prime <- predict(sp1, deriv=1)
pred.second <- predict(sp1, deriv=2)

d1 <- data.frame(pred.prime)
d2 <- data.frame(pred.second)

dfMinimums <- d1[abs(d1$y) < 1e-4, c('x','y')]

Solution

  • I think that there are two problems here.

    1. You are using the original x-values and they are spaced too far apart AND
    2. Because of the wide spacing of the x's, your threshold for where you consider the derivative "close enough" to zero is too high.

    Here is basically your code but with many more x values and requiring smaller derivatives. Since you do not provide any data, I made a coarse approximation to it that should suffice for illustration.

    ## Coarse approximation of your data
    x = runif(300, 0,45000)
    y = sin(x/5000) + sin(x/950)/4 + rnorm(300, 0,0.05) 
    df = data.frame(x,y)
    sp1 <- smooth.spline(df)
    

    Spline code

    Sx = seq(0,45000,10)
    pred.spline <- predict(sp1, Sx)
    d0 <- data.frame(pred.spline)
    pred.prime <- predict(sp1, Sx, deriv=1)
    d1 <- data.frame(pred.prime)
    
    Mins = which(abs(d1$y) < mean(abs(d1$y))/150)
    
    plot(df, pch=20, col="navy")
    lines(sp1, col="darkgreen")
    points(d0[Mins,], pch=20, col="red")
    

    Extrema

    The extrema look pretty good.

    plot(d1, type="l")
    points(d1[Mins,], pch=20, col="red")
    

    Derivative

    The points identified look like zeros of the derivative.