Bagaimana saya bisa memasukkan spline ke data yang berisi nilai dan turunan 1/2?

Saya memiliki dataset yang berisi, katakanlah, beberapa pengukuran untuk posisi, kecepatan dan akselerasi. Semua berasal dari "lari" yang sama. Saya bisa membangun sistem linier dan sesuai polinomial untuk semua pengukuran itu.

Tetapi bisakah saya melakukan hal yang sama dengan splines? Apa cara 'R' dalam melakukan ini?

Berikut adalah beberapa data simulasi yang ingin saya masukkan:

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?

Kami akan menjelaskan bagaimana spline dapat digunakan melalui teknik Kalman Filtering (KF) sehubungan dengan State-Space Model (SSM). Fakta bahwa beberapa model spline dapat diwakili oleh SSM dan dihitung dengan KF diungkapkan oleh CF Ansley dan R. Kohn pada tahun 1980-1990. Fungsi yang diestimasi dan turunannya adalah harapan negara tergantung pada pengamatan. Estimasi ini dihitung dengan menggunakan pemulusan interval tetap , tugas rutin saat menggunakan SSM.

Demi kesederhanaan, asumsikan bahwa pengamatan dilakukan pada waktu dan bahwa angka pengamatan pada hanya melibatkan satu turunan dengan urutan dalam . Bagian pengamatan model menulis sebagai mana menunjukkan fungsi true yang tidak teramati dan adalah kesalahan Gaussian dengan varian tergantung pada urutan derivasi . Persamaan transisi (waktu kontinu) mengambil bentuk umum $t_1 < t_2 < \dots < t_n$$k$$t_k$d k { 0 ,$d_k$$\{0,\,1,\,2\}$

$$\tag{O1} y(t_k) = f^{[d_k]}(t_k) + \varepsilon(t_k)$$ $f(t)$ε ( t k ) H ( t k ) d k d$\varepsilon(t_k)$$H(t_k)$$d_k$ $$\tag{T1} \frac{\text{d}}{\text{d}t}\boldsymbol{\alpha}(t) = \mathbf{A} \boldsymbol{\alpha}(t) + \boldsymbol{\eta}(t)$$ mana adalah vektor state yang tidak teramati dan adalah derau putih Gaussian dengan kovarians , diasumsikan independen dari kebisingan pengamatan r.vs . Untuk menggambarkan spline, kami mempertimbangkan keadaan yang diperoleh dengan menumpuk turunan pertama, yaitu . Transisinya adalah $\boldsymbol{\alpha}(t)$$\boldsymbol{\eta}(t)$$\mathbf{Q}$$\varepsilon(t_k)$$m$$\boldsymbol{\alpha}(t) := [f(t),\, f^{[1]}(t), \, \dots,\, f^{[m-1]}(t)]^\top$ $$\begin{bmatrix} f^{[1]}(t) \\ f^{[2]}(t) \\ \vdots \\ f^{[m-1]}(t) \\ f^{[m]}(t) \end{bmatrix} = \begin{bmatrix} 0 & 1 & 0 & &\\ 0 & 0 & 1 & & \\ \vdots & & & \ddots &\\ & & & & 1\\ 0 & \dots & & & 0 \end{bmatrix} \begin{bmatrix} f(t) \\ f^{[1]}(t) \\ \vdots \\ f^{[m-2]}(t)\\ f^{[m-1]}(t) \end{bmatrix} + \begin{bmatrix} 0 \\ 0 \\ \vdots\\ 0 \\ \eta(t) \end{bmatrix}$$ 2m2m-1m=2>1 y ( t k ) dan kita kemudian mendapatkan spline polinomial dengan urutan (dan derajat ). Sementara sesuai dengan spline kubik biasa,$2m$$2m-1$$m=2$$>1$. Untuk tetap berpegang pada formalisme SSM klasik kita bisa menulis ulang (O1) sebagai di mana matriks observasi memilih turunan yang sesuai di dan varian dari dipilih tergantung pada . Jadi mana , dan . Demikian pula $$\tag{O2} y(t_k) = \mathbf{Z}(t_k) \boldsymbol{\alpha}(t_k) + \varepsilon(t_k),$$ $\mathbf{Z}(t_k)$$\boldsymbol{\alpha}(t_k)$$H(t_k)$$\varepsilon(t_k)$$d_k$$\mathbf{Z}(t_k) = \mathbf{Z}^\star_{d_k + 1}$$\mathbf{Z}^\star_1 := [1,\,0,\,\dots,\,0]$$\mathbf{Z}^\star_2 := [0,\,1,\,\dots\,0]$$\mathbf{Z}^\star_3 := [0,\,0,\,1, 0,\,\dots]$$H(t_k) = H^\star_{d_k+1}$ H ⋆ 1 H ⋆ 2 H ⋆ 3untuk tiga varian , , dan . $H^\star_1$$H^\star_2$$H^\star_3$

Meskipun transisi dalam waktu kontinu, KF sebenarnya adalah waktu diskrit standar . Memang, kita akan dalam praktek fokus pada kali di mana kita memiliki observasi, atau di mana kita ingin memperkirakan derivatif. Kita dapat menganggap himpunan menjadi gabungan dari dua set waktu ini dan menganggap bahwa pengamatan pada dapat hilang: ini memungkinkan untuk memperkirakan turunan kapan saja terlepas dari keberadaan suatu pengamatan. Masih ada untuk menurunkan SSM diskrit.$t$$\{t_k\}$$t_k$$m$$t_k$

Kami akan menggunakan indeks untuk waktu diskrit, menulis untuk dan seterusnya. SSM waktu diskret mengambil bentuk mana matriks dan berasal dari (T1) dan (O2) sedangkan varian dari diberikan oleh asalkan$\boldsymbol{\alpha}_k$$\boldsymbol{\alpha}(t_k)$

$$\begin{align*} \tag{DT} \boldsymbol{\alpha}_{k+1} &= \mathbf{T}_k \,\boldsymbol{\alpha}_{k} + \boldsymbol{\eta}^\star_{k}\\ y_k &= \mathbf{Z}_k\boldsymbol{\alpha}_k + \varepsilon_k \end{align*}$$ $\mathbf{T}_k$$\mathbf{Q}_k^\star := \text{Var}(\boldsymbol{\eta}_k^\star)$$\varepsilon_k$$H_k=H^\star_{d_k+1}$$y_k$Tk=exp{δkA}=[ 1 δ 1 ktidak hilang. Dengan menggunakan beberapa aljabar, kita dapat menemukan matriks transisi untuk SSM-waktu diskrit mana untuk . Demikian pula matriks kovarians untuk SSM waktu diskrit dapat diberikan sebagai $$\mathbf{T}_k = \exp\left\{ \delta_k \mathbf{A} \right\} = \begin{bmatrix} 1 & \frac{\delta_k^1}{1!} & \frac{\delta_k^2}{2!} & \dots & \frac{\delta_k^{m-1}}{(m-1)!}\\ 0 & 1 & \frac{\delta_k^1}{1!} & & \\ \vdots & & & \ddots &\\ & & & & \frac{\delta_k^1}{1!}\\ 0 & \dots & & & 1 \end{bmatrix}, \qquad$$
$\delta_k:= t_{k+1} - t_{k}$$k<n$$\mathbf{Q}^\star_k = \text{Var} (\boldsymbol{\eta}_k^\star)$ $$\mathbf{Q}^\star_k= \sigma_\eta^2 \, \left[\frac{\delta_k^{2m-i-j+1}}{(m-i)!(m-j)! (2m-i-j+1)}\right]_{i,j}$$ mana indeks dan berada di antara dan .$i$$j$$1$$m$

Sekarang untuk meneruskan perhitungan dalam R kita membutuhkan paket yang ditujukan untuk KF dan menerima model yang bervariasi waktu; paket CRAN KFAS tampaknya merupakan pilihan yang baik. Kita dapat menulis fungsi R untuk menghitung matriks dan dari vektor kali untuk mengkodekan SSM (DT). Dalam notasi yang digunakan oleh paket, sebuah matriks hadir untuk mengalikan noise dalam persamaan transisi (DT): kami menganggapnya sebagai identitas . Perhatikan juga bahwa kovarians awal difus harus digunakan di sini.$\mathbf{T}_k$$\mathbf{Q}^\star_k$$t_k$$\mathbf{R}_k$$\boldsymbol{\eta}^\star_k$$\mathbf{I}_m$

EDIT Bintang seperti yang ditulis pada awalnya salah. Diperbaiki (termasuk dalam kode R dan gambar).$\mathbf{Q}^\star$

CF Ansley dan R. Kohn (1986) "Pada Kesetaraan Dua Pendekatan Stochastic untuk Spline Smoothing" J. Appl. Mungkin. , 23, hlm. 391-405

R. Kohn dan CF Ansley (1987) "Algoritma Baru untuk Spline Smoothing Berdasarkan Proses Smoothing Stochastic" SIAM J. Sci. dan Stat. Komputasi. , 8 (1), hlm. 33–48

J. Helske (2017). "KFAS: Model Ruang Keluarga Negara Eksponensial dalam R" J. Stat. Lembut. , 78 (10), hlm. 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)
}

