Saddlepoint yaklaşımı nasıl çalışır?

Nasıl yapar saddlepoint yaklaşım çalışır? Ne tür bir sorun için iyi?
(Örnekleme yoluyla belirli bir örneği veya örneği kullanmaktan çekinmeyin)

Herhangi bir dezavantaj, zorluk, dikkat edilmesi gerekenler veya takılmalar için tuzaklar var mı?

Olasılık yoğunluk fonksiyonuna saddlepoint yaklaşımı (kütle fonksiyonları için aynı şekilde çalışır, ancak burada sadece yoğunluklar hakkında konuşacağım), merkezi limit teoreminde bir inceltme olarak görülebilen şaşırtıcı derecede iyi çalışan bir yaklaşımdır. Dolayısıyla, yalnızca merkezi bir limit teoreminin olduğu ortamlarda çalışacaktır, ancak daha güçlü varsayımlara ihtiyacı vardır.

Moment oluşturma fonksiyonunun var olduğu ve iki kez farklılaştığı varsayımıyla başlarız. Bu, özellikle tüm anların var olduğu anlamına gelir. moment oluşturma işleviyle (mgf) ve cgf (kümülatör oluşturma işlevi) ile rastgele bir değişken olsun (burada , doğal logaritmayı belirtir). Gelişimde Ronald W Butler'ı yakından takip edeceğim: "Uygulamalarla Saddlepoint Yaklaşımları" (CUP). Belli bir integrali Laplace yaklaşımını kullanarak saddlepoint yaklaşımını geliştireceğiz. Yazmak $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$$ burada . Şimdi Taylor genişleyecektir içinde dikkate bir sabite olarak. Bu verir ' x'e göre farklılaşmayı ifade eder . Not bu h (t, x) = - t \ frac {\ kısmi} {\ kısmi x} \ log f (x) \\ s '(t, x) = - {kısmi \ ^ 2} \ frac {\ partial x ^ 2} \ log f (x)> 0 (yaklaşımın çalışması için gerekli olduğu gibi varsayımla son eşitsizlik). X_t olsun$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$$h'(t,x_t)=0$ için çözüm olun . Bunun için en az verdiğini üstlenecek $h(t,x)$ bir fonksiyonu olarak $x$ . İntegralde bu genişlemeyi kullanmak ve $\dotsm$ bölümünü unutmak , $$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$$ Gauss integrali olan dx , $$e^{K(t)} \approx e^{-h(t,x_t)} \sqrt{\frac{2\pi}{h''(t,x_t)}}.$$ Bu, saddlepoint yaklaşımının (ilk versiyonunu) $$f(x_t) \approx \sqrt{\frac{h''(t,x_t)}{2\pi}} \exp(K(t) -t x_t) \\ \tag{*} \label{*}$$ Yaklaşımın üstel bir aile şeklinde olduğuna dikkat edin.

Şimdi bunu daha faydalı bir biçimde elde etmek için bazı işler yapmamız gerekiyor.

Kaynaktan , biz olsun İle ilgili olarak bu Farklılaşan verir (bizim varsayımlarla) ve arasındaki ilişki monotondur, bu nedenle iyi tanımlanmıştır. Biz bir yaklaşma ihtiyaç . Bu amaçla,$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)$$\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{**}$$ Sadece yukarıda geçen dönem üzerinde zayıf bağlıdır varsayarsak göre onun türevi bu yüzden, yaklaşık sıfırdır, biz olsun (biz bu konuda yorumun geri gelecektir) Bu yaklaşıma kadar, o zaman böylece ve , denklemiyle , saddlepoint denklemi olarak adlandırılır. $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{§}$$

Ne belirlenmesinde hemen kaçırma olduğunu ve saddlepoint denkleminin örtük olarak farklılaşması ile bulabildiğimizi : Sonuç (yukarı eden yaklaşım kadar) Her şeyi birleştirme biz yoğunluk nihai saddlepoint yaklaşım vardır olarak $\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)}}.$$ Şimdi, belirli bir noktasında yoğunluğunu yaklaşmak için, pratikte bu kullanmak bunun için biz saddlepoint denklemini çözmek bulmak için .$x_t$$x_t$$t$

Saddlepoint yaklaşımı sık sık göre ortalama yoğunluğu bir yaklaşım olarak belirtilmektedir IID gözlem . Ortalamanın kümülatif üretme işlevi basitçe , bu nedenle ortalamanın saddlepoint yaklaşımı $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)}}$$

İlk örneğe bakalım. Standart normal yoğunluğa yaklaşmaya çalışırsak ne elde ederiz? mgf böylece böylece saddlepoint denklemi ve saddlepoint yaklaşımı değerini verir yani bu durumda yaklaşıklık kesindir.

$$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}$$

Çok farklı bir uygulamaya bakalım: Dönüşüm alanındaki bootstrap, ortalamanın bootstrap dağılımına saddlepoint yaklaşımını kullanarak analitik olarak bootstrapping yapabiliriz!

