Зроблять два мільйони очок за секунду?
Розподіл симетричний: нам потрібно лише розробити розподіл на одну восьму повного кола, а потім скопіювати його навколо інших октантів. У полярних координатах кумулятивний розподіл кута Θ для випадкового розташування ( X , Y ) при значенні θ задається площею між трикутником ( 0 , 0 ) , ( 1 , 0 ) , ( 1 , tan θ ) і дуга кола, що проходить від ((r,θ)Θ(X,Y)θ(0,0),(1,0),(1,tanθ) до ( cos θ , sin θ ) . Таким чином, він пропорційний(1,0)(cosθ,sinθ)
FΘ(θ)=Pr(Θ≤θ)∝12tan(θ)−θ2,
звідки його щільність
fΘ(θ)=ddθFΘ(θ)∝tan2(θ).
Ми можемо взяти вибірку з цієї щільності, використовуючи, скажімо, метод відкидання (який має ефективність ).8/π−2≈54.6479%
Умовна щільність радіальної координати пропорційна r d r між r = 1 та r = sec θ . Це можна пробити за допомогою легкої інверсії CDF.Rrdrr=1r=secθ
Якщо ми генеруємо незалежні зразки , перетворення назад до декартових координат ( x i , y i ) вибірки цього октанта. Оскільки вибірки є незалежними, випадкове зміна координат створює незалежну випадкову вибірку з першого квадранта, як бажано. (Випадкові свопи вимагають генерування лише однієї біноміальної змінної, щоб визначити, скільки реалізується для заміни.)(ri,θi)(xi,yi)
Кожна така реалізація вимагає, в середньому, однієї рівномірної змінної (для R ) плюс 1 / ( 8 π - 2 ) разів двох рівномірних змінних (для Θ ) і невеликої кількості (швидкого) обчислення. Це 4 / ( π - 4 ) ≈ 4,66 змінних на точку (що, звичайно, має дві координати). Повна інформація наведена в прикладі коду нижче. Ця цифра відображає 10 000 з більш ніж півмільйона отриманих балів.(X,Y)R1/(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")