如何将样条曲线拟合到包含值和一阶/二阶导数的数据?


14

我有一个数据集,其中包含一些位置,速度和加速度的测量值。全部来自同一“运行”。我可以构造一个线性系统,并将多项式拟合所有这些度量。

但是我可以用样条线做同样的事情吗?这样做的“ R”方式是什么?

这是一些我想拟合的模拟数据:

f <- function(x) 2+x-0.5*x^2+rnorm(length(x), mean=0, sd=0.1)
df <- function(x) 1-x+rnorm(length(x), mean=0, sd=0.3)
ddf <- function(x) -1+rnorm(length(x), mean=0, sd=0.6)

x_f <- runif(5, 0, 5)
x_df <- runif(8, 3, 8)
x_ddf <- runif(10, 4, 9)

data <- data.frame(type=rep('f'), x=x_f, y=f(x_f))
data <- rbind(data, data.frame(type=rep('df'), x=x_df, y=df(x_df)))
data <- rbind(data, data.frame(type=rep('ddf'), x=x_ddf, y=ddf(x_ddf)))

library(ggplot2)
ggplot(data, aes(x, y, color=type)) + geom_point()


library(splines)
m <- lm(data$y ~ bs(data$x, degree=6)) # but I want to fit on f, df, ddf. possible?

在此处输入图片说明


我不知道您问题的答案,但splinefun可以计算导数,想必您可以以此为起点,使用某些反方法拟合数据?我有兴趣学习解决方案。
David LeBauer

1
莫里斯·考克斯(Maurice Cox)在1972年的论文中解决了这个问题。我不知道R是否支持,但是搜索词是“ Hermite splines”。
user14717

@DavidLeBauer,这就是我目前正在做的事情。我正式确定了适合多个点的优化问题,以使样条曲线及其派生词近似数据。但是,更直接的方法会很棒。
丹妮

3
一个相当标准的方法是通过卡尔曼滤波。(不可观察)状态包含精确的导数,并且观察值是这些值的嘈杂形式。例如,三次样条曲线的模型大致表明二阶导数是(连续时间)白噪声,但是也可以使用更高阶的模型。您将不得不根据当前观测值的推导顺序来描述测量噪声。在第一种方法中,三个噪声方差(待估计)就足够了。
伊夫(Yves)

2
导数的测量误差是什么?比位置高得多吗?在您的情节中,为什么还不能将arent点对齐?x轴是什么?
阿克萨卡尔州

Answers:


9

我们将描述如何通过卡尔曼滤波(KF)技术将样条线与状态空间模型(SSM)结合使用。CF Ansley和R. Kohn在1980-1990年间揭示了一些样条模型可以用SSM表示并可以用KF计算的事实。估计函数及其导数是该状态在观察条件下的期望。通过使用固定间隔平滑来计算这些估计,这是使用SSM时的常规任务。