Anda dapat melakukannya dengan sangat baik dengan rutin standar kuadrat-terkecil, asalkan Anda memiliki gagasan yang masuk akal tentang ukuran relatif kesalahan acak yang dibuat untuk setiap turunan. Tidak ada batasan pada jumlah pengukuran yang Anda buat untuk setiap nilai - Anda bahkan dapat secara bersamaan mengukur turunan yang berbeda di masing-masing nilai. Satu-satunya batasan dalam penggunaan Ordinary Least Squares (OLS) adalah biasa: Anda menganggap pengukurannya independen.$x$

Ide dasar dapat paling jelas diungkapkan dengan mengabstraksi masalah. Model Anda menggunakan serangkaian fungsi (seperti basis spline) sebagai dasar untuk memprediksi nilai dari fungsi yang tidak diketahui pada titik Ini berarti Anda berupaya memperkirakan koefisien yang setiap kombinasi dapat diterima mendekati Sebut ini ruang (vektor) kombinasi linear$p$$f_j:\mathbb{R}\to\mathbb{R},$ $j=1, 2, \ldots, p$$y_i = f(x_i)$$f$$(x_1, x_2, \ldots, x_n).$$\beta_j$$\sum_j \beta_j f_j(x_i)$$y_i.$$\mathbb F.$

