Trovare un modo per simulare numeri casuali per questa distribuzione


20

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

F(x)=1exp(axbp+1xp+1),x0

dove a,b>0,p(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


1
Non c'è abbastanza tempo per una risposta completa, ma è possibile controllare gli algoritmi di Importance Sampling, in alternativa.
scegli il

1
non è un esercizio da manuale, ho solo stabilito il vincolo perché è un presupposto ragionevole per i miei dati
Sebastian

6
Sono quindi sorpreso dalla normalizzazione "miracolosa" di (p+1)1 che trasforma la distribuzione in un potere perfetto di un esponenziale, ma i miracoli accadono (con poca probabilità).
Xi'an,

Risposte:


49

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

(1F(x))=exp{axbp+1xp+1}=exp{ax}1F1(x)exp{bp+1xp+1}1F2(x)
F
X=min{X1,X2}X1F1,X2F2
F1E(a)F21/(p+1)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:

inserisci qui la descrizione dell'immagine


5
soluzione davvero interessante!
Sebastian

14

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 .qqpxL=0xR=1xRF(xR)>q[xL,xR]ϵxMF(xM)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.Fab

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

ECDF


10

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+bxp)exp{axbp+1xp+1}
f(x)=aeaxebxp+1/(p+1)1+bxpebxp+1/(p+1)eax1
f(x)g(x)=aeax+bxpebxp+1/(p+1)
gξ=xp+1x=ξ1/(p+1)
dxdξ=1p+1ξ1p+11=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κbxpebxp+1/(p+1)κΞ=X1/(p+1)
κbξpp+1ebξ/(p+1)1p+1ξpp+1=κbp+1ebξ/(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.2
f(x)g(x)=2(12aeax+12bxpebxp+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:

inserisci qui la descrizione dell'immagine

Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.