Bagaimana cara pendekatan saddlepoint bekerja?

Bagaimana cara pendekatan saddlepoint bekerja? Masalah apa yang cocok untuk itu?
(Jangan ragu untuk menggunakan contoh atau contoh tertentu dengan cara ilustrasi)

Apakah ada kekurangan, kesulitan, hal-hal yang harus diperhatikan, atau perangkap untuk yang tidak waspada?

Perkiraan saddlepoint ke fungsi densitas probabilitas (berfungsi juga untuk fungsi massa, tapi saya hanya akan berbicara di sini dalam hal kepadatan) adalah perkiraan yang bekerja dengan sangat baik, yang dapat dilihat sebagai penyempurnaan pada teorema limit pusat. Jadi, itu hanya akan bekerja di pengaturan di mana ada teorema batas pusat, tetapi perlu asumsi yang lebih kuat.

Kita mulai dengan asumsi bahwa fungsi pembangkit momen ada dan dua kali dapat dibedakan. Ini menyiratkan secara khusus bahwa semua momen ada. Biarkan menjadi variabel acak dengan fungsi pembangkit momen (mgf) dan cgf (fungsi pembangkit kumulans) (di mana menunjukkan logaritma natural). Dalam pengembangan saya akan mengikuti erat Ronald W Butler: "Saddlepoint Approximations with Applications" (CUP). Kami akan mengembangkan pendekatan saddlepoint menggunakan pendekatan Laplace ke integral tertentu. Menulis $X$

$$\DeclareMathOperator{\E}{\mathbb{E}} M(t) = \E e^{t X}$$ $K(t)=\log M(t)$$\log$ $$e^{K(t)} = \int_{-\infty}^\infty e^{t x} f(x) \; dx =\int_{-\infty}^\infty \exp(tx+\log f(x) ) \; dx \\ = \int_{-\infty}^\infty \exp(-h(t,x)) \; dx$$ mana . Sekarang kita akan memperluas Taylor di mempertimbangkan sebagai konstanta. Ini memberi mana ' menunjukkan diferensiasi sehubungan dengan x . Perhatikan bahwa h '(t, x) = - t- \ frac {\ partial} {\ partial x} \ log f (x) \\ h' '(t, x) = - \ frac {\ partial ^ 2} {\ partial x ^ 2} \ log f (x)> 0 (ketidaksetaraan terakhir dengan asumsi karena diperlukan agar aproksimasi berfungsi). Biarkan x_t$h(t,x) = -tx - \log f(x)$$h(t,x)$$x$$t$ $$h(t,x)=h(t,x_0) + h'(t,x_0)(x-x_0) +\frac12 h''(t,x_0) (x-x_0)^2 +\dotsm$$ $'$$x$ $$h'(t,x)=-t-\frac{\partial}{\partial x}\log f(x) \\ h''(t,x)= -\frac{\partial^2}{\partial x^2} \log f(x) > 0$$ $x_t$menjadi solusi untuk $h'(t,x_t)=0$ . Kami akan menganggap bahwa ini memberikan minimum untuk $h(t,x)$ sebagai fungsi dari $x$ . Dengan menggunakan ekspansi ini di bagian integral dan lupa tentang bagian $\dotsm$ , beri $$e^{K(t)} \approx \int_{-\infty}^\infty \exp(-h(t,x_t)-\frac12 h''(t,x_t) (x-x_t)^2 ) \; dx \\ = e^{-h(t,x_t)} \int_{-\infty}^\infty e^{-\frac12 h''(t,x_t) (x-x_t)^2} \; dx$$ yang merupakan integral Gaussian, memberikan $$e^{K(t)} \approx e^{-h(t,x_t)} \sqrt{\frac{2\pi}{h''(t,x_t)}}.$$ Ini memberikan (versi pertama) dari perkiraan saddlepoint sebagai $$f(x_t) \approx \sqrt{\frac{h''(t,x_t)}{2\pi}} \exp(K(t) -t x_t) \\ \tag{*} \label{*}$$ Perhatikan bahwa aproksimasi memiliki bentuk keluarga eksponensial.

Sekarang kita perlu melakukan beberapa pekerjaan untuk mendapatkan ini dalam bentuk yang lebih bermanfaat.

Dari kita mendapatkan Membedakan ini sehubungan dengan memberikan (dengan asumsi kami), jadi hubungan antara dan adalah monoton, jadi didefinisikan dengan baik. Kita membutuhkan perkiraan untuk . Untuk itu, kita dapatkan dengan menyelesaikan dari$h'(t,x_t)=0$

$$t = -\frac{\partial}{\partial x_t} \log f(x_t).$$ $x_t$ $$\frac{\partial t}{\partial x_t} = -\frac{\partial^2}{\partial x_t^2} \log f(x_t) > 0$$ $t$$x_t$$x_t$$\frac{\partial}{\partial x_t} \log f(x_t)$ log f ( x t ) = K ( t ) - t x t - 1$\eqref{*}$ $$\log f(x_t) = K(t) -t x_t -\frac12 \log \frac{2\pi}{-\frac{\partial^2}{\partial x_t^2} \log f(x_t)}. \tag{**} \label{**}$$ xtxt∂logf(xt) Dengan asumsi istilah terakhir di atas hanya bergantung pada , sehingga turunannya terhadap kira-kira nol (kami akan kembali untuk mengomentari ini), kami mendapatkan Sampai dengan perkiraan ini maka kita memiliki sehingga dan harus dihubungkan melalui persamaan yang disebut persamaan saddlepoint. $x_t$$x_t$ $$\frac{\partial \log f(x_t)}{\partial x_t} \approx (K'(t)-x_t) \frac{\partial t}{\partial x_t} - t$$ $$0 \approx t + \frac{\partial \log f(x_t)}{\partial x_t} = (K'(t)-x_t) \frac{\partial t}{\partial x_t}$$ $t$$x_t$ $$K'(t) - x_t=0, \\ \tag{§} \label{§}$$

Apa yang kita lewatkan sekarang dalam menentukan adalah dan dapat kita temukan dengan diferensiasi implisit dari persamaan saddlepoint : Hasilnya adalah bahwa (hingga perkiraan kami) Menyatukan semuanya, kami memiliki perkiraan akhir saddlepoint untuk kepadatan sebagai h ″ ( t , x t ) = - ∂ 2 log f ( x t )$\eqref{*}$

$$h''(t,x_t) = -\frac{\partial^2 \log f(x_t)}{\partial x_t^2} \\ = -\frac{\partial}{\partial x_t} (\frac{\partial log f(x_t)}{\partial x_t} ) \\ = -\frac{\partial}{\partial x_t}(-t)= (\frac{\partial x_t}{\partial t})^{-1}$$ $K'(t)=x_t$ $$\frac{\partial x_t}{\partial t} = K''(t).$$ $$h''(t,x_t) = \frac1{K''(t)}$$ $f(x)$ $$f(x_t) \approx e^{K(t)- t x_t} \sqrt{\frac1{2\pi K''(t)}}.$$ Sekarang, untuk menggunakan ini secara praktis, untuk memperkirakan kerapatan pada titik tertentu , kita memecahkan persamaan saddlepoint untuk untuk menemukan .$x_t$$x_t$$t$

The saddlepoint pendekatan sering dinyatakan sebagai pendekatan dengan kepadatan rata-rata berdasarkan pengamatan iid . Fungsi penghasil kumulans dari mean adalah hanya , jadi pendekatan saddlepoint untuk mean menjadi $n$$X_1, X_2, \dotsc, X_n$$n K(t)$

$$f(\bar{x}_t) = e^{nK(t) - n t \bar{x}_t} \sqrt{\frac{n}{2\pi K''(t)}}$$

Mari kita lihat contoh pertama. Apa yang kita dapatkan jika kita mencoba mendekati kerapatan normal standar mgf adalah jadi sehingga persamaan saddlepoint adalah dan pendekatan saddlepoint memberikan jadi dalam hal ini aproksimasi tepat.

$$f(x)=\frac1{\sqrt{2\pi}} e^{-\frac12 x^2}$$ $M(t)=\exp(\frac12 t^2)$ $$K(t)=\frac12 t^2 \\ K'(t)=t \\ K''(t)=1$$ $t=x_t$ $$f(x_t) \approx e^{\frac12 t^2 -t x_t} \sqrt{\frac1{2\pi \cdot 1}} = \frac1{\sqrt{2\pi}} e^{-\frac12 x_t^2}$$

