Mostrarei outra solução possível, que é amplamente aplicável e, com o software R de hoje, bastante fácil de implementar. Essa é a aproximação da densidade do ponto de sela, que deve ser mais conhecida!
Para terminologia sobre a distribuição gama, seguirei https://en.wikipedia.org/wiki/Gamma_distribution com a parametrização shape / scale, é o parâmetro shape e é scale. Para a aproximação do ponto de sela, seguirei Ronald W. Butler: "Aproximações do ponto de sela com aplicações" (Cambridge UP). A aproximação do ponto de sela é explicada aqui: Como funciona a aproximação do ponto de sela?
aqui vou mostrar como é usado nesta aplicação.θkθ
Seja uma variável aleatória com a função geradora de momento existente
que deve existir por em algum intervalo aberto que contenha zero. Em seguida, defina a função geradora cumulante por
Sabe-se que . A equação do ponto de sela é que define implicitamente como uma função de (que deve estar no intervalo de ). Nós escrevemos essa função implicitamente definida como
. Observe que a equação do ponto de sela sempre tem exatamente uma solução, porque a função cumulante é convexa. H ( s ) = E e s X s K ( s ) = log M ( s ) E X = K ' ( 0 ) , Var ( X ) = K " ( 0 ) K ' ( s ) = x s x X s ( x )X
M( s ) = Ees X
sK( s ) = logM( S )
EX= K′( 0 ) , Var ( X) = K′ ′( 0 )K′( s^) = x
sxXs^( X )
Então a aproximação do ponto de sela à densidade de é dada por
Não é garantido que esta função de densidade aproximada seja integrada a 1, assim como a aproximação não normalizada do ponto de sela. Poderíamos integrá-lo numericamente e renormalizar para obter uma melhor aproximação. Mas essa aproximação é garantida para não ser negativa.X f ( x ) = 1fX
f^( x ) = 12 πK′ ′( s^)-------√exp( K( s^) - s^x )
Agora, sejam variáveis variáveis aleatórias gama independentes, onde possui a distribuição com parâmetros . Então a função geradora cumulante é
definida para . A primeira derivada é
e a segunda derivada é
A seguir, darei algum código para calcular isso e usarei os valores de parâmetro , ,X i ( k i , θ i ) K ( s ) = - n ∑ i = 1 k i ln ( 1 - θ i s ) s < 1 / máx ( θ 1 , θ 2 , … , θ n ) K ′ ( sX1, X2, … , XnXEu( kEu, θEu)
K( s ) = - ∑i = 1nkEuem( 1 - θEus )
s < 1 / máx ( θ1, θ2, … , Θn)K′( s ) = ∑i = 1nkEuθEu1 - θEus
K′ ′( s ) = ∑i = 1nkEuθ2Eu( 1 - θEus )2.
Rn = 3k = ( 1 , 2 , 3 )θ = ( 1 , 2 , 3 ). Observe que o
Rcódigo a seguir usa um novo argumento na função uniroot introduzida no R 3.1, portanto, não será executado nos R's mais antigos.
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")
resultando na seguinte plotagem:
Vou deixar a aproximação do ponto de sela normalizada como um exercício.