Yang istimewa dari masalah ini adalah Anda tidak perlu mengamati$y_i.$ Sebagai gantinya, ada satu set fungsional fungsional linier terkait dengan data. Ingatlah bahwa fungsional adalah "fungsi fungsi:" setiap memberikan angka ke fungsi apa pun Model ini menyatakan bahwa$\mathcal{L}_i$$\mathcal{L}_i$$\mathcal{L}_i[f]$$f\in \mathbb F.$

$$y_i = \mathcal{L}_i [f] + \sigma_i \varepsilon_i\tag{1}$$

mana diberikan functionals, yang yang dikenal faktor skala, dan adalah independen dan identik didistribusikan variabel acak.$\mathcal{L}_i$$\sigma_i \gt 0$$\varepsilon_i$

Dua asumsi tambahan membuat OLS dapat diterapkan dan bermakna secara statistik:

1. Distribusi umum dari memiliki varian yang terbatas.$\varepsilon_i$

2. Setiap adalah fungsional linier . Sebuah fungsional adalah linier ketika untuk setiap elemen dan angka yang sesuai$\mathcal{L}_i$$\mathcal L$$f_j\in\mathbb{F}$$\alpha_j,$

   $$\mathcal{L}\left[\sum_j \alpha_j f_j\right] = \sum_j \alpha_j \mathcal{L}\left[f_j\right].$$

