Tìm cách mô phỏng các số ngẫu nhiên cho phân phối này

Tôi đang cố gắng viết một chương trình trong R mô phỏng các số ngẫu nhiên giả từ một phân phối với hàm phân phối tích lũy:

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

trong đó$a,b>0, p \in (0,1)$

Tôi đã thử lấy mẫu biến đổi nghịch đảo nhưng dường như không thể phân tích được nghịch đảo. Tôi sẽ rất vui nếu bạn có thể đề xuất một giải pháp cho vấn đề này

Có một giải pháp đơn giản (và nếu tôi có thể thêm, thanh lịch) cho bài tập này: vì xuất hiện như một sản phẩm của hai bản phân phối tồn tại: phân phối là phân phối của Trong trường hợp này F_1 là Exponential \ mathcal {E} (a) phân phối và F_2 là 1 / (p + 1) -thứ sức mạnh của phân phối lũy thừa \ mathcal {E} (b / (p + 1)) .$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))$

Mã R liên quan đơn giản như nó nhận được

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

và nó chắc chắn nhanh hơn nhiều so với độ phân giải pdf và chấp nhận từ chối:

> 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 

với một sự phù hợp hoàn hảo không ngạc nhiên:

Bạn luôn có thể giải quyết số lượng biến đổi nghịch đảo.

Dưới đây, tôi làm một tìm kiếm chia đôi rất đơn giản. Đối với xác suất đầu vào đã cho (Tôi sử dụng vì bạn đã có trong công thức của mình), tôi bắt đầu với và . Sau đó, tôi nhân đôi cho đến khi . Cuối cùng, tôi lặp lại chia đôi khoảng cho đến khi chiều dài của nó ngắn hơn và điểm giữa của nó thỏa mãn .$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$

ECDF phù hợp với của bạn đủ tốt cho các lựa chọn của tôi về và , và nó khá nhanh. Bạn có thể có thể tăng tốc độ này bằng cách sử dụng một số tối ưu hóa kiểu Newton thay vì tìm kiếm chia đôi đơn giản.$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")

Có một chút phức tạp nếu giải quyết trực tiếp bằng cách chấp nhận từ chối. Đầu tiên, một sự khác biệt đơn giản cho thấy pdf của phân phối là Thứ hai, vì chúng ta có giới hạn trên Thứ ba, xem xét thuật ngữ thứ hai trong , hãy thay đổi biến , tức là . Sau đó là Jacobian của sự thay đổi của biến. Nếu

$$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$có mật độ có dạng trong đó là hằng số chuẩn hóa, sau đó có mật độ có nghĩa là (i) là được phân phối dưới dạng biến thiên theo hàm mũ và (ii) hằng số bằng một. Do đó, cuối cùng bằng với hỗn hợp có trọng số bằng nhau của phân bố lũy thừa và công suất của lũy thừa$\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))$phân phối, modulo một hằng số nhân thiếu của để tính các trọng số: Và rất đơn giản để mô phỏng như một hỗn hợp.$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$

Do đó, kết xuất R của thuật toán chấp nhận từ chối

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

và cho một mẫu 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])}

Đây là một minh họa cho a = 1, b = 2, p = 3: