Tạo điểm hiệu quả giữa vòng tròn đơn vị và hình vuông đơn vị

Tôi muốn tạo các mẫu từ vùng màu xanh được xác định ở đây:

Giải pháp ngây thơ là sử dụng lấy mẫu từ chối trong ô vuông đơn vị, nhưng điều này chỉ cung cấp hiệu suất $1-\pi/4$ (~ 21,4%).

Có một số cách tôi có thể lấy mẫu hiệu quả hơn?

Hai triệu điểm mỗi giây sẽ làm gì?

Phân phối là đối xứng: chúng ta chỉ cần thực hiện phân phối cho một phần tám của vòng tròn đầy đủ và sau đó sao chép nó xung quanh các quãng tám khác. Trong tọa độ cực , phân phối tích lũy của góc Θ cho vị trí ngẫu nhiên ( X , Y ) theo giá trị θ được đưa ra bởi khu vực giữa tam giác ( 0 , 0 ) , ( 1 , 0 ) , ( 1 , tan θ ) và cung của vòng tròn kéo dài từ $(r,\theta)$$\Theta$$(X,Y)$$\theta$$(0,0), (1,0), (1,\tan\theta)$ đến ( cos θ , tội lỗi θ ) . Do đó tỷ lệ thuận với$(1,0)$$(\cos\theta,\sin\theta)$

$$F_\Theta(\theta) = \Pr(\Theta \le \theta) \propto \frac{1}{2}\tan(\theta) - \frac{\theta}{2},$$

mật độ của nó là

$$f_\Theta(\theta) = \frac{d}{d\theta} F_\Theta(\theta) \propto \tan^2(\theta).$$

Chúng tôi có thể lấy mẫu từ mật độ này bằng cách sử dụng phương pháp loại bỏ (có hiệu quả ).$8/\pi-2 \approx 54.6479\%$

Mật độ có điều kiện của tọa độ hướng tâm tỷ lệ thuận với giữa và . Điều đó có thể được lấy mẫu với sự đảo ngược dễ dàng của CDF.r d r r = 1 r = giây $R$$rdr$$r=1$$r=\sec\theta$

Nếu chúng ta tạo các mẫu độc lập , chuyển đổi trở lại tọa độ Cartesian lấy mẫu octant này. Bởi vì các mẫu là độc lập, việc hoán đổi tọa độ ngẫu nhiên tạo ra một mẫu ngẫu nhiên độc lập từ góc phần tư thứ nhất, như mong muốn. (Các giao dịch hoán đổi ngẫu nhiên yêu cầu chỉ tạo một biến Binomial duy nhất để xác định số lượng thực hiện để hoán đổi.)( x i , y i$(r_i,\theta_i)$$(x_i,y_i)$

Trung bình, mỗi lần thực hiện yêu cầu, trung bình, một biến thiên đồng nhất (đối với ) cộng với hai lần thay đổi đồng nhất (đối với ) và một lượng nhỏ (nhanh) tính toán. Đó là biến thiên cho mỗi điểm (tất nhiên, có hai tọa độ). Chi tiết đầy đủ có trong ví dụ mã dưới đây. Con số này vẽ ra 10.000 trong số hơn nửa triệu điểm được tạo ra.R 1 / ( 8 π - 2 ) Θ 4 / ( π - 4 ) ≈ $(X,Y)$$R$$1/(8\pi-2)$$\Theta$$4/(\pi-4) \approx 4.66$

Đây là Rmã đã tạo ra mô phỏng này và hẹn giờ cho nó.

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

Tôi đề xuất giải pháp sau đây, nên đơn giản hơn, hiệu quả hơn và / hoặc tính toán rẻ hơn so với các loại thuốc khác bằng @cardinal, @whuber và @ stephan-kolassa cho đến nay.

Nó bao gồm các bước đơn giản sau:

1) Vẽ hai mẫu thống nhất tiêu chuẩn:

$$u_1 \sim Unif(0,1)\\ u_2 \sim Unif(0,1).$$

2a) Áp dụng phép biến đổi cắt sau cho điểm (các điểm trong tam giác dưới bên phải được phản ánh cho tam giác phía trên bên trái và chúng sẽ là "un- phản ánh "trong 2b): $\min\{u_1,u_2\}, \max\{u_1,u_2\}$

$$\begin{bmatrix} x\\y \end{bmatrix} = \begin{bmatrix} 1\\1 \end{bmatrix} + \begin{bmatrix} \frac{\sqrt{2}}{2} & -1\\ \frac{\sqrt{2}}{2} - 1 & 0\\ \end{bmatrix} \, \begin{bmatrix} \min\{u_1,u_2\}\\ \max\{u_1,u_2\}\\ \end{bmatrix}.$$

2b) Hoán đổi và nếu .$x$$y$$u_1 > u_2$

3) Từ chối mẫu nếu bên trong vòng tròn đơn vị (mức chấp nhận phải ở khoảng 72%), tức là:

$$x^2 + y^2 < 1.$$

Trực giác đằng sau thuật toán này được hiển thị trong hình.

Bước 2a và 2b có thể được hợp nhất thành một bước duy nhất:

2) Áp dụng chuyển đổi cắt và hoán đổi

$$x = 1 + \frac{\sqrt{2}}{2} \min(u_1, u_2) - u_2\\ y = 1 + \frac{\sqrt{2}}{2} \min(u_1, u_2) - u_1$$

Đoạn mã sau thực hiện thuật toán ở trên (và kiểm tra nó bằng mã @ whuber's).

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

Một số xét nghiệm nhanh mang lại kết quả như sau.

Thuật toán /stats//a/258349 . Tốt nhất trong 3: 0,33 giây trên một triệu điểm.

Thuật toán này. Tốt nhất trong 3: 0,18 giây trên một triệu điểm.

Vâng, hiệu quả hơn có thể được thực hiện, nhưng tôi chắc chắn hy vọng bạn không tìm kiếm nhanh hơn .

Ý tưởng sẽ là lấy mẫu một giá trị trước, với mật độ tỷ lệ thuận với chiều dài của lát màu xanh dọc trên mỗi giá trị :$x$$x$

$$f(x) = 1-\sqrt{1-x^2}.$$

Wolfram giúp bạn tích hợp điều đó :

$$\int_0^x f(y)dy = -\frac{1}{2}x\sqrt{1-x^2}+x-\frac{1}{2}\arcsin x.$$

Vì vậy, hàm phân phối tích lũy sẽ là biểu thức này, được chia tỷ lệ để tích hợp thành 1 (nghĩa là chia cho ).∫ 1 0 f ( y ) d $F$$\int_0^1 f(y)dy$

Bây giờ, để tạo giá trị của bạn , hãy chọn một số ngẫu nhiên , được phân phối đồng đều giữa và . Sau đó tìm sao cho . Đó là, chúng ta cần đảo ngược CDF ( lấy mẫu biến đổi nghịch đảo ). Điều này có thể được thực hiện, nhưng nó không dễ dàng. Cũng không nhanh.t 0 1 x F ( x ) = $x$$t$$0$$1$$x$$F(x)=t$

Cuối cùng, cho , chọn một ngẫu nhiên được phân phối đồng đều giữa và .y $x$$y$$\sqrt{1-x^2}$$1$

Dưới đây là mã R. Lưu ý rằng tôi đang đánh giá trước CDF ở một lưới các giá trị , và thậm chí sau đó việc này mất khá nhiều phút.$x$

Bạn có thể có thể tăng tốc độ đảo ngược CDF lên một chút nếu bạn đầu tư một số suy nghĩ. Rồi lại suy nghĩ, đau lắm. Cá nhân tôi sẽ đi lấy mẫu từ chối, nhanh hơn và ít bị lỗi hơn, trừ khi tôi có lý do rất chính đáng để không.

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