为了简单起见,假设观测有时由并且该观测数在 只涉及一个与阶导数在 。模型的观察部分写为 ,其中表示未观察到的函数, 是一个高斯误差,取决于推导阶数,其方差为。(连续时间)过渡方程采用一般形式 t1<t2<<tnktkd k { 0 dk{0,1,2}

(O1)y(tk)=f[dk](tk)+ε(tk)
f(t)ε t kH t kd kε(tk)H(tk)dk
(T1)ddtα(t)=Aα(t)+η(t)
αηQεķα=[˚F ,其中是未观察到的状态向量, 是具有协方差的高斯白噪声,假定与观察噪声r.vs。为了描述样条,我们考虑通过堆叠 一阶导数获得的状态,即 。过渡是 α(t)η(t)Qε(tk)mα(t):=[f(t),f[1](t),,f[m1](t)]
[f[1](t)f[2](t)f[m1](t)f[m](t)]=[010001100][f(t)f[1](t)f[m2](t)f[m1](t)]+[000η(t)]
22-1m=2>1 y t k ,然后得到阶数为阶数为)的多项式样条。虽然对应于通常的三次样条,2m2m1m=2>1。为了坚持经典的SSM形式主义,我们可以将(O1)重写为 其中观测矩阵挑选在合适的衍生物和方差的 取决于被选择。因此其中, 和。同样,
(O2)y(tk)=Z(tk)α(tk)+ε(tk),
Z(tk)α(tk)H(tk)ε(tk)dkZ(tk)=Zdk+1Z1:=[1,0,,0]Z2:=[0,1,0]Z3:=[0,0,1,0,]H(tk)=Hdk+1 ħ 1 ħ 2 ħ 3对于三个方差, 和。 H1H2H3

尽管过渡是连续时间,但KF实际上是标准的离散时间。确实,我们将在实践中将重点放在我们有观察或想要估计导数的时间上。我们可以将集合作为这两组时间的并集,并假设处的观测可能会丢失:这允许在任何时间估计导数, 而与观测值的存在无关。仍然需要导出离散SSM。t{tk}tkmtk

我们将使用指数的离散时间,写为 等。离散时间SSM的格式为 其中矩阵和来自(T1)和(O2),而的方差由 假设αkα(tk)

(DT)αk+1=Tkαk+ηkyk=Zkαk+εk
TkQk:=Var(ηk)εkHk=Hdk+1ykŤķ=EXP{δķ}=[ 1 δ 1 ķ不失踪。使用一些代数,我们可以找到离散时间SSM的过渡矩阵 其中对于。类似地,离散时间SSM 的协方差矩阵可以表示为
Tk=exp{δkA}=[1δk11!δk22!δkm1(m1)!01δk11!δk11!01],

δk:=tk+1tkk<nQk=Var(ηk)
Qk=ση2[δk2mij+1(mi)!(mj)!(2mij+1)]i,j
,其中索引和在和之间。ij1m

现在要进行R中的计算,我们需要一个专用于KF并接受时变模型的软件包。CRAN软件包KFAS似乎是一个不错的选择。我们可以编写R函数来从时间的向量计算矩阵 和 以便对SSM(DT)进行编码。在软件包使用的符号中,矩阵乘以(DT)转换方程中的噪声 :在这里,我们将其视为恒等。另请注意,此处必须使用扩散初始协方差。TkQktkRkηkIm

编辑最初编写的是错误的。已修复(R代码和图像中也是如此)。Q

CF安斯利和R.科恩(1986)“关于两种随机方法的样条平滑的等效性”,J.Appl。Probab。,第23页,第391–405页

R. Kohn和CF Ansley(1987),“基于平滑随机过程的样条平滑的新算法”,SIAM J. Sci。和统计。计算 ,8(1),第33-48页

J.赫尔斯克(2017)。“ KFAS:R中的指数族状态空间模型”,J。Stat 。柔软的。,78(10),1-39页

用导数平滑

smoothWithDer <- function(t, y, d, m = 3,
                          Hstar = c(3, 0.2, 0.1)^2, sigma2eta = 1.0^2) {

    ## define the SSM matrices, depending on 'delta_k' or on 'd_k'
    Tfun <- function(delta) {
        mat <-  matrix(0, nrow = m, ncol = m)
        for (i in 0:(m-1)) {
            mat[col(mat) == row(mat) + i] <- delta^i / gamma(i + 1)
        }
        mat
    }
    Qfun <- function(delta) {
        im <- (m - 1):0
        x <- delta^im / gamma(im + 1)
        mat <- outer(X = x, Y = x, FUN = "*")
        im2 <- outer(im, im, FUN = "+")
        sigma2eta * mat * delta / (im2 + 1) 
    }
    Zfun <-  function(d) {
        Z <- matrix(0.0, nrow = 1, ncol = m)
        Z[1, d + 1] <- 1.0
        Z
    }
    Hfun <- function(d) ifelse(d >= 0, Hstar[d + 1], 0.0)
    Rfun <- function() diag(x = 1.0, nrow = m)

    ## define arrays by stacking the SSM matrices. We need one more
    ## 'delta' at the end of the series
    n <- length(t)
    delta <-  diff(t)
    delta <- c(delta, mean(delta))

    Ta <- Qa <- array(0.0, dim = c(m, m, n))
    Za <- array(0.0, dim = c(1, m, n))
    Ha <- array(0.0, dim = c(1, 1, n))
    Ra <-  array(0.0, dim = c(m, m, n))

    for (k in 1:n) {
        Ta[ , , k] <- Tfun(delta[k])
        Qa[ , , k] <- Qfun(delta[k])
        Za[ , , k] <- Zfun(d[k])
        Ha[ , , k] <- Hfun(d[k])
        Ra[ , , k] <- Rfun()
    }

    require(KFAS)
    ## define the SSM and perform Kalman Filtering and smoothing
    mod <- SSModel(y ~ SSMcustom(Z = Za, T = Ta, R = Ra, Q = Qa, n = n,
                                 P1 = matrix(0, nrow = m, ncol = m),
                                 P1inf = diag(1.0, nrow = m), 
                                 state_names = paste0("d", 0:(m-1))) - 1)
    out <- KFS(mod, smoothing = "state")
    list(t = t, filtered = out$att, smoothed = out$alphahat)

}

## An example function as in OP
f <- function(t, d = rep(0, length = length(t))) {
    f <- rep(NA, length(t))
    if (any(ind <- (d == 0))) f[ind] <- 2.0 + t[ind] - 0.5 * t[ind]^2
    if (any(ind <- (d == 1))) f[ind] <- 1.0 - t[ind]
    if (any(ind <- (d == 2))) f[ind] <- -1.0
    f
}

set.seed(123)
n <-  100
t <- seq(from = 0, to = 10, length = n)
Hstar <- c(3, 0.4, 0.2)^2
sigma2eta <- 1.0

fTrue <- cbind(d0 = f(t), d1 = f(t, d = 1), d2 = f(t, d = 2))

## ============================================================================
## use a derivative index of -1 to indicate non-observed values, where
## 'y' will be NA
##
## [RUN #0]  no derivative  m = 2 (cubic spline)
## ============================================================================
d0 <- sample(c(-1, 0), size = n, replace = TRUE, prob = c(0.7, 0.3))
ft0 <-  f(t, d0)
## add noise picking the right sd
y0 <- ft0 + rnorm(n = n, sd = c(0.0, sqrt(Hstar))[d0 + 2])
res0 <- smoothWithDer(t, y0, d0, m = 2, Hstar = Hstar)

## ============================================================================
## [RUN #1] Only first order derivative: we can take m = 2 (cubic spline)
## ============================================================================
d1 <- sample(c(-1, 0:1), size = n, replace = TRUE, prob = c(0.7, 0.15, 0.15))
ft1 <-  f(t, d1)
y1 <- ft1 + rnorm(n = n, sd = c(0.0, sqrt(Hstar))[d1 + 2])
res1 <- smoothWithDer(t, y1, d1, m = 2, Hstar = Hstar)

## ============================================================================
## [RUN #2] First and second order derivative: we can take m = 3
## (quintic spline)
## ============================================================================
d2 <- sample(c(-1, 0:2), size = n, replace = TRUE, prob = c(0.7, 0.1, 0.1, 0.1))
ft2 <-  f(t, d2)
y2 <- ft2 + rnorm(n = n, sd = c(0.0, sqrt(Hstar))[d2 + 2])
res2 <- smoothWithDer(t, y2, d2, m = 3, Hstar = Hstar)

## plots : a ggplot with facets would be better here.
for (run in 0:2) {
    resrun <- get(paste0("res", run))
    drun <- get(paste0("d", run))
    yrun <- get(paste0("y", run))
    matplot(t, resrun$smoothed, pch = 16, cex = 0.7, ylab = "", xlab = "")
    matlines(t, fTrue, lwd = 2, lty = 1)
    for (dv in 0:2) {
        points(t[drun == dv], yrun[drun == dv], cex = 1.2, pch = 22, lwd = 2,
               bg = "white", col = dv + 1)
    }
    title(main = sprintf("run %d. Dots = smooothed, lines = true, square = obs", run))
    legend("bottomleft", col = 1:3, legend = c("d0", "d1", "d2"), lty = 1)
}

谢谢您的回答。我对此很感兴趣。目前,您不允许f在某些情况下使用的值及其衍生物t。如何使用所有信息?再次,谢谢您的回答。
丹妮

我的理解是,低于T1的所有内容都是关于在同一推理过程中使用多个导数的。伊夫可以证实。
eric_kernfeld,

确实,您可以 对一个使用导数:观察是一个向量,而 有行选择所需的导数。我相信,一个共同的的作品与KFAS,但通过使用NAS有可能有一个时间变化为好。ok>1tkykZkoko>1o
伊夫(Yves)

@Yves我是否正确理解您的意思:如果我在t_k点处具有一阶和二阶导数,则Z_k如下所示:matrix(c(0,0,0, 0,1,0, 0,0,1), nrow=length(d_k), ncol=m, byrow = T)。因此,总的来说,这将是一个尺寸为“最高导数” *“样条度” *“时间步数”的多维数据集
dani

是@dani,几乎:行的所有的数量矩阵是即中的示例。这是最高的导数阶加一。而且,样条曲线的度为,而不是。在您的示例中,由于您未观察到阶数(函数本身)的导数,因此应在观察值中将其设置为,也可以删除第一行。但是,我怀疑在这种特定情况下,问题是不适当地发生的,因此SSM可能无法观察到Zkmaxk{dk+1}32m1m0NA
伊夫,

5

只要您对每个导数产生的随机误差的相对大小有一个合理的了解,就可以使用标准的最小二乘例程很好地完成出色的工作。对每个值进行测量的次数没有限制-您甚至可以同时测量每个值的不同导数。使用普通最小二乘(OLS)的唯一限制是通常的做法:您假设测量是独立的。x

通过抽象问题可以最清楚地表达基本思想。 您的模型使用一组函数(例如任何样条线基础)作为预测值点上的未知函数 这意味着您试图估计每个线性组合可接受的系数 我们称此为线性组合(向量)空间pfj:RR, j=1,2,,pyi=f(xi)f(x1,x2,,xn).βjjβjfj(xi)yi.F.

这个问题的特殊之处在于您不必观察yi. 而是有一组与数据关联的线性函数 。回想一下,函数是“函数的函数:”每个 为 的任何函数分配一个数字LiLiLi[f]fF.

(1)yi=Li[f]+σiεi

其中被赋予功能,是已知的比例因子,而是独立且分布均匀的随机变量。Liσi>0εi

另外两个假设使OLS适用并在统计上有意义:

  1. 的公共分布具有有限的方差。εi

  2. 每个都是线性函数。功能性是线性时的任何元件和相应的数字LiLfjFαj,

    L[jαjfj]=jαjL[fj].

(2)允许将模型更明确地表示为(1)

yi=β1Li[f1]++βpLi[fp]+σiεi.

减少的全部意义在于,因为您已经规定了所有函数所有基本函数和标准偏差所以值都是数字 - -这些只是回归问题的通常“变量”或“特征”-只是(相对)权重。因此,就高斯-马尔可夫定理的最佳意义而言,OLS是一个很好的使用程序。Li,fj,σi,Li[fj]σi

该问题涉及的功能如下:

  • 在指定点评估 这就是我们通常要做的。这是线性的,因为根据定义,函数的线性组合是逐点求值的。fx: L[f]=f(x).

  • 在指定点求导数 这是线性的,因为微分是线性的。fx: L[f]=f(x).

  • 在指定点评估二阶导数fx: L[f]=f(x).


好的,这种方法效果如何? 像往常一样,我们将比较残差和拟合值与观测值。由于位置,速度和加速度都位于不同的单位中,因此应将它们绘制在单独的轴上。y^iyiy^i

数字

第一行使用曲线绘制及其前两个导数。在曲线上绘制了相关的数据点:左侧的观测值,中间的观测导数,右侧的第二导数。y^

底行绘制了相应的残差。像往常一样,我们正在寻找缺乏任何可观的关系:我们希望残差值(其y坐标)从左到右随机变化,以显示独立性且没有趋势。

在的数据值生成完全一样的问题(使用随机数种子设置为17后用于再现性)。我也使用了由函数生成的B样条空间拟合,同样也针对问题,是度1到6。该图显示了度2的结果,这是最低的度(即最简单的模型)表现出较低的AIC和良好的残留行为,以及所有六个(嵌套)模型的ANOVA表示的模型。n=23set.seed(17)FRbs

适合的是

y^=27.48993+2.54078f1+2.97679f2

其中和是由创建的B样条基函数。f1f2bs

残差表现良好。适合的。此外,这种方法找到了正确的模型:数据确实是从二次函数(2级)生成的。此外,与用于生成原始误差的0.1、0.3和0.6相比,残差的标准偏差约为正确的大小:0.11、0.20和0.61。鉴于这些曲线明显地外推了观测值(不超过)并使用了这么小的数据集(),这真是令人惊讶。x=5n=23

最后,高阶样条曲线拟合的残差在质量上是相同的。他们只做了一点点改进,但​​使用了不太可信的模型。例如,对于足够高的度,它们开始在观测值之间的较小值处剧烈振荡。 为了说明这种(不良)行为,下面是9级拟合:x

图2

最后,这是一个示例,其中对基础的各种线性功能进行了多次观察。 用于生成这些观察结果的代码从问题中的代码更改为

mult <- 2
x_f <- rep(runif(5, 0, 5), mult)       # Two observations per point
x_df <- rep(runif(8, 3, 8), mult)      # Two derivatives per point
x_ddf <- c(x_df, rep(runif(10, 4, 9))  # Derivative and acceleration per point

图3


R进行这些计算的代码相当笼统。 特别是,它使用数值微分法找到导数,因此它不依赖于所使用样条曲线的类型。它通过按比例将观察值与加权来处理的不同值 它可以自动构建并拟合一组模型。线性函数和标准偏差是硬编码的。根据数据集中变量的值分别选择三个。σi1/σi2.Liσitype

作为如何使用拟合的示例,尾声可打印摘要,其AIC列表以及所有这些的ANOVA。

#
# Estimate spline derivatives at points of `x`.
#
d <- function(x, s, order=1) {
  h <- diff(range(x, na.rm=TRUE))
  dh <- h * 1e-4
  lags <- seq(-order, order, length.out=order+1) * dh/2
  b <- choose(order, 0:order) * (-1)^(order:0)
  y <- b %*% matrix(predict(s, c(outer(lags, x, `+`))), nrow=length(lags))
  y <- matrix(y / (dh^order), nrow=length(x))
}
#
# Fit and plot models by degree.
#
data$order <- c(f=0, df=1, ddf=2)[data$type]
k <- max(data$order)
x <- data$x
w <- (c(0.1, 0.3, 0.6)^(-2))[data$order+1] # As specified in the question

fits <- lapply(1:6, function(deg) {
  #
  # Construct a model matrix.
  #
  s <- bs(x, degree=deg, intercept=TRUE)
  X.l <- lapply(seq.int(k+1)-1, function(i) {
    X <- subset(data, order==i)
    Y <- as.data.frame(d(X$x, s, order=i))
    cbind(X, Y)
  })
  X <- do.call("rbind", X.l)
  #
  # Fit WLS models.
  #
  f <- as.formula(paste("y ~ -1 +", paste0("V", 0:deg+1, collapse="+")))
  fit <- lm(f, X, weights=w)
  msr <- tapply(residuals(fit), data$order, function(r) {
    k <- length(r) - 1 - deg
    ifelse(k >= 1, sum(r^2) / k, 1)
  })
  #
  # Compute predicted values along the graphs.
  #
  X.new <- data.frame(x = seq(min(X$x), max(X$x), length.out=101))
  X.new$y.hat <- predict(s, X.new$x) %*% coefficients(fit)
  X.new$Dy.hat <- d(X.new$x, s, 1) %*% coefficients(fit)
  X.new$DDy.hat <- d(X.new$x, s, 2) %*% coefficients(fit)
  X$Residual <- residuals(fit)
  #
  # Return the model.
  #
  fit$msr <- msr
  fit
})
lapply(fits, function(f) sqrt(f$msr))
lapply(fits, summary)
lapply(fits, AIC)
do.call("anova", fits)

1

首先,我要感谢您提出这个问题。这是一个非常有趣的问题。我喜欢花键和您可以用它们做的很酷的事情。这给了我做一些研究的借口。:-)

BLUF:简短的答案是“否”。我不知道R中的任何功能会自动为您完成此操作。长答案是……要复杂得多。导数和函数值不在同一位置采样的事实使这一点变得更加困难。而且,在间隔的右端附近没有函数值的事实可能使它无法实现。

让我们从三次样条开始。给定点和相应的二阶导数,通过它们的三次样条为:(xj,yj)zj

Sj(x)=Ayj+Byj+1+Czj+Dzj+1
其中 验证,,和。这保证了样条及其二阶导数是连续的。但是,在这一点上,我们没有连续的阶导数。为了强制一阶导数是连续的,我们需要以下约束:
hj=xj+1xjA=xj+1xhjB=1AC=16(A3A)hj2D=16(B3B)hj2
Sj(xj)=yjSj(xj+1)=yj+1Sj(xj)=zjSj(xj+1)=zj+1
(1)6hj1yj1(6hj1+6hj)yj+6hjyj+1=hj1zj1+2(hj1+hj)zj+hjzj+1
在经典三次样条曲线设置中,假设您具有点并使用方程(以及两个附加的边界约束)来求解。一旦知道,就完全指定了样条线,您可以使用它在任意点进行插值。另外,方程变成一个三对角矩阵,可以在线性时间内求解!(xj,yj)(1)zjzj(1)

OK,现在假设您知道而不是。您可以使用方程来求解吗?从纯代数的角度来看,这似乎是可行的。有方程式和未知数,所以...为什么不呢?但是事实证明你做不到;矩阵将是奇异的。这应该不足为奇。给定二阶导数,您怎么可能插值函数值?至少,您需要一个初始值,就像微分方程一样。yjzj(1)yjNN

那你的情况呢?您的某些点具有函数值,而某些点具有导数。目前,让我们忽略一阶导数(它们在三次样条曲线的基础上有点混乱)。形式上,令是具有函数值的点的集合,而是具有二阶导数的点的集合。我们仍然有未知数的方程。只是有些未知数是,有些是。事实证明,你会得到一个解决方案,如果0,1或2和或(xi,yi),iI(xj,zj),jJNNyjzjIN3,N2N1I。换句话说,前三个点之一必须是一个功能值,而后三个点之一必须是一个功能值。除了该约束之外,您还可以随意添加任意数量的派生类。

那些一阶导数怎么样?当然可以在样条中包含一阶导数。但是,就像我说的那样,它变得更加混乱。样条的一阶导数由下式给出: 当然,我们只对结处的导数真正感兴趣,因此我们可以通过在求值来简化此操作: 您可以添加这些从方程得到的矩阵约束

Sj(x)=yj+1yjhj3A216hjzj+3B216hjzj+1
xj
Sj(xj)=yj+1yjhj13hjzj16hjzj+1
(1)结果样条将具有指定的一阶导数。另外,这将有助于解决奇异矩阵问题。如果在前三点和后三点中都有函数值或一阶导数,则将获得解决方案。

因此,我将所有内容合并到一些代码中,这是我得到的图片:

花键变错了

如您所见,结果并不理想。这是因为这是一个常规样条曲线,必须遵守所有数据。由于数据是随机的,因此我们确实需要使用回归样条。这是另一篇文章的主题。但是,如果您进行数学运算,最终将要在线性等式约束下优化二次目标函数-并且有一个封闭式解决方案!

By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.