通过R函数“smooth.spline”识别拟合平滑样条曲线的所有局部极值。

Question

我有一个二维数据集。

我使用R＆＃39; smooth.spline函数来平滑我的点图，遵循本文中的示例：

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

这样我得到的曲线图类似于这张图片上的绿线

我想知道X值，其中平滑样条曲线的一阶导数等于零（确定最小值或最大值）。

我的问题是我输入predict()函数的初始数据集（或我可以自动生成的数据集）不包含与平滑样条极值相对应的精确X值。

如何找到这样的X值？

这是上面绿色样条线的一阶导数的图片

但极值的确切X坐标仍然不准确。

我生成图片的近似R脚本如下所示

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')]

Answer 1

我认为这里有两个问题。

1. 您使用的是原始x值，它们间隔太远而且
2. 由于x的间距较宽，因此您认为导数“足够接近”为零的阈值太高。

这基本上是你的代码，但有更多的x值，需要更小的衍生物。由于您没有提供任何数据，因此我对其进行了粗略的近似，足以说明。

## 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)

样条代码

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")



极值看起来很不错。

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



所识别的点看起来像衍生物的零。

Answer 2

您可以使用我的R软件包SplinesUtils：https://github.com/ZheyuanLi/SplinesUtils，该软件包可以通过安装

devtools::install_github("ZheyuanLi/SplinesUtils")

要使用的功能是SmoothSplinesAsPiecePoly和solve。我将只使用文档下的示例。

library(SplinesUtils)

## a toy dataset
set.seed(0)
x <- 1:100 + runif(100, -0.1, 0.1)
y <- poly(x, 9) %*% rnorm(9)
y <- y + rnorm(length(y), 0, 0.2 * sd(y))

## fit a smoothing spline
sm <- smooth.spline(x, y)

## coerce "smooth.spline" object to "PiecePoly" object
oo <- SmoothSplineAsPiecePoly(sm)

## plot the spline
plot(oo)

## find all stationary / saddle points
xs <- solve(oo, deriv = 1)
#[1]  3.791103 15.957159 21.918534 23.034192 25.958486 39.799999 58.627431
#[8] 74.583000 87.049227 96.544430

## predict the "PiecePoly" at stationary / saddle points
ys <- predict(oo, xs)
#[1] -0.92224176  0.38751847  0.09951236  0.10764884  0.05960727  0.52068566
#[7] -0.51029209  0.15989592 -0.36464409  0.63471723
points(xs, ys, pch = 19)

Answer 3

我发现@ G5W实现中的一个警告是它有时会返回多个记录，这些记录靠近极值而不是单个记录。在图表中，它们无法被看到，因为它们都有效地落入了一个点。

来自here的以下代码段过滤掉了具有一阶导数最小值的单个极值点：

library(tidyverse)
df2 <- df  %>%
  group_by(round(y, 4)) %>% 
  filter(abs(d1) == min(abs(d1))) %>% 
  ungroup() %>% 
  select(-5)