生成单位圆和正方形单元之间有效地分

我想从此处定义的蓝色区域生成样本：

天真的解决方案是在单位平方中使用拒绝采样，但这仅提供（〜21.4％）的效率。$1-\pi/4$

有什么方法可以更有效地采样吗？

请问每秒两百万点吗？

分布是对称的：我们只需要计算整个圆八分之一的分布，然后将其复制到其他八分圆周围即可。在极坐标中，角度的累积分布Θ用于随机位置（X ，ÿ ）处的值θ是由三角之间的区域内给定的（0 ，0 ），（1 ，0 ），（1 ，黄褐色θ ）和圆的从延伸的弧$(r,\theta)$$\Theta$$(X,Y)$$\theta$$(0,0), (1,0), (1,\tan\theta)$到（COS θ ，罪θ ）。因此，它与$(1,0)$$(\cos\theta,\sin\theta)$

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

它的密度是

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

我们可以使用从这个密度样，就是说，一个拒绝方法（其具有效率）。$8/\pi-2 \approx 54.6479\%$

径向坐标的条件密度正比于[R d - [R之间ř = 1和- [R = 仲丁基θ。可与CDF的容易反转进行采样。$R$$rdr$$r=1$$r=\sec\theta$

如果我们生成独立样本，转换回直角坐标（X 我，ÿ 我）样品此八分圆。因为样本是独立的，所以根据需要随机交换坐标会从第一象限生成一个独立的随机样本。（随机交换只需要生成一个二项式变量即可确定要交换多少个实现。）$(r_i,\theta_i)$$(x_i,y_i)$

每一个这样的实现的要求，平均来说，一个均匀的变量（对于[R ）加上1 /（8 π - 2 ）时间的两个均匀个变量（对于Θ）和（快速）的计算量小。这是4 /（π - 4 ）≈ 4.66每点（其中，当然，有两个坐标）个变量。详细信息在下面的代码示例中。产生这个数字地块10,000个超过半万点。$(X,Y)$$R$$1/(8\pi-2)$$\Theta$$4/(\pi-4) \approx 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")

我提出了以下解决方案，到目前为止，该解决方案应该比@ cardinal，@ whuber和@ stephan-kolassa的其他解决方案更简单，更有效和/或在计算上更便宜。

它涉及以下简单步骤：

1）画出两个标准样品均匀：

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

2a）的应用下面的剪切变换到点 （分在较低的直角三角形反射到左上三角形并且他们将是“非反射”在2b中）： [ x y ] = [ 1 1 ] + [ $\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）如果u 1 > u 2交换和y。$x$$y$$u_1 > u_2$

3）如果样品在单位圆内（接受度应为72％左右），即x 2 + y 2 < 1，则拒绝样品 。

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

该算法的直觉如图所示。

步骤2a和2b可以合并为一个步骤：

2）应用剪切变换并交换

$$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$$

以下代码实现了上面的算法（并使用@whuber的代码对其进行了测试）。

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

一些快速测试得出以下结果。

算法/stats//a/258349。最佳3：每百万分0.33秒。

此算法。最佳3：每百万分0.18秒。

好吧，可以更有效地完成工作，但是我希望您不要追求更快的速度。

这个想法是对 $x$ 首先是值，其密度与每个上方的垂直蓝色切片的长度成比例 $x$ 值：

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

Wolfram帮助您整合：

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

所以累积分布函数 $F$ 将是此表达式，缩放为1（即除以 $\int_0^1 f(y)dy$）。

现在，生成您的 $x$ 值，选择一个随机数 $t$，均匀地分布在 $0$ 和 $1$。然后找到$x$ 这样 $F(x)=t$。也就是说，我们需要反转CDF（逆变换采样）。可以做到，但这并不容易。也不快。

最后，给定 $x$，随机选择 $y$ 均匀地分布在 $\sqrt{1-x^2}$ 和 $1$。

下面是R代码。请注意，我正在对CDF进行预先评估$x$ 值，即使如此，也要花费几分钟。

如果您投入一些思考，则可以使CDF转换速度大大提高。再说一遍，思维很痛苦。我个人会去拒绝抽样，这是更快，远不易出错，除非我有非常好的理由不这样做。

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