Mostrerò un'altra possibile soluzione, che è abbastanza ampiamente applicabile, e con il software R di oggi, abbastanza facile da implementare. Questa è l'approssimazione della densità del punto di sella, che dovrebbe essere più conosciuta!
Per la terminologia relativa alla distribuzione gamma, seguirò https://en.wikipedia.org/wiki/Gamma_distribution con la parametrizzazione di forma / scala, è il parametro di forma e è la scala. Per l'approssimazione a sella seguirò Ronald W Butler: "Approssimazioni a sella con applicazioni" (Cambridge UP). L'approssimazione del punto di sella è spiegata qui: come funziona l'approssimazione del punto di sella?
qui mostrerò come viene utilizzato in questa applicazione.kθ
Sia una variabile casuale con funzione di generazione del momento esistente
che deve esistere per in un intervallo aperto che contiene zero. Quindi definire la funzione di generazione cumulativa per
È noto che . L'equazione del punto di sella è che definisce implicitamente come una funzione di (che deve essere compresa nell'intervallo di ). Scriviamo questa funzione implicitamente definita come
. Si noti che l'equazione del punto di sella ha sempre esattamente una soluzione, poiché la funzione cumulativa è convessa. M ( s ) = E e s X s K ( s ) = log M ( s ) E X = K ′ ( 0 ) , Var ( X ) = K ″X
M(s)=EesX
sK(s)=logM(s)
EX=K′(0),Var(X)=K′′(0)K′(s^)=x
sxXs^(x)
Quindi l'approssimazione del punto di sella alla densità di è data da
Questa funzione di densità approssimativa non è garantita per integrarsi a 1, così come l'approssimazione del punto di sella non normalizzata. Potremmo integrarlo numericamente e rinormalizzarlo per ottenere una migliore approssimazione. Ma questa approssimazione è garantita non negativa.fX
f^(x)=12πK′′(s^)−−−−−−−√exp(K(s^)−s^x)
Ora lascia che siano variabili gamma casuali indipendenti, dove ha la distribuzione con parametri . Quindi la funzione di generazione cumulativa è
definita per . La prima derivata è
e la seconda derivata è
Di seguito fornirò un codice per calcolare questo, e userò i valori dei parametri , ,X1,X2,…,XnXi(ki,θi)
K(s)=−∑i=1nkiln(1−θis)
s<1/max(θ1,θ2,…,θn)K′(s)=∑i=1nkiθi1−θis
K′′(s)=∑i=1nkiθ2i(1−θis)2.
Rn=3k=(1,2,3)θ=(1,2,3). Si noti che il
Rcodice seguente utilizza un nuovo argomento nella funzione uniroot introdotta in R 3.1, quindi non verrà eseguito in R precedenti.
shape <- 1:3 #ki
scale <- 1:3 # thetai
# For this case, we get expectation=14, variance=36
make_cumgenfun <- function(shape, scale) {
# we return list(shape, scale, K, K', K'')
n <- length(shape)
m <- length(scale)
stopifnot( n == m, shape > 0, scale > 0 )
return( list( shape=shape, scale=scale,
Vectorize(function(s) {-sum(shape * log(1-scale * s) ) }),
Vectorize(function(s) {sum((shape*scale)/(1-s*scale))}) ,
Vectorize(function(s) { sum(shape*scale*scale/(1-s*scale)) })) )
}
solve_speq <- function(x, cumgenfun) {
# Returns saddle point!
shape <- cumgenfun[[1]]
scale <- cumgenfun[[2]]
Kd <- cumgenfun[[4]]
uniroot(function(s) Kd(s)-x,lower=-100,
upper = 0.3333,
extendInt = "upX")$root
}
make_fhat <- function(shape, scale) {
cgf1 <- make_cumgenfun(shape, scale)
K <- cgf1[[3]]
Kd <- cgf1[[4]]
Kdd <- cgf1[[5]]
# Function finding fhat for one specific x:
fhat0 <- function(x) {
# Solve saddlepoint equation:
s <- solve_speq(x, cgf1)
# Calculating saddlepoint density value:
(1/sqrt(2*pi*Kdd(s)))*exp(K(s)-s*x)
}
# Returning a vectorized version:
return(Vectorize(fhat0))
} #end make_fhat
fhat <- make_fhat(shape, scale)
plot(fhat, from=0.01, to=40, col="red", main="unnormalized saddlepoint approximation\nto sum of three gamma variables")
risultante nel seguente diagramma:
Lascerò l'approssimazione a sella normalizzata come esercizio.
