초당 2 백만 포인트가됩니까?

분포는 대칭입니다. 우리는 전체 원의 1/8에 대한 분포를 계산 한 다음 다른 낙엽 주위로 복사하면됩니다. 극좌표 에서 값 θ 의 임의 위치 ( X , Y ) 에 대한 각도 Θ 의 누적 분포 는 삼각형 ( 0 , 0 ) , ( 1 , 0 ) , ( 1 , tan θ ) 및 ( 에서 연장되는 원의 호(r,θ)

Θ

(X,Y)

θ

(0,0),(1,0),(1,tanθ)

~ ( cos θ , sin θ ) . 따라서 비례(1,0)

(cosθ,sinθ)

밀도가

우리는 거부 방법 (효율 )을 사용하여이 밀도에서 샘플링 할 수 있습니다 .8/π−2≈54.6479%

좌표 반경 조건부 밀도 비례 R에 D의 R 과 R = 1 및 R = 초 θ . CDF의 쉬운 반전으로 샘플링 할 수 있습니다.R

rdr

r = 1

r = 초θ

우리는 독립 샘플을 생성하는 경우 직교 좌표로 변환 백 ( X I , Y I ) 샘플이 팔분. 표본이 독립적이기 때문에 임의로 무작위로 좌표를 교환하면 원하는 경우 1 사분면에서 독립적 인 임의 표본이 생성됩니다. (랜덤 스왑은 스왑 할 실현 횟수를 결정하기 위해 단일 이항 변수 만 생성하면됩니다.)( r나는, θ나는)

( x나는, y나는)

각각의 그러한 구현 보통, 하나 개의 균일 변량에 (대해 필요 R ) 플러스 1 / ( 8 π – 2 ) 2 개 배 균일 (위한 variates Θ ) 및 (고속) 소량의 계산. 그것은 점 당 4 / ( π − 4 ) ≈ 4.66 변화입니다 (물론 두 좌표가 있습니다). 자세한 내용은 아래 코드 예제에 있습니다. 이 수치는 생성 된 50 만 개 이상의 포인트 중 10,000 개를 나타냅니다.( X, Y)

아르 자형

1 / ( 8 π− 2 )

Θ

4 / ( π– 4 ) ≈ 4.66

R이 시뮬레이션을 생성하고 시간을 정한 코드 는 다음과 같습니다 .

n.sim <- 1e6
x.time <- system.time({
  # Generate trial angles `theta`
  theta <- sqrt(runif(n.sim)) * pi/4
  # Rejection step.
  theta <- theta[runif(n.sim) * 4 * theta <= pi * tan(theta)^2]
  # Generate radial coordinates `r`.
  n <- length(theta)
  r <- sqrt(1 + runif(n) * tan(theta)^2)
  # Convert to Cartesian coordinates.
  # (The products will generate a full circle)
  x <- r * cos(theta) #* c(1,1,-1,-1)
  y <- r * sin(theta) #* c(1,-1,1,-1)
  # Swap approximately half the coordinates.
  k <- rbinom(1, n, 1/2)
  if (k > 0) {
    z <- y[1:k]
    y[1:k] <- x[1:k]
    x[1:k] <- z
  }
})
message(signif(x.time[3] * 1e6/n, 2), " seconds per million points.")
#
# Plot the result to confirm.
#
plot(c(0,1), c(0,1), type="n", bty="n", asp=1, xlab="x", ylab="y")
rect(-1, -1, 1, 1, col="White", border="#00000040")
m <- sample.int(n, min(n, 1e4))
points(x[m],y[m], pch=19, cex=1/2, col="#0000e010")

답변

n.sim <- 1e6
x.time <- system.time({
    # Draw two standard uniform samples
    u_1 <- runif(n.sim)
    u_2 <- runif(n.sim)
    # Apply shear transformation and swap
    tmp <- 1 + sqrt(2)/2 * pmin(u_1, u_2)
    x <- tmp - u_2
    y <- tmp - u_1
    # Reject if inside circle
    accept <- x^2 + y^2 > 1
    x <- x[accept]
    y <- y[accept]
    n <- length(x)
})
message(signif(x.time[3] * 1e6/n, 2), " seconds per million points.")
#
# Plot the result to confirm.
#
plot(c(0,1), c(0,1), type="n", bty="n", asp=1, xlab="x", ylab="y")
rect(-1, -1, 1, 1, col="White", border="#00000040")
m <- sample.int(n, min(n, 1e4))
points(x[m],y[m], pch=19, cex=1/2, col="#0000e010")

epsilon <- 1e-6
xx <- seq(0,1,by=epsilon)
x.cdf <- function(x) x-(x*sqrt(1-x^2)+asin(x))/2
xx.cdf <- x.cdf(xx)/x.cdf(1)

nn <- 1e4
rr <- matrix(nrow=nn,ncol=2)
set.seed(1)
pb <- winProgressBar(max=nn)
for ( ii in 1:nn ) {
    setWinProgressBar(pb,ii,paste(ii,"of",nn))
    x <- max(xx[xx.cdf<runif(1)])
    y <- runif(1,sqrt(1-x^2),1)
    rr[ii,] <- c(x,y)
}
close(pb)

plot(rr,pch=19,cex=.3,xlab="",ylab="")