Trouver un moyen de simuler des nombres aléatoires pour cette distribution

J'essaie d'écrire un programme en R qui simule des nombres pseudo aléatoires à partir d'une distribution avec la fonction de distribution cumulative:

$$F(x)= 1-\exp \left(-ax-\frac{b}{p+1}x^{p+1}\right), \quad x \geq 0$$

où$a,b>0, p \in (0,1)$

J'ai essayé l'échantillonnage par transformée inverse mais l'inverse ne semble pas résoluble analytiquement. Je serais heureux si vous pouviez suggérer une solution à ce problème

Il existe une solution simple (et si je peux ajouter, élégante) à cet exercice: puisque apparaît comme le produit de deux distributions de survie: la distribution est la distribution de Dans ce cas, est la distribution exponentielle et est la -ième puissance d'une distribution exponentielle .$1-F(x)$

$$(1-F(x))=\exp\left\{-ax-\frac{b}{p+1}x^{p+1}\right\}=\underbrace{\exp\left\{-ax\right\}}_{1-F_1(x)}\underbrace{\exp\left\{-\frac{b}{p+1}x^{p+1}\right\}}_{1-F_2(x)}$$ $F$ $$X=\min\{X_1,X_2\}\qquad X_1\sim F_1\,,X_2\sim F_2$$ $F_1$$\mathcal{E}(a)$$F_2$$1/(p+1)$$\mathcal{E}(b/(p+1))$

Le code R associé est aussi simple que possible

x=pmin(rexp(n,a),rexp(n,b/(p+1))^(1/(p+1))) #simulating an n-sample

et il est nettement plus rapide que les résolutions PDF inverses et acceptation-rejet:

> n=1e6
> system.time(results <- Vectorize(simulate,"prob")(runif(n)))
utilisateur     système      écoulé 
    89.060       0.072      89.124 
> system.time(x <- simuF(n,1,2,3))
utilisateur     système      écoulé 
     1.080       0.020       1.103 
> system.time(x <- pmin(rexp(n,a),rexp(n,b/(p+1))^(1/(p+1))))
utilisateur     système      écoulé 
     0.160       0.000       0.163 

avec un ajustement parfait sans surprise:

Vous pouvez toujours résoudre numériquement la transformation inverse.

Ci-dessous, je fais une recherche de bissection très simple. Pour une probabilité d'entrée donnée (j'utilise puisque vous avez déjà un dans votre formule), je commence par et . Ensuite, je double jusqu'à . Enfin, je bissecte itérativement l'intervalle jusqu'à ce que sa longueur soit plus courte que et que son point milieu satisfasse .$q$$q$$p$$x_L=0$$x_R=1$$x_R$$F(x_R)>q$$[x_L,x_R]$$\epsilon$$x_M$$F(x_M)\approx q$

L'ECDF s'adapte assez bien à votre pour mes choix de et , et c'est assez rapide. Vous pourriez probablement accélérer cela en utilisant une optimisation de type Newton au lieu de la recherche de bissection simple.$F$$a$$b$

aa <- 2
bb <- 1
pp <- 0.1

cdf <- function(x) 1-exp(-aa*x-bb*x^(pp+1)/(pp+1))

simulate <- function(prob,epsilon=1e-5) {
    left <- 0
    right <- 1
    while ( cdf(right) < prob ) right <- 2*right

    while ( right-left>epsilon ) {
        middle <- mean(c(left,right))
        value_middle <- cdf(middle)
        if ( value_middle < prob ) left <- middle else right <- middle
    }

    mean(c(left,right))
}

set.seed(1)
results <- Vectorize(simulate,"prob")(runif(10000))
hist(results)

xx <- seq(0,max(results),by=.01)
plot(ecdf(results))
lines(xx,cdf(xx),col="red")

Il y a une résolution quelque peu compliquée si directe par acceptation-rejet. Tout d'abord, une différenciation simple montre que le pdf de la distribution est Deuxièmement, puisque nous avons la borne supérieure Troisièmement, considérant le deuxième terme en , prendre le changement de variable , c'est-à-dire . Alors est le jacobien du changement de variable. Si

$$f(x)=(a+bx^p)\exp\left\{-ax-\frac{b}{p+1}x^{p+1}\right\}$$ $$f(x)=ae^{-ax}\underbrace{e^{-bx^{p+1}/(p+1)}}_{\le 1}+bx^pe^{-bx^{p+1}/(p+1)}\underbrace{e^{-ax}}_{\le 1}$$ $$f(x)\le g(x)=ae^{-ax}+bx^pe^{-bx^{p+1}/(p+1)}$$ $g$$\xi=x^{p+1}$$x=\xi^{1/(p+1)}$ $$\dfrac{\text{d}x}{\text{d}\xi}=\dfrac{1}{p+1}\xi^{\frac{1}{p+1}-1}=\dfrac{1}{p+1}\xi^{\frac{-p}{p+1}}$$ $X$a une densité de la forme où est la constante de normalisation, alors a la densité ce qui signifie que (i) est distribué comme une variable exponentielle et (ii) la constante est égale à un. Par conséquent, finit par être égal au mélange également pondéré d'une distribution exponentielle et de la puissance -ième d'une puissance exponentielle$\kappa bx^pe^{-bx^{p+1}/(p+1)}$$\kappa$$\Xi=X^{1/(p+1)}$ $$\kappa b\xi^{\frac{p}{p+1}}e^{-b\xi/(p+1)}\,\dfrac{1}{p+1}\xi^{\frac{-p}{p+1}}=\kappa \dfrac{b}{p+1}e^{-b\xi/(p+1)}$$ $\Xi$$\mathcal{E}(b/(p+1))$$\kappa$$g(x)$$\mathcal{E}(a)$$1/(p+1)$$\mathcal{E}(b/(p+1))$distribution, modulo une constante multiplicative manquante de pour tenir compte des poids: Et est simple à simuler comme un mélange.$2$ $$f(x)\le g(x)=2\left(\frac{1}{2} ae^{-ax}+\frac{1}{2} bx^pe^{-bx^{p+1}/(p+1)}\right)$$ $g$

Un rendu R de l'algorithme d'acceptation-rejet est donc

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

et pour un n-échantillon:

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

Voici une illustration pour a = 1, b = 2, p = 3: