이 분포에 대한 난수를 시뮬레이션하는 방법 찾기


20

누적 분포 함수를 사용하여 분포에서 의사 난수를 시뮬레이션하는 프로그램을 R로 작성하려고합니다.

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

여기서 a,b>0,p(0,1)

역변환 샘플링을 시도했지만 역으로 분석 할 수없는 것 같습니다. 이 문제에 대한 해결책을 제안 할 수 있다면 기쁠 것입니다.


1
완전한 답변을 얻을 시간이 충분하지 않지만 대안으로 중요도 샘플링 알고리즘을 확인할 수 있습니다.
chuse

1
그것은 교과서 연습이 아니며, 데이터에 대한 합리적인 가정이기 때문에 제한을 규정했습니다
Sebastian

6
나는 그 다음으로 "기적"정상화에 놀라게하고있다 지수의 완벽한 전원에 배포 켜졌지만 기적은 (작은 확률)이 일어날 않습니다. (p+1)1
시안

답변:


49

이 연습에는 간단한 (그리고 우아하게 추가 할 수 있다면) 해결책이 있습니다. 1F(x) 는 두 개의 생존 분포의 곱처럼 보이기 때문에 :

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

관련된 R 코드는 얻는 것만 큼 간단합니다.

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

그리고 그것은 역 pdf 및 수락 거부 해상도보다 훨씬 빠릅니다.

> 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 

놀랍도록 완벽한 착용감 :

여기에 이미지 설명을 입력하십시오


5
정말 멋진 솔루션!
세바스찬

14

항상 역변환을 수치 적으로 해결할 수 있습니다.

아래에서는 매우 간단한 이분법 검색을 수행합니다. 주어진 입력 확률 ( 식에 이미 가 있으므로 를 및 합니다. 그런 다음 까지 두 배로 합니다. 마지막으로, 길이가 보다 짧고 중간 점 만족할 때까지 구간 반복적으로 이등분합니다 .qqpxL=0xR=1xRF(xR)>q[xL,xR]ϵxMF(xM)q

ECDF는 귀하의 를 및 중에서 선택하기에 충분히 적합하며 상당히 빠릅니다. 간단한 이분법 검색 대신 일부 뉴턴 유형 최적화를 사용하여 속도를 높일 수 있습니다.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

수락 거부에 의한 직접 해결 방법은 다소 복잡합니다. 먼저 간단한 미분은 분포의 pdf가 임을 나타냅니다. 둘째, 상한 셋째, 의 두 번째 항을 고려하여 변수 즉, 입니다. 그런 다음 은 변수 변경의 야곱입니다. 경우

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
X 형식의 밀도를 갖습니다. 여기서 는 정규화 상수이고 의 밀도는 즉, (i) 는 지수 변수 로 분포되며 (ii) 상수 는 1과 같습니다. 따라서 는 지수 분포와 지수 의 제곱의 똑같이 가중 된 혼합물 과 같습니다.κ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))분포의 누락 곱셈 상수 모듈로 가중치를 고려하여 : 와 을 혼합하여 시뮬레이션 쉽다.2
f(x)g(x)=2(12aeax+12bxpebxp+1/(p+1))
g

따라서 수락-거부 알고리즘의 R 렌더링은

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

그리고 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])}

다음은 a = 1, b = 2, p = 3에 대한 그림입니다.

여기에 이미지 설명을 입력하십시오

당사 사이트를 사용함과 동시에 당사의 쿠키 정책개인정보 보호정책을 읽고 이해하였음을 인정하는 것으로 간주합니다.
Licensed under cc by-sa 3.0 with attribution required.