Mari kita lihat aplikasi yang sangat berbeda: Bootstrap di domain transformasi, kita dapat melakukan bootstrap secara analitik menggunakan pendekatan saddlepoint ke distribusi bootstrap rata-rata!

Asumsikan kita memiliki iid didistribusikan dari beberapa kepadatan (dalam contoh simulasi kita akan menggunakan distribusi satuan eksponensial). Dari sampel kami menghitung fungsi penghasil momen empiris dan kemudian cgf empirik . Kita membutuhkan mgf empiris untuk rata-rata yaitu dan cgf empiris untuk mean yang kita gunakan untuk membangun pendekatan saddlepoint. Dalam beberapa kode R berikut (R versi 3.2.3): $X_1, X_2, \dotsc, X_n$$f$

$$\hat{M}(t)= \frac1{n} \sum_{i=1}^n e^{t x_i}$$ K (t)=log M (t)$\hat{K}(t) = \log \hat{M}(t)$$\log ( \hat{M}(t/n)^n )$ $$\hat{K}_{\bar{X}}(t) = n \log \hat{M}(t/n)$$

set.seed(1234)
x  <-  rexp(10)

require(Deriv)   ### From CRAN
drule[["sexpmean"]]   <-  alist(t=sexpmean1(t))  # adding diff rules to 
                                                 # Deriv
drule[["sexpmean1"]]  <-  alist(t=sexpmean2(t))

###

make_ecgf_mean  <-   function(x)   {
    n  <-  length(x)
    sexpmean  <-  function(t) mean(exp(t*x))
    sexpmean1 <-  function(t) mean(x*exp(t*x))
    sexpmean2 <-  function(t) mean(x*x*exp(t*x))
    emgf  <-  function(t) sexpmean(t)
    ecgf  <-   function(t)  n * log( emgf(t/n) )
    ecgf1 <-   Deriv(ecgf)
    ecgf2 <-   Deriv(ecgf1)
    return( list(ecgf=Vectorize(ecgf),
                 ecgf1=Vectorize(ecgf1),
                 ecgf2 =Vectorize(ecgf2) )    )
}

### Now we need a function solving the saddlepoint equation and constructing
### the approximation:
###

make_spa <-  function(cumgenfun_list) {
    K  <- cumgenfun_list[[1]]
    K1 <- cumgenfun_list[[2]]
    K2 <- cumgenfun_list[[3]]
    # local function for solving the speq:
    solve_speq  <-  function(x) {
          # Returns saddle point!
          uniroot(function(s) K1(s)-x,lower=-100,
                  upper = 100, 
                  extendInt = "yes")$root
}
    # Function finding fhat for one specific x:
    fhat0  <- function(x) {
        # Solve saddlepoint equation:
        s  <-  solve_speq(x)
        # Calculating saddlepoint density value:
        (1/sqrt(2*pi*K2(s)))*exp(K(s)-s*x)
    }
    # Returning a vectorized version:
    return(Vectorize(fhat0))
} #end make_fhat

(Saya sudah mencoba menulis ini sebagai kode umum yang dapat dimodifikasi dengan mudah untuk cgf lain, tetapi kodenya masih belum terlalu kuat ...)

Kemudian kami menggunakan ini untuk sampel sepuluh pengamatan independen dari unit distribusi eksponensial. Kami melakukan bootstrap nonparametrik yang biasa "dengan tangan", plot histogram bootstrap yang dihasilkan untuk rata-rata, dan overplot perkiraan pendekatan saddlepoint:

> ECGF  <- make_ecgf_mean(x)
> fhat  <-  make_spa(ECGF)
> fhat
function (x) 
{
    args <- lapply(as.list(match.call())[-1L], eval, parent.frame())
    names <- if (is.null(names(args))) 
        character(length(args))
    else names(args)
    dovec <- names %in% vectorize.args
    do.call("mapply", c(FUN = FUN, args[dovec], MoreArgs = list(args[!dovec]), 
        SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES))
}
<environment: 0x4e5a598>
> boots  <-  replicate(10000, mean(sample(x, length(x), replace=TRUE)), simplify=TRUE)
> boots  <-  replicate(10000, mean(sample(x, length(x), replace=TRUE)), simplify=TRUE)
> hist(boots, prob=TRUE)
> plot(fhat, from=0.001, to=2, col="red", add=TRUE)

