単位円と単位正方形の間の点を効率的に生成

ここで定義された青い領域からサンプルを生成します。

素朴な解決策は、単位平方で棄却サンプリングを使用することですが、これは（〜21.4％）の効率しか提供しません。$1-\pi/4$

より効率的にサンプリングできる方法はありますか？

1秒間に200万ポイントはできますか？

分布は対称です。完全な円の8分の1の分布を計算し、それを他のオクタントの周りにコピーするだけです。極座標では、値でのランダムな位置の角度累積分布は、三角形から延びる円弧に。これにより、Θ （X 、Y ）θ （0 、0 ）、（1 、0 ）、（1 、黄褐色θ ）（1 、0 ）（COS θ 、罪θ $(r,\theta)$$\Theta$$(X,Y)$$\theta$$(0,0), (1,0), (1,\tan\theta)$$(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\%$

動径座標の条件付き密度は、と間の比例します。これは、CDFの簡単な反転でサンプリングできます。$R$$rdr$$r=1$$r=\sec\theta$

独立したサンプルを生成する場合、デカルト座標への変換はこのオクタントをサンプリングします。サンプルは独立しているため、座標をランダムに交換すると、必要に応じて最初の象限から独立したランダムサンプルが生成されます。（ランダムスワップでは、スワップする実現の数を決定するために、1つのBinomial変数のみを生成する必要があります。）$(r_i,\theta_i)$$(x_i,y_i)$

このような各実現には、平均して、1つの一様変量（）に倍の2つの一様変量（）と少量の（高速）計算が必要です。だこれ（当然のことながら、2点の座標を持っている、）ポイントごと変量。詳細は以下のコード例にあります。この図は、生成された50万点以上のうち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）2つの標準均一サンプルを描画します：

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

2a）次のせん断変換をポイント （右下の三角形の点は左上の三角形に反映され、「un- 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）場合、と交換します。$x$$y$$u_1 > u_2$

3）単位円内にある場合（受け入れ率は約72％）、つまり、場合、サンプルを拒否します

$$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：100万ポイントあたり0.33秒。

このアルゴリズム。ベストオブ3：100万ポイントあたり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.$$

したがって、累積分布関数はこの式になり、1に積分するようにスケーリングされます（つまり、で除算されます）。$F$$\int_0^1 f(y)dy$

ここで、値を生成するために、から間に均一に分布する乱数選択します。[検索ように。つまり、CDFを反転する必要があります（逆変換サンプリング）。これは実行できますが、簡単ではありません。速くもありません。$x$$t$$0$$1$$x$$F(x)=t$

最後に、与えられた場合、と間に均一に分布するランダムを選択します。$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="")