Vi è una risoluzione un po 'contorta se diretta da accettare-rifiutare. Innanzitutto, una semplice differenziazione mostra che il pdf della distribuzione è
Secondo, poiché
abbiamo il limite superiore
Terzo, considerando il secondo termine in , prendi il cambiamento della variabile , ovvero . Quindi
è il giacobino del cambiamento di variabile. Sef(x)=(a+bxp)exp{−ax−bp+1xp+1}
f(x)=ae−axe−bxp+1/(p+1)≤1+bxpe−bxp+1/(p+1)e−ax≤1
f(x)≤g(x)=ae−ax+bxpe−bxp+1/(p+1)
gξ=xp+1x=ξ1/(p+1)dxdξ=1p+1ξ1p+1−1=1p+1ξ−pp+1
Xha una densità della forma dove è la costante normalizzante, quindi ha la densità
che significa che (i) è distribuito come una variabile esponenziale e (ii) la costante è uguale a una. Pertanto, finisce per essere uguale alla miscela equamente ponderata di una distribuzione esponenziale e alla potenza un'esponenzialeκbxpe−bxp+1/(p+1)κΞ=X1/(p+1)κbξpp+1e−bξ/(p+1)1p+1ξ−pp+1=κbp+1e−bξ/(p+1)
ΞE(b/(p+1))κg(x)E(a)1/(p+1)E(b/(p+1))distribuzione, modulo una costante moltiplicativa mancante di per tenere conto dei pesi:
E è semplice da simulare come una miscela.2f(x)≤g(x)=2(12ae−ax+12bxpe−bxp+1/(p+1))
g
Un rendering R dell'algoritmo accetta-rifiuta è quindi
simuF <- function(a,b,p){
reepeat=TRUE
while (reepeat){
if (runif(1)<.5) x=rexp(1,a) else
x=rexp(1,b/(p+1))^(1/(p+1))
reepeat=(runif(1)>(a+b*x^p)*exp(-a*x-b*x^(p+1)/(p+1))/
(a*exp(-a*x)+b*x^p*exp(-b*x^(p+1)/(p+1))))}
return(x)}
e per un campione n:
simuF <- function(n,a,b,p){
sampl=NULL
while (length(sampl)<n){
x=u=sample(0:1,n,rep=TRUE)
x[u==0]=rexp(sum(u==0),b/(p+1))^(1/(p+1))
x[u==1]=rexp(sum(u==1),a)
sampl=c(sampl,x[runif(n)<(a+b*x^p)*exp(-a*x-b*x^(p+1)/(p+1))/
(a*exp(-a*x)+b*x^p*exp(-b*x^(p+1)/(p+1)))])
}
return(sampl[1:n])}
Ecco un'illustrazione per a = 1, b = 2, p = 3: