Come funziona l'approssimazione del punto di sella?

Come funziona l'approssimazione del punto di sella? Per quale tipo di problema è utile?
(Sentiti libero di usare un esempio o esempi particolari a titolo illustrativo)

Ci sono svantaggi, difficoltà, cose a cui fare attenzione o trappole per gli incauti?

L'approssimazione a sella di una funzione di densità di probabilità (funziona allo stesso modo per le funzioni di massa, ma parlerò qui solo in termini di densità) è un'approssimazione sorprendentemente ben funzionante, che può essere vista come un perfezionamento del teorema del limite centrale. Pertanto, funzionerà solo in contesti in cui esiste un teorema limite centrale, ma necessita di presupposti più forti.

Partiamo dal presupposto che la funzione generatrice del momento esiste ed è due volte differenziabile. Ciò implica in particolare che tutti i momenti esistono. Sia una variabile casuale con funzione di generazione del momento (mgf) e cgf (funzione di generazione cumulativa) (dove \ log indica il logaritmo naturale). Nello sviluppo seguirò da vicino Ronald W Butler: "Saddlepoint Approximations with Applications" (CUP). Svilupperemo l'approssimazione del punto di sella usando l'approssimazione di Laplace a un certo integrale. Scrivi $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$$ dove $h(t,x) = -tx - \log f(x)$ . Ora Taylor espanderà$h(t,x)$ in$x$ considerando$t$ come costante. Questo dà $$h(t,x)=h(t,x_0) + h'(t,x_0)(x-x_0) +\frac12 h''(t,x_0) (x-x_0)^2 +\dotsm$$ dove$'$ indica la differenziazione rispetto a$x$ . Notare che $$h'(t,x)=-t-\frac{\partial}{\partial x}\log f(x) \\ h''(t,x)= -\frac{\partial^2}{\partial x^2} \log f(x) > 0$$ (l'ultima disuguaglianza per ipotesi in quanto è necessaria affinché l'approssimazione funzioni). Lascia$x_t$sii la soluzione per $h'(t,x_t)=0$ . Supponiamo che questo dia un minimo per $h(t,x)$ in funzione di $x$ . Usando questa espansione nell'integrale e dimenticando la parte $\dotsm$ , si ottiene $$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$$ che è un integrale gaussiano, che dà $$e^{K(t)} \approx e^{-h(t,x_t)} \sqrt{\frac{2\pi}{h''(t,x_t)}}.$$ Questo fornisce (una prima versione) dell'approssimazione del punto di sella come $$f(x_t) \approx \sqrt{\frac{h''(t,x_t)}{2\pi}} \exp(K(t) -t x_t) \\ \tag{*} \label{*}$$ Si noti che l'approssimazione ha la forma di una famiglia esponenziale.

Ora dobbiamo fare un po 'di lavoro per ottenere questo in una forma più utile.

Da otteniamo La differenziazione rispetto a dà (secondo i nostri presupposti), quindi la relazione tra e è monotona, quindi è ben definita. Abbiamo bisogno di un'approssimazione a . A tal fine, otteniamo risolvendo da$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{**}$$ Supponendo che l'ultimo termine sopra dipenda solo debolmente da , quindi la sua derivata rispetto a è approssimativamente zero (torneremo a commentare questo), otteniamo Fino a questa approssimazione abbiamo quindi quel modo che e debbano essere correlati attraverso l'equazione che si chiama equazione a sella. $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{§}$$

Ciò che ci manca ora nel determinare è e che possiamo trovare per differenziazione implicita dell'equazione del punto di sella : Il risultato è che (fino alla nostra approssimazione) Mettendo tutto insieme, abbiamo l'approssimazione finale a sella della densità come $\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)}}.$$ Ora, per usarlo praticamente, per approssimare la densità in un punto specifico , risolviamo l'equazione del punto di sella affinché quella trovi .$x_t$$x_t$$t$

L'approssimazione del punto di sella viene spesso indicata come approssimazione della densità della media in base a osservazioni . La funzione di generazione cumulativa della media è semplicemente , quindi l'approssimazione del punto di sella per la media diventa $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)}}$$

Vediamo un primo esempio. Cosa otteniamo se proviamo ad approssimare la densità normale standard Il mgf è quindi quindi l'equazione del punto di sella è e l'approssimazione del punto di sella fornisce quindi in questo caso l'approssimazione è esatta.

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

Esaminiamo un'applicazione molto diversa: Bootstrap nel dominio di trasformazione, possiamo eseguire il bootstrap analiticamente usando l'approssimazione a sella alla distribuzione bootstrap della media!

Supponiamo di avere iid distribuiti da una certa densità (nell'esempio simulato useremo una distribuzione esponenziale dell'unità). Dal campione calcoliamo la funzione generatrice del momento empirico e quindi il cgf . Abbiamo bisogno del mgf empirico per la media che è e del cgf empirico per la media che usiamo per costruire un'approssimazione a sella. Di seguito alcuni codici R (R versione 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

(Ho provato a scrivere questo come codice generale che può essere modificato facilmente per altri cgfs, ma il codice non è ancora molto robusto ...)

Quindi usiamo questo per un campione di dieci osservazioni indipendenti da una distribuzione esponenziale unitaria. Facciamo il solito bootstrap non parametrico "a mano", tracciamo l'istogramma del bootstrap risultante per la media e sovrapponiamo l'approssimazione del punto di sella:

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

Dare la trama risultante:

L'approssimazione sembra essere piuttosto buona!

Potremmo ottenere un'approssimazione ancora migliore integrando l'approssimazione a sella e il ridimensionamento:

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

Ora la funzione di distribuzione cumulativa basata su questa approssimazione potrebbe essere trovata mediante l'integrazione numerica, ma è anche possibile effettuare un'approssimazione diretta a sella per questo. Ma questo è per un altro post, questo è abbastanza lungo.

Infine, alcuni commenti lasciati fuori dallo sviluppo sopra. In abbiamo fatto un'approssimazione essenzialmente ignorando il terzo termine. Perché possiamo farlo? Un'osservazione è che per la normale funzione di densità, il termine lasciato fuori non contribuisce a nulla, quindi l'approssimazione è esatta. Quindi, poiché l'approssimazione del punto di sella è un perfezionamento del teorema del limite centrale, quindi siamo in qualche modo vicini al normale, quindi dovrebbe funzionare bene. Uno può anche guardare esempi specifici. Guardando l'approssimazione a sella alla distribuzione di Poisson, guardando quel terzo termine lasciato fuori, in questo caso diventa una funzione trigamma, che in effetti è piuttosto piatta quando l'argomento non è vicino allo zero.$\eqref{**}$

Infine, perché il nome? Il nome deriva da una derivazione alternativa, usando tecniche di analisi complesse. Più tardi possiamo esaminarlo, ma in un altro post!

Qui espanderò la risposta di Kjetil e mi concentrerò su quelle situazioni in cui la Cumulant Generating Function (CGF) è sconosciuta, ma può essere stimata dai dati , dove . Lo stimatore CGF più semplice è probabilmente quello di Davison e Hinkley (1988) che è quello usato nell'esempio bootstrap di kjetil. Questo stimatore ha lo svantaggio che l'equazione del punto di sella risultante può essere risolta solo se , il punto in cui vogliamo valutare la densità del punto di sella, rientra nello scafo convesso di .$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) e Fasiolo et al. (2016) hanno affrontato questo problema proponendo due stimatori CGF alternativi, progettati in modo tale che l'equazione del punto di sella possa essere risolta per qualsiasi . La soluzione di Fasiolo et al. (2016), chiamato Extended Emotionical Saddlepoint Approximation ESA, è implementato nel pacchetto esaddle R e qui fornisco un paio di esempi.$y$

Come semplice esempio univariato, considerare l'utilizzo dell'ESA per approssimare una densità .$\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)

Questa è la misura giusta

Guardando il tappeto è chiaro che abbiamo valutato la densità ESA al di fuori dell'intervallo dei dati. Un esempio più impegnativo è il seguente gaussiano deformato bivariato.

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

La vestibilità è abbastanza buona.

Grazie alla grande risposta di Kjetil, sto provando a farmi un piccolo esempio, di cui vorrei discutere perché sembra sollevare un punto rilevante:

Considera la distribuzione . e i suoi derivati ​​possono essere trovati qui e sono riprodotti nelle funzioni nel codice seguente. $\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)

Questo produce

Ciò ovviamente produce un'approssimazione che ottiene giustamente le caratteristiche qualitative della densità, ma, come confermato nel commento di Kjetil, non è una densità adeguata, poiché è al di sopra della densità esatta ovunque. Ricalcare l'approssimazione come segue dà l'errore di trascuratezza quasi trascurabile tracciato di seguito.

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)