如何通过R的smooth.spline函数识别拟合平滑样条的局部极值

Got it, let's work through this problem end-to-end. I'll start by helping you generate a reliable synthetic dataset, then walk through fitting the smooth spline, calculating its first derivative, and finding those critical points where the derivative is zero (local minima/maxima).

Step 1: Generate a Synthetic 2D Dataset #

First, let's create a dataset with clear local extrema—this avoids relying on messy real-world data while keeping the problem realistic. We'll use a cubic function plus some Gaussian noise to mimic real data:

# Set random seed for reproducibility
set.seed(123)

# Generate x values spanning a range with clear extrema
x <- seq(0, 6, length.out = 100)

# Generate y values: cubic function with noise (has two critical points)
y <- x^3 - 6*x^2 + 9*x + rnorm(length(x), sd = 0.5)

This dataset will have a local maximum around x=1 and a local minimum around x=3—perfect for testing our workflow.

Step 2: Fit the Smooth Spline #

Now we'll use smooth.spline() to fit the data, just like the example you referenced. We'll plot the raw data and the fitted spline to confirm it looks right:

# Fit the smooth spline (adjust df to control smoothness)
spline_fit <- smooth.spline(x, y, df = 10)

# Plot the results (matches the green curve style you mentioned)
plot(x, y, pch = 16, col = "gray", main = "Smooth Spline Fit & Critical Points")
lines(spline_fit, col = "green", lwd = 2)

Step 3: Calculate the First Derivative of the Spline #

The predict() function for smooth.spline objects lets us compute derivatives directly using the deriv argument. We'll generate a dense set of x points to evaluate the derivative, so we can accurately find where it crosses zero:

# Generate dense x points for precise derivative evaluation
x_dense <- seq(min(x), max(x), length.out = 1000)

# Predict first derivative values at these dense points
deriv1 <- predict(spline_fit, x = x_dense, deriv = 1)$y

Step 4: Find X Values Where Derivative is Zero #

To find the critical points, we need to locate where the first derivative changes sign (since that's where it crosses zero). We'll use the uniroot() function to solve for roots in each interval where the derivative switches from positive to negative (or vice versa):

# Helper function to compute derivative at a single x value
deriv_fun <- function(x_val) {
  predict(spline_fit, x = x_val, deriv = 1)$y
}

# Identify intervals where the derivative changes sign
sign_changes <- which(diff(sign(deriv1)) != 0)

# Extract each interval and solve for the root (critical point)
critical_points <- sapply(sign_changes, function(i) {
  interval <- c(x_dense[i], x_dense[i+1])
  uniroot(deriv_fun, interval = interval)$root
})

# Add critical points to the plot for visualization
points(critical_points, predict(spline_fit, x = critical_points)$y, 
       pch = 19, col = "red", cex = 1.5)
text(critical_points, predict(spline_fit, x = critical_points)$y + 0.3, 
     labels = round(critical_points, 2), col = "red")

Running this code will give you the exact x-values of the local maximum and minimum, marked with red dots on your plot.

Quick Adjustments for Your Own Data: #

• Replace the synthetic x and y vectors with your actual dataset.
• Tweak the df parameter in smooth.spline() to adjust smoothness—higher values mean less smoothing, lower values mean more.
• If your data has more extrema, the code will automatically detect all sign changes in the derivative and solve for each root.

内容的提问来源于stack exchange，提问作者Sergey Shcherbakov