Trovare un modo per simulare numeri casuali per questa distribuzione

Sto cercando di scrivere un programma in R che simula numeri pseudo casuali da una distribuzione con la funzione di distribuzione cumulativa:

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

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

Ho provato il campionamento della trasformata inversa ma l'inverso non sembra risolvibile dal punto di vista analitico. Sarei felice se potessi suggerire una soluzione a questo problema

C'è una soluzione semplice (e se posso aggiungere, elegante) a questo esercizio: poiché $1-F(x)$ appare come un prodotto di due distribuzioni di sopravvivenza:

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

Il codice R associato è il più semplice possibile

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

ed è sicuramente molto più veloce del pdf inverso e accetta le risoluzioni:

> 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 

con una vestibilità sorprendentemente perfetta:

Puoi sempre risolvere numericamente la trasformazione inversa.

Di seguito, eseguo una ricerca bisection molto semplice. Per una data probabilità di input (uso poiché hai già una nella tua formula), inizio con e . Quindi raddoppio fino a . Infine, l'intervallo fino a quando la sua lunghezza è inferiore a e il suo punto medio soddisfa .$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 si adatta al vostro abbastanza bene per le mie scelte di e , ed è ragionevolmente veloce. Probabilmente potresti accelerare questo usando una ottimizzazione di tipo Newton invece della semplice ricerca di bisection.$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")

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. Se

$$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$ha 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$\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))$distribuzione, modulo una costante moltiplicativa mancante di per tenere conto dei pesi: E è semplice da simulare come una miscela.$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 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: