Как работает приближение седловой точки?

Как работает приближение седловой точки? Для каких проблем это хорошо?
(Не стесняйтесь использовать конкретный пример или примеры в качестве иллюстрации)

Есть ли какие-либо недостатки, трудности, вещи, на которые стоит обратить внимание, или ловушки для неосторожных?

Седловое приближение к функции плотности вероятности (она работает аналогично для массовых функций, но я буду говорить здесь только в терминах плотностей) - это удивительно хорошо работающее приближение, которое можно рассматривать как уточнение центральной предельной теоремы. Таким образом, он будет работать только в тех случаях, когда существует центральная предельная теорема, но для этого нужны более строгие предположения.

Начнем с предположения, что функция, порождающая момент, существует и является дважды дифференцируемой. Это подразумевает, в частности, что все моменты существуют. Пусть $X$ - случайная величина с генерирующей момент функцией (mgf)

$$\DeclareMathOperator{\E}{\mathbb{E}} M(t) = \E e^{t X}$$ и cgf (генерирующая функция кумулянта) $K(t)=\log M(t)$ (где $\log$обозначает натуральный логарифм). В процессе разработки я буду внимательно следить за Рональдом У. Батлером: «Приближения седловой точки с приложениями» (CUP). Мы разработаем приближение седловой точки, используя приближение Лапласа к некоторому интегралу. Напишите $$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$$ где $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$. Предположим, что это дает минимум для $h(t,x)$как функции от$x$. Используя это разложение в интеграле и забыв прочасть$\dotsm$, получим $$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$$ - гауссовский интеграл, дающий $$e^{K(t)} \approx e^{-h(t,x_t)} \sqrt{\frac{2\pi}{h''(t,x_t)}}.$$ Это дает (первый вариант) приближения седловой точки как $$f(x_t) \approx \sqrt{\frac{h''(t,x_t)}{2\pi}} \exp(K(t) -t x_t) \\ \tag{*} \label{*}$$ Обратите внимание, что аппроксимация имеет вид экспоненциального семейства.

Теперь нам нужно проделать некоторую работу, чтобы получить это в более полезной форме.

Из мы получаем Дифференцируя это по получаем (по нашим предположениям), образом, связь между и является монотонной, поэтому четко определена. Нам нужно приближение к . Для этого мы получаем решение из$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{**}$$ Предполагая, что последний член, приведенный выше, слабо зависит от , поэтому его производная по приблизительно равна нулю (мы еще вернемся к комментариям по этому поводу), мы получим Тогда до этого приближения мы получим, что так что и должны быть связаны через уравнение который называется уравнением седловой точки. $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{§}$$

Что мы упускаем при определении это и что мы можем найти путем неявного дифференцирования уравнения в седловой точке : Результатом является то, что (с точностью до нашего приближения) Собрав все вместе, мы получим окончательное приближение седловой точки плотности как $\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)}}.$$ Теперь, чтобы использовать это практически, чтобы приблизить плотность в определенной точке , мы решаем уравнение седловой точки для этого чтобы найти .$x_t$$x_t$$t$

Приближение перевала часто указывается как приближение к плотности среднее на основании н.о.р. наблюдений . Производящая функция кумулянта среднего - это просто , поэтому приближение седловой точки для среднего становится $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)}}$$

Давайте посмотрим на первый пример. Что мы получим, если попытаться приблизить стандартную нормальную плотность mgf: так что поэтому уравнение седловой точки и приближение седловой точки дает так что в этом случае приближение является точным.

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

Давайте посмотрим на совсем другое приложение: начальную загрузку в области преобразования, мы можем выполнить загрузку аналитически, используя приближение седловой точки к загрузочному распределению среднего!

Предположим, у нас есть распределенные по некоторой плотности (в смоделированном примере мы будем использовать единичное экспоненциальное распределение). Из выборки мы вычисляем эмпирическую функцию, генерирующую моменты, а затем эмпирическую cgf . Нам нужно эмпирическое значение mgf для среднего значения, которое является и эмпирическое значение cgf для среднего значения который мы используем для построения седлового приближения. Ниже приведен код R (версия 3.2.3 R): $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

(Я пытался написать это как общий код, который можно легко модифицировать для других cgfs, но код все еще не очень надежен ...)

Затем мы используем это для выборки из десяти независимых наблюдений из единичного экспоненциального распределения. Мы делаем обычную непараметрическую начальную загрузку «вручную», строим итоговую гистограмму начальной загрузки для среднего значения и выводим приближение седловой точки:

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

Предоставление полученного участка:

Аппроксимация кажется довольно хорошей!

Мы могли бы получить еще лучшее приближение, интегрировав приближение седловой точки и масштабирование:

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

Теперь кумулятивная функция распределения, основанная на этом приближении, может быть найдена путем численного интегрирования, но для этого также можно сделать прямое приближение седловой точки. Но это для другого поста, этого достаточно долго.

Наконец, некоторые комментарии остались вне разработки выше. В мы сделали приближение, по существу игнорируя третий член. Почему мы можем это сделать? Одно наблюдение состоит в том, что для нормальной функции плотности оставленный член ничего не дает, поэтому приближение является точным. Итак, поскольку седловая аппроксимация является уточнением центральной предельной теоремы, мы немного приблизились к нормали, поэтому это должно хорошо работать. Можно также посмотреть на конкретные примеры. Глядя на приближение седловой точки к распределению Пуассона, глядя на этот пропущенный третий член, в этом случае он становится тригамма-функцией, которая действительно довольно плоская, когда аргумент не близок к нулю.$\eqref{**}$

Наконец, почему имя? Название происходит от альтернативного происхождения, используя методы комплексного анализа. Позже мы можем рассмотреть это, но в другом посте!

Здесь я подробно остановлюсь на ответе kjetil и остановлюсь на тех ситуациях, когда функция генерации кумулянта (CGF) неизвестна, но ее можно оценить по данным , где . Самая простая оценка CGF - это, вероятно, оценка Дэвисона и Хинкли (1988) который используется в примере начальной загрузки kjetil. Недостатком этой оценки является то, что полученное уравнение седловой точки может быть решено, только если , точка, в которой мы хотим оценить плотность седловой точки, попадает в выпуклую оболочку .$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) и Fasiolo et al. (2016) решили эту проблему, предложив две альтернативные оценки CGF, сконструированные таким образом, чтобы уравнение седловой точки могло быть решено для любого . Решение Fasiolo et al. (2016), называемый расширенным Эмпирическим СЭП по Седловой точке, реализован в пакете esaddle R, и здесь я привожу несколько примеров.$y$

В качестве простого одномерного примера рассмотрите возможность использования ESA для аппроксимации плотности .$\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)

Это подходит

Глядя на ковер, становится ясно, что мы оценили плотность ESA за пределами диапазона данных. Более сложным примером является следующий искривленный двумерный гауссов.

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

Подгонка довольно хорошая.

Благодаря замечательному ответу Кжетила я сам пытаюсь привести небольшой пример, который я хотел бы обсудить, потому что он, кажется, поднимает важный вопрос:

Рассмотрим . и его производные могут быть найдены здесь и воспроизведены в функциях в коде ниже. $\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)

Это производит

Это, очевидно, приводит к приближению, которое дает качественные характеристики правильной плотности, но, как подтверждается в комментарии Кжетила, не является правильной плотностью, так как она выше точной плотности везде. Изменение масштаба аппроксимации следующим образом дает почти ничтожную ошибку аппроксимации, представленную ниже.

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)