(2) memungkinkan model untuk dinyatakan lebih eksplisit sebagai$(1)$

$$y_i = \beta_1 \mathcal{L}_i[f_1] + \cdots + \beta_p \mathcal{L}_i[f_p] + \sigma_i \varepsilon_i.$$

Inti dari pengurangan ini adalah bahwa karena Anda telah menetapkan semua fungsional semua fungsi dasar dan standar deviasi nilai semuanya angka - -ini hanyalah "variabel" atau "fitur" biasa dari masalah regresi - dan hanyalah bobot (relatif). Dengan demikian, dalam arti optimal dari Teorema Gauss-Markov, OLS adalah prosedur yang bagus untuk digunakan.$\mathcal{L}_i,$$f_j,$$\sigma_i,$$\mathcal{L}_i[f_j]$$\sigma_i$

Fungsional yang terlibat dalam pertanyaan adalah sebagai berikut:

• Evaluasi pada titik tertentu Inilah yang biasanya kita lakukan. Ini linier karena, menurut definisi, kombinasi fungsi linear dievaluasi secara searah.$f$$x:$ $\mathcal{L}[f] = f(x).$

• Evaluasi turunan pada titik yang ditentukan Ini linier karena diferensiasi linier.$f^\prime$$x:$ $\mathcal{L}[f] = f^\prime(x).$

• Evaluasi turunan kedua pada titik yang ditentukan$f^{\prime \prime}$$x:$ $\mathcal{L}[f] = f^{\prime \prime}(x).$

---

Oke, seberapa baik pendekatan ini bekerja? Seperti biasa, kita akan mempelajari residual membandingkan nilai-nilai yang dipasang dengan nilai-nilai yang diamati. Karena posisi, kecepatan, dan akselerasi semuanya dalam unit yang berbeda, mereka harus diplot pada sumbu yang terpisah.$\hat y_i - y_i$$\hat y_i$

Baris atas menggunakan kurva untuk membuat grafik dan dua turunan pertamanya. Poin data yang relevan diplot di atas kurva: nilai yang diamati di sebelah kiri, turunan yang diamati di tengah, dan turunan kedua yang diamati di sebelah kanan.$\hat y$

Baris bawah memplot residual yang sesuai. Seperti biasa, kami mencari kurangnya hubungan yang cukup: kami berharap nilai residu (koordinat y) bervariasi secara acak dari kiri ke kanan, menunjukkan independensi dan tidak ada tren.

Nilai data dihasilkan persis seperti pada pertanyaan (setelah menyetel seed number acak menjadi 17 digunakan untuk reproduktifitas). Saya menjelajahi cocok menggunakan spasi B-spline dihasilkan oleh fungsi , juga seperti dalam pertanyaan, untuk derajat 1 sampai 6. Gambar ini menunjukkan hasil untuk derajat 2, yang merupakan tingkat terendah (yaitu, model paling sederhana) menunjukkan AIC yang rendah dan perilaku residual yang baik, serta model yang ditunjukkan oleh ANOVA dari semua enam (bersarang) model.$n=23$set.seed(17)$\mathbb F$Rbs

Cocok adalah

$$\hat y = -27.48993 + 2.54078 f_1 + 2.97679 f_2$$

di mana dan adalah fungsi basis B-spline yang dibuat oleh .$f_1$$f_2$bs

Residunya berperilaku baik. Cocok itu bagus. Selain itu, pendekatan ini menemukan model yang benar : data memang dihasilkan dari fungsi kuadratik (derajat 2). Selanjutnya, standar deviasi residu adalah tentang ukuran yang tepat: 0,11, 0,20, dan 0,61 dibandingkan dengan 0,1, 0,3, dan 0,6 yang digunakan untuk menghasilkan kesalahan asli. Itu cukup luar biasa mengingat bahwa kurva ini jelas memperkirakan pengamatan (yang tidak melampaui ) dan menggunakan dataset kecil seperti itu ( ).$x=5$$n=23$