Bazı yoğunluktan dağıtılmış X_n sahip olduğumuzu varsayalım (benzetilen örnekte bir üstel dağılım kullanacağız). Örnekten, ve sonra ampirik cgf kullanarak deneysel momenti üreten işlevi hesapladık. . Biz bir ortalama ampirik MGF mi , ortalama ampirik KGF saddlepoint yaklaşımı oluşturmak için kullandığımız . Aşağıdaki bazı R kodlarında (R sürüm 3.2.3): $X_1, X_2, \dotsc, X_n$$f$

$$\hat{M}(t)= \frac1{n} \sum_{i=1}^n e^{t x_i}$$ $\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

(Bunu diğer cgfs'ler için kolayca değiştirilebilen genel kod olarak yazmaya çalıştım, ancak kod hala çok sağlam değil ...)

Daha sonra bunu, bir birim üstel dağılımından on bağımsız gözlem örneği için kullanırız. Her zamanki parametrik olmayan önyükleme işlemini "el ile" yaparız, sonuçta ortaya çıkan önyükleme histogramını çizeriz ve saddlepoint yaklaşımının üzerine çizeriz:

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

Ortaya çıkan arsa verilmesi:

Yaklaşım oldukça iyi görünüyor!

Saddlepoint yaklaşımını entegre ederek ve yeniden ölçeklendirerek daha iyi bir yaklaşım elde edebiliriz:

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

Şimdi, bu yaklaşıma dayanan kümülatif dağılım işlevi, sayısal entegrasyonla bulunabilir, ancak bunun için doğrudan bir sınır noktası yaklaşımı yapmak da mümkündür. Ama bu başka bir yazı için, bu yeterince uzun.

Son olarak, bazı gelişmeler yukarıdaki gelişme dışında kaldı. Gelen biz bir yaklaşım esas olarak üçüncü dönem göz ardı yaptı. Bunu neden yapabiliriz? Bir gözlem, normal yoğunluk işlevi için, sol-dışı teriminin hiçbir şeye katkıda bulunmadığı, böylece yaklaşıklığın kesin olduğu yönündedir. Bu yüzden, saddlepoint-yaklaşımı, merkezi limit teoreminde bir inceltme olduğundan, bu yüzden biraz normale yaklaştık, bu yüzden bu iyi sonuç vermeli. Bir de belirli örneklere bakabilirsiniz. Poisson dağılımına saddlepoint yaklaşımına bakıldığında, bu üçüncü terimden geriye bakıldığında, bu durumda, argüman sıfıra yakın olmadığında oldukça düz olan bir trigamma işlevi olur.$\eqref{**}$

Sonunda neden isim? Ad, karmaşık analiz tekniklerini kullanarak alternatif bir türevden geliyor. Daha sonra buna bakabiliriz, ama başka bir postada!

Burada kjetil'in cevabını genişletiyorum ve Kümülan Üretme Fonksiyonunun (CGF) bilinmediği durumlara odaklanıyorum, ancak , burada . En basit CGF tahmincisi muhtemelen Davison ve Hinkley (1988) ki bu kjetillerin bootstrap örneğinde kullanıldı. Bu tahmin Elde saddlepoint denklemi dezavantajına sahiptir sadece çözülebilir , biz saddlepoint yoğunluğunu değerlendirmek istiyoruz nokta, ki dışbükey gövde içine düşmektedir .$x_1,\dots,x_n$$x\in R^d$

$$\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) ve Fasiolo ve ark. (2016) bu sorunu, saddlepoint denkleminin herhangi bir için çözülebileceği şekilde tasarlanan iki alternatif CGF tahmincisi önererek ele almıştır . Fasiolo ve ark. (2016), genişletilmiş Ampirik Saddlepoint Yaklaşımı ESA olarak adlandırılan Esaddle R paketinde uygulanmıştır ve burada birkaç örnek vereceğim.$y$

Tek değişkenli basit bir örnek olarak, bir yoğunluğuna yaklaşmak için ESA'yı kullanın .$\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)

Bu uygun

Halıya bakıldığında, ESA yoğunluğunu veri aralığının dışında değerlendirdiğimiz açıktır. Daha zorlu bir örnek, aşağıdaki çarpık iki değişkenli Gaussian'dır.

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

Uyum oldukça iyi.

Kjetil'in mükemmel cevabı sayesinde, tartışmak istediğim küçük bir örnek bulmaya çalışıyorum çünkü konuyla ilgili bir noktaya değiniyor gibi görünüyor:

dağılımını göz önünde bulundurun . ve türevleri burada bulunabilir ve aşağıdaki koddaki fonksiyonlarda çoğaltılır. $\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)

Bu üretir

Bu açık bir şekilde, yoğunluğun nitel özelliklerini doğru yapan bir yaklaşım ortaya çıkarmaktadır, ancak Kjetil'in yorumunda da belirtildiği gibi, her yerdeki tam yoğunluğun üzerinde olduğu gibi uygun bir yoğunluk değildir. Yaklaştırmayı aşağıdaki gibi yeniden ölçeklendirmek, aşağıda çizilen neredeyse ihmal edilebilir yakınlaştırma hatasını verir.

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)