Эффективно генерируйте очки между кругом юнитов и квадратом


17

Я хотел бы создать образцы из синей области, определенной здесь:

введите описание изображения здесь

Наивным решением является использование выборки отбраковки на единицу площади, но это обеспечивает эффективность только (~ 21,4%).1-π/4

Есть ли какой-нибудь способ, которым я могу сделать выборку более эффективно?


6
Подсказка : используйте симметрию, чтобы просто удвоить эффективность.
кардинал

3
Ах, как: если значение (0,0), это может быть сопоставлено с (1,1)? Мне нравится эта идея
Cam.Davidson.Pilon

@ Cardinal Разве это не должно в 4 раза превышать эффективность? Вы можете выполнить выборку в а затем отразить ее по оси x, оси y и исходной точке. [0,...,1]×[0,...,1]
Мартин Крамер

1
@Martin: В четырех симметричных областях у вас есть перекрытия, с которыми вам нужно обращаться более осторожно.
кардинал

3
@Martin: Если я понять , что вы описываете, что не приводит к повышению эффективности на всех . (Вы нашли одну точку, а теперь знаете три других - в области, в четыре раза превышающей ее размер), которые либо лежат, либо не лежат на единичном диске с вероятностью один в зависимости от того, соответствует ли . Как это помогает?) Смысл повышения эффективности заключается в увеличении вероятности принятия для каждого ( x , y ) сгенерированного. Возможно, я тот самый плотный? (Икс,Y)(Икс,Y)
кардинал

Ответы:


10

Будет ли два миллиона очков в секунду?

Распределение симметрично: нам нужно только определить распределение для одной восьмой части полного круга, а затем скопировать его вокруг других октантов. В полярных координатах совокупное распределение угла Θ для случайного положения ( X , Y ) при значении θ определяется площадью между треугольником ( 0 , 0 ) , ( 1 , 0 ) , ( 1 , tan θ ) и дуга окружности, продолжающаяся от ((р,θ)Θ(X,Y)θ(0,0),(1,0),(1,tanθ) до ( cos θ , sin θ ) . Таким образом, оно пропорционально(1,0)(cosθ,sinθ)

FΘ(θ)=Pr(Θθ)12tan(θ)θ2,

откуда его плотность

fΘ(θ)=ddθFΘ(θ)tan2(θ).

Мы можем сделать выборку из этой плотности, используя, скажем, метод отбраковки (который имеет эффективность ).8/π254.6479%

Условная плотность радиальной координаты пропорциональна r d r между r = 1 и r = sec θ . Это можно сделать с помощью простой инверсии CDF.Rрdррзнак равно1рзнак равносекθ

Если мы сгенерируем независимые выборки , преобразование обратно в декартовы координаты ( x i , y i ) произведет выборку этого октанта. Поскольку выборки являются независимыми, случайное переключение координат создает независимую случайную выборку из первого квадранта, по желанию. (Случайные свопы требуют генерации только одной биномиальной переменной, чтобы определить, сколько реализаций нужно поменять.)(ri,θi)(xi,yi)

Каждая такая реализация требует, в среднем, одной равномерной переменной (для R ) плюс 1 / ( 8 π - 2 ) умножения на две равномерных переменной (для Θ ) и небольшое количество (быстрых) вычислений. Это 4 / ( π - 4 ) 4,66 вариации на точку (что, конечно, имеет две координаты). Полная информация приведена в примере кода ниже. Эта цифра показывает 10000 из более чем полумиллиона сгенерированных очков.(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")

1
Я не понимаю это предложение: «Поскольку выборки независимы, систематически меняя координаты каждой второй выборки, по желанию, получается независимая случайная выборка из первого квадранта». Мне кажется, что систематическое изменение координат каждой второй выборки дает сильно зависимые выборки. Например, мне кажется, что ваша реализация в коде генерирует полмиллиона образцов подряд из одного и того же октанта?
А. Рекс

7
Строго говоря, этот подход не совсем работает (для точек iid), поскольку он генерирует одинаковое количество выборок в двух октантах: таким образом, точки выборки являются зависимыми. Теперь, если вы подбросите несмещенные монеты, чтобы определить октант для каждого образца ...
кардинал

1
@ Кардинал, ты прав; Я исправлю это - без (асимптотически) увеличения числа генерируемых случайных величин!
whuber

2
Строго говоря (и, опять же , только в чистом теоретическом смысле), в конечном случае образца, ваша модификация не требует не дополнительных однородных случайных случайных величин. То есть: из самого первого равномерного случайного изменения построить последовательность переключения из первых битов. Затем используйте остаток (времена 2 n ) в качестве первой сгенерированной координаты. n2n
кардинал

2
2sin(θ)2(4π)/(π2)75%

13

Я предлагаю следующее решение, которое до сих пор должно быть проще, эффективнее и / или дешевле в вычислительном отношении, чем другие решения @cardinal, @whuber и @ stephan-kolassa.

Он включает в себя следующие простые шаги:

u1Unif(0,1)u2Unif(0,1).

min{u1,u2},max{u1,u2}

[xy]=[11]+[2212210][min{u1,u2}max{u1,u2}].

xyu1>u2

x2+y2<1.

Интуиция этого алгоритма показана на рисунке. enter image description here

Шаги 2a и 2b можно объединить в один шаг:

x=1+22min(u1,u2)u2y=1+22min(u1,u2)u1

Следующий код реализует алгоритм выше (и проверяет его с помощью кода @ 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 секунды на миллион очков.


3
+1 Очень хорошо сделано! Спасибо, что поделились вдумчивым, умным и простым решением.
whuber

Отличная идея! Я думал о отображении из единицы sq в эту часть, но не думал о несовершенном отображении, а затем о схеме отклонения. Спасибо за расширение моего разума!
Cam.Davidson.Pilon

7

Что ж, более эффективно можно сделать, но я надеюсь, что вы не ищете быстрее .

xx

f(x)=11x2.

Wolfram поможет вам интегрировать это :

0xf(y)dy=12x1x2+x12arcsinx.

F01f(y)dy

xt01xF(x)=t

xy1x21

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

randoms


Интересно, улучшит ли скорость оценки использование полиномов Чебышева для аппроксимации CDF?
Sycorax сообщает, что восстановит Монику

@Sycorax, не без модификаций; см., например, обработку алгебраических сингулярностей в конечных точках.
JM не является статистиком
Используя наш сайт, вы подтверждаете, что прочитали и поняли нашу Политику в отношении файлов cookie и Политику конфиденциальности.
Licensed under cc by-sa 3.0 with attribution required.