我们将描述如何通过卡尔曼滤波(KF)技术将样条线与状态空间模型(SSM)结合使用。CF Ansley和R. Kohn在1980-1990年间揭示了一些样条模型可以用SSM表示并可以用KF计算的事实。估计函数及其导数是该状态在观察条件下的期望。通过使用固定间隔平滑来计算这些估计,这是使用SSM时的常规任务。
为了简单起见,假设观测有时由并且该观测数在
只涉及一个与阶导数在
。模型的观察部分写为
,其中表示未观察到的真函数,
是一个高斯误差,取决于推导阶数,其方差为。(连续时间)过渡方程采用一般形式
t1<t2<⋯<tnktkd k { 0 ,dk{0,1,2}y(tk)=f[dk](tk)+ε(tk)(O1)
f(t)ε (t k)H (t k)d kε(tk)H(tk)dkddtα(t)=Aα(t)+η(t)(T1)
α(吨)η(吨)Qε(吨ķ)米α(吨):=[˚F(吨),
,其中是未观察到的状态向量,
是具有协方差的高斯白噪声,假定与观察噪声r.vs。为了描述样条,我们考虑通过堆叠
一阶导数获得的状态,即 。过渡是
α(t)η(t)Qε(tk)mα(t):=[f(t),f[1](t),…,f[m−1](t)]⊤⎡⎣⎢⎢⎢⎢⎢⎢⎢⎢f[1](t)f[2](t)⋮f[m−1](t)f[m](t)⎤⎦⎥⎥⎥⎥⎥⎥⎥⎥=⎡⎣⎢⎢⎢⎢⎢⎢⎢00⋮010…01⋱10⎤⎦⎥⎥⎥⎥⎥⎥⎥⎡⎣⎢⎢⎢⎢⎢⎢⎢⎢f(t)f[1](t)⋮f[m−2](t)f[m−1](t)⎤⎦⎥⎥⎥⎥⎥⎥⎥⎥+⎡⎣⎢⎢⎢⎢⎢⎢⎢00⋮0η(t)⎤⎦⎥⎥⎥⎥⎥⎥⎥
2米2米-1m=2>1 y (t k)
,然后得到阶数为 (
阶数为)的多项式样条。虽然对应于通常的三次样条,2m2m−1m=2>1。为了坚持经典的SSM形式主义,我们可以将(O1)重写为
其中观测矩阵挑选在合适的衍生物和方差的
取决于被选择。因此其中,
和。同样,y(tk)=Z(tk)α(tk)+ε(tk),(O2)
Z(tk)α(tk)H(tk)ε(tk)dkZ(tk)=Z⋆dk+1Z⋆1:=[1,0,…,0]Z⋆2:=[0,1,…0]Z⋆3:=[0,0,1,0,…]H(tk)=H⋆dk+1 ħ ⋆ 1 ħ ⋆ 2 ħ ⋆ 3对于三个方差,
和。 H⋆1H⋆2H⋆3
尽管过渡是连续时间,但KF实际上是标准的离散时间。确实,我们将在实践中将重点放在我们有观察或想要估计导数的时间上。我们可以将集合作为这两组时间的并集,并假设处的观测可能会丢失:这允许在任何时间估计导数,
而与观测值的存在无关。仍然需要导出离散SSM。t{tk}tkmtk
我们将使用指数的离散时间,写为
等。离散时间SSM的格式为
其中矩阵和来自(T1)和(O2),而的方差由
假设αkα(tk)αk+1yk=Tkαk+η⋆k=Zkαk+εk(DT)
TkQ⋆k:=Var(η⋆k)εkHk=H⋆dk+1ykŤķ=EXP{δķ甲}=[ 1 δ 1 ķ不失踪。使用一些代数,我们可以找到离散时间SSM的过渡矩阵
其中对于。类似地,离散时间SSM 的协方差矩阵可以表示为
Tk=exp{δkA}=⎡⎣⎢⎢⎢⎢⎢⎢⎢⎢⎢⎢⎢10⋮0δ1k1!1…δ2k2!δ1k1!…⋱δm−1k(m−1)!δ1k1!1⎤⎦⎥⎥⎥⎥⎥⎥⎥⎥⎥⎥⎥,
δk:=tk+1−tkk<nQ⋆k=Var(η⋆k)Q⋆k=σ2η[δ2m−i−j+1k(m−i)!(m−j)!(2m−i−j+1)]i,j
,其中索引和在和之间。ij1m
现在要进行R中的计算,我们需要一个专用于KF并接受时变模型的软件包。CRAN软件包KFAS似乎是一个不错的选择。我们可以编写R函数来从时间的向量计算矩阵
和
以便对SSM(DT)进行编码。在软件包使用的符号中,矩阵乘以(DT)转换方程中的噪声
:在这里,我们将其视为恒等。另请注意,此处必须使用扩散初始协方差。TkQ⋆ktkRkη⋆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)
}
splinefun
可以计算导数,想必您可以以此为起点,使用某些反方法拟合数据?我有兴趣学习解决方案。