Memberikan plot yang dihasilkan:

Perkiraannya agak bagus!

Kita bisa mendapatkan perkiraan yang lebih baik dengan mengintegrasikan pendekatan saddlepoint dan men-rescaling:

> integrate(fhat, lower=0.1, upper=2)
1.026476 with absolute error < 9.7e-07

Sekarang fungsi distribusi kumulatif berdasarkan perkiraan ini dapat ditemukan dengan integrasi numerik, tetapi juga dimungkinkan untuk membuat perkiraan saddlepoint langsung untuk itu. Tapi itu untuk posting lain, ini sudah cukup lama.

Akhirnya, beberapa komentar tidak disertakan dalam pengembangan di atas. Dalam kami melakukan perkiraan yang pada dasarnya mengabaikan istilah ketiga. Kenapa kita bisa melakukan itu? Satu pengamatan adalah bahwa untuk fungsi kepadatan normal, istilah yang ditinggalkan tidak berkontribusi apa-apa, sehingga perkiraannya tepat. Jadi, karena saddlepoint-aproksimasi adalah penyempurnaan pada teorema limit pusat, jadi kita agak mendekati normal, jadi ini seharusnya bekerja dengan baik. Kita juga dapat melihat contoh-contoh spesifik. Melihat pendekatan saddlepoint ke distribusi Poisson, melihat istilah ketiga yang ditinggalkan itu, dalam hal ini yang menjadi fungsi trigamma, yang memang agak datar ketika argumennya tidak mendekati nol.$\eqref{**}$

Akhirnya, mengapa namanya? Nama ini berasal dari derivasi alternatif, menggunakan teknik analisis kompleks. Nanti kita bisa melihat itu, tetapi di pos lain!

Di sini saya memperluas jawaban kjetil, dan saya fokus pada situasi-situasi di mana Cumulant Generating Function (CGF) tidak diketahui, tetapi dapat diperkirakan dari data , di mana . Estimator CGF paling sederhana mungkin adalah dari Davison and Hinkley (1988) yang digunakan dalam contoh bootstrap kjetil. Estimator ini memiliki kelemahan bahwa persamaan saddlepoint yang dihasilkan dapat diselesaikan hanya jika , titik di mana kami ingin mengevaluasi kepadatan saddlepoint, termasuk dalam cembung cembung . x ∈ R d K ( λ ) = $x_1,\dots,x_n$$x\in R^d$ K '(λ)=y,yx1,...,x

$$\hat{K}(\lambda) = \frac{1}{n}\sum_{i=1}^{n}e^{\lambda^Tx_i},$$ $$\hat{K}'(\lambda) = y,$$ $y$$x_1,\dots,x_n$

Wong (1992) dan Fasiolo et al. (2016) mengatasi masalah ini dengan mengusulkan dua alternatif penduga CGF, yang dirancang sedemikian rupa sehingga persamaan saddlepoint dapat diselesaikan untuk setiap . Solusi dari Fasiolo et al. (2016), disebut ESA Pendekatan Empiris Saddlepoint diperpanjang, diimplementasikan dalam paket esaddle R dan di sini saya memberikan beberapa contoh.$y$

Sebagai contoh univariat yang sederhana, pertimbangkan untuk menggunakan ESA untuk memperkirakan kepadatan .$\text{Gamma}(2, 1)$

library("devtools")
install_github("mfasiolo/esaddle")
library("esaddle")

########## Simulating data
x <- rgamma(1000, 2, 1)

# Fixing tuning parameter of ESA
decay <-  0.05

# Evaluating ESA at several point
xSeq <- seq(-2, 8, length.out = 200)
tmp <- dsaddle(y = xSeq, X = x, decay = decay, log = TRUE)

# Plotting true density, ESA and normal approximation
plot(xSeq, exp(tmp$llk), type = 'l', ylab = "Density", xlab = "x")
lines(xSeq, dgamma(xSeq, 2, 1), col = 3)
lines(xSeq, dnorm(xSeq, mean(x), sd(x)), col = 2)
suppressWarnings( rug(x) )
legend("topright", c("ESA", "Truth", "Gaussian"), col = c(1, 3, 2), lty = 1)