Akhirnya, residu pada kecocokan untuk spline tingkat tinggi secara kualitatif sama; mereka hanya membuat sedikit perbaikan dengan biaya menggunakan model yang kurang masuk akal. Untuk derajat yang cukup tinggi, mereka mulai terombang-ambing secara liar untuk nilai-nilai kecil antara nilai-nilai yang diamati, misalnya. Untuk menggambarkan perilaku (buruk) ini, inilah kecocokan derajat-9:$x$

Akhirnya, di sini adalah contoh di mana banyak pengamatan dari berbagai fungsional linear dari dasar dibuat. Kode untuk menghasilkan pengamatan ini diubah dari yang ada di pertanyaan menjadi

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

---

The Rkode untuk membawa perhitungan ini agak umum. Secara khusus, ia menggunakan diferensiasi numerik untuk menemukan turunannya sehingga tidak tergantung pada jenis spline yang digunakan. Ini menangani nilai yang berbeda dari dengan menimbang pengamatan secara proporsional ke Secara otomatis membangun dan menyesuaikan satu set model dalam satu lingkaran. Fungsional linear dan standar deviasi adalah hard-coded. Ada tiga masing-masing, dipilih sesuai dengan nilai variabel dalam dataset.$\sigma_i$$1/\sigma_i^2.$$\mathcal{L}_i$$\sigma_i$type

Sebagai contoh bagaimana Anda dapat menggunakan pasangan, coda mencetak ringkasan, daftar AIC mereka, dan ANOVA dari semuanya.

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

Pertama-tama, saya ingin mengucapkan terima kasih karena telah mengajukan pertanyaan ini. Ini pertanyaan yang SANGAT menarik. Saya suka splines dan hal-hal keren yang dapat Anda lakukan dengannya. Dan ini memberi saya alasan untuk melakukan riset. :-)

BLUF: Jawaban singkatnya adalah tidak. Saya tidak tahu fungsi apa pun di R yang akan melakukan ini untuk Anda secara otomatis. Jawaban panjangnya adalah ... jauh lebih rumit. Fakta bahwa turunan dan nilai fungsi tidak disampel di tempat yang sama membuat ini lebih sulit. Dan fakta bahwa Anda tidak memiliki nilai fungsi di dekat ujung kanan interval mungkin membuatnya tidak mungkin.

Mari kita mulai dengan spline kubik. Poin yang diberikan dan turunan kedua yang sesuai , spline kubik yang melewatinya adalah:$(x_j, y_j)$$z_j$

$$S_j(x) = Ay_j + By_{j+1} + Cz_j + Dz_{j+1}$$ mana Cukup mudah untuk memverifikasi bahwa , , dan . Ini menjamin bahwa spline dan turunan keduanya adalah kontinu. Namun, pada titik ini, kami tidak memiliki turunan pertama yang berkelanjutan . Untuk memaksa turunan pertama menjadi kontinu, kita membutuhkan batasan berikut: $$\begin{array}{} h_j & = & x_{j+1} - x_j \\ A & = & \frac{x_{j+1} - x}{h_j} \\ B & = & 1 - A \\ C & = & \frac{1}{6}(A^3 - A)h_j ^2 \\ D & = & \frac{1}{6}(B^3 - B)h_j ^2 \end{array}$$ $S_j(x_j) = y_j$$S_j(x_{j+1}) = y_{j+1}$$S''_j(x_j) = z_j$$S''_j(x_{j+1}) = z_{j+1}$ $$\frac{6}{h_{j-1}}y_{j-1} - \left( \frac{6}{h_{j-1}} + \frac{6}{h_j} \right) y_j + \frac{6}{h_j}y_{j+1} = h_{j-1} z_{j-1} + 2(h_{j-1} + h_j) z_j + h_j z_{j + 1} \tag{1}\label{1}$$ Dalam penyiapan spline kubik klasik, Anda menganggap Anda memiliki titik dan menggunakan persamaan (bersama dengan dua batasan batas tambahan) untuk menyelesaikan untuk . Setelah Anda mengetahui , spline ditentukan sepenuhnya dan Anda dapat menggunakannya untuk menginterpolasi pada titik sembarang. Sebagai bonus tambahan, persamaan berubah menjadi matriks tridiagonal yang dapat diselesaikan dalam waktu linier!$(x_j, y_j)$$\eqref{1}$$z_j$$z_j$$\eqref{1}$

OK, sekarang anggaplah, alih-alih mengetahui , Anda tahu . Bisakah Anda menggunakan persamaan untuk menyelesaikan ? Dari sudut pandang aljabar murni, tampaknya layak. Ada persamaan dan tidak diketahui, jadi ... mengapa tidak? Tetapi ternyata Anda tidak bisa; matriks akan tunggal. Dan itu seharusnya tidak mengejutkan. Bagaimana mungkin Anda menginterpolasi nilai fungsi yang diberikan HANYA turunan kedua? Paling tidak, Anda akan membutuhkan nilai awal, seperti persamaan diferensial.$y_j$$z_j$$\eqref{1}$$y_j$$N$$N$

Bagaimana dengan situasi Anda? Beberapa poin Anda memiliki nilai fungsi dan beberapa poin Anda memiliki turunan. Untuk saat ini, mari kita abaikan turunan pertama (mereka agak berantakan untuk berurusan dengan basis spline kubik). Secara formal, misalkan menjadi himpunan titik dengan nilai fungsi dan menjadi himpunan titik dengan turunan kedua. Kami masih memiliki persamaan dengan tidak diketahui. Hanya saja beberapa yang tidak diketahui adalah dan beberapa . Ternyata Anda akan mendapatkan solusi jika 0, 1 atau 2 AND atau$(x_i, y_i), i \in \mathcal{I}$$(x_j, z_j), j \in \mathcal{J}$$N$$N$$y_j$$z_j$$\in \mathcal{I}$$N - 3, N - 2$$N - 1 \in \mathcal{I}$. Dengan kata lain, salah satu dari tiga poin pertama harus menjadi nilai fungsi DAN salah satu dari tiga poin terakhir harus menjadi nilai fungsi. Selain kendala itu, Anda bebas untuk melemparkan sebanyak mungkin turunan yang Anda inginkan.

Bagaimana dengan turunan pertama itu? Tentunya mungkin untuk memasukkan turunan pertama dalam spline Anda. Tapi, seperti saya katakan, itu menjadi jauh lebih berantakan. Turunan pertama dari spline diberikan oleh: Tentu saja, kami hanya benar-benar tertarik dengan turunan pada simpul, sehingga kami dapat menyederhanakan ini sedikit dengan mengevaluasinya di : Anda dapat menambahkan ini kendala pada matriks yang Anda dapatkan dari persamaan

$$S'_j(x) = \frac{y_{j+1} - y_j}{h_j} - \frac{3A^2 - 1}{6} h_j z_j + \frac{3B^2 - 1}{6} h_j z_{j+1}$$ $x_j$ $$S'_j(x_j) = \frac{y_{j+1} - y_j}{h_j} - \frac{1}{3} h_j z_j - \frac{1}{6} h_j z_{j+1}$$ $\eqref{1}$dan spline yang dihasilkan akan memiliki turunan pertama yang ditentukan. Selain itu, ini akan membantu dengan masalah matriks singular. Anda akan mendapatkan solusi jika Anda memiliki nilai fungsi EITHER atau turunan pertama dalam tiga poin pertama dan terakhir.

Jadi saya mengumpulkan semuanya dalam beberapa kode dan inilah gambar yang saya dapat:

Seperti yang Anda lihat, hasilnya tidak bagus. Itu karena ini adalah spline biasa yang harus menghormati SEMUA data. Karena data bersifat stokastik, kita benar-benar perlu menggunakan garis regresi. Itu topik untuk posting lain. Tetapi jika Anda bekerja melalui matematika, Anda akan akhirnya mengoptimalkan fungsi tujuan kuadratik tunduk pada kendala kesetaraan linear - dan ada solusi bentuk tertutup!