Ini cocok

Melihat permadani itu jelas bahwa kami mengevaluasi kepadatan ESA di luar rentang data. Contoh yang lebih menantang adalah Gaussian bivariat berikut yang melengkung.

# Function that evaluates the true density
dwarp <- function(x, alpha) {
  d <- length(alpha) + 1
  lik <- dnorm(x[ , 1], log = TRUE)
  tmp <- x[ , 1]^2
  for(ii in 2:d)
    lik <- lik + dnorm(x[ , ii] - alpha[ii-1]*tmp, log = TRUE)
  lik
}

# Function that simulates from true distribution
rwarp <- function(n = 1, alpha) {
  d <- length(alpha) + 1
  z <- matrix(rnorm(n*d), n, d)
  tmp <- z[ , 1]^2
  for(ii in 2:d) z[ , ii] <- z[ , ii] + alpha[ii-1]*tmp
  z
}

set.seed(64141)
# Creating 2d grid
m <- 50
expansion <- 1
x1 <- seq(-2, 3, length=m)* expansion; 
x2 <- seq(-3, 3, length=m) * expansion
x <- expand.grid(x1, x2) 

# Evaluating true density on grid
alpha <- 1
dw <- dwarp(x, alpha = alpha)

# Simulate random variables
X <- rwarp(1000, alpha = alpha)

# Evaluating ESA density
dwa <- dsaddle(as.matrix(x), X, decay = 0.1, log = FALSE)$llk

# Plotting true density
par(mfrow = c(1, 2))
plot(X, pch=".", col=1, ylim = c(min(x2), max(x2)), xlim = c(min(x1), max(x1)),
     main = "True density", xlab = expression(X[1]), ylab = expression(X[2]))
contour(x1, x2, matrix(dw, m, m), levels = quantile(as.vector(dw), seq(0.8, 0.995, length.out = 10)), col=2, add=T)

# Plotting ESA density
plot(X, pch=".",col=2, ylim = c(min(x2), max(x2)), xlim = c(min(x1), max(x1)),
     main = "ESA density", xlab = expression(X[1]), ylab = expression(X[2]))
contour(x1, x2, matrix(dwa, m, m), levels = quantile(as.vector(dwa), seq(0.8, 0.995, length.out = 10)), col=2, add=T)

Cocok cukup bagus.

Terima kasih atas jawaban Kjetil yang luar biasa, saya mencoba memberikan sedikit contoh sendiri, yang ingin saya diskusikan karena sepertinya memunculkan poin yang relevan:

Pertimbangkan . dan turunannya dapat ditemukan di sini dan direproduksi dalam fungsi dalam kode di bawah ini. K ( t $\chi^2(m)$$K(t)$

x <- seq(0.01,20,by=.1)
m <- 5

K  <- function(t,m) -1/2*m*log(1-2*t)
K1 <- function(t,m) m/(1-2*t)
K2 <- function(t,m) 2*m/(1-2*t)^2

saddlepointapproximation <- function(x) {
  t <- .5-m/(2*x)
  exp( K(t,m)-t*x )*sqrt( 1/(2*pi*K2(t,m)) )
}
plot( x, saddlepointapproximation(x), type="l", col="salmon", lwd=2)
lines(x, dchisq(x,df=m), col="lightgreen", lwd=2)

Ini menghasilkan

Ini jelas menghasilkan perkiraan yang mendapatkan fitur kualitatif dari kepadatan yang tepat, tetapi, seperti yang dikonfirmasi dalam komentar Kjetil, bukan kepadatan yang tepat, karena di atas kepadatan yang tepat di mana-mana. Menyesuaikan ulang perkiraan sebagai berikut memberikan kesalahan perkiraan yang hampir diabaikan yang digambarkan di bawah ini.

scalingconstant <- integrate(saddlepointapproximation, x[1], x[length(x)])$value

approximationerror_unscaled <- dchisq(x,df=m) - saddlepointapproximation(x)
approximationerror_scaled   <- dchisq(x,df=m) - saddlepointapproximation(x) /
                                                    scalingconstant

plot( x, approximationerror_unscaled, type="l", col="salmon", lwd=2)
lines(x, approximationerror_scaled,             col="blue",   lwd=2)