Genere puntos eficientemente entre el círculo unitario y el cuadrado unitario

Me gustaría generar muestras de la región azul definida aquí:

La solución ingenua es utilizar el muestreo de rechazo en el cuadrado de la unidad, pero esto proporciona solo una eficiencia de (~ 21.4%).$1-\pi/4$

¿Hay alguna manera de que pueda probar más eficientemente?

¿Serán dos millones de puntos por segundo?

La distribución es simétrica: solo necesitamos calcular la distribución para un octavo del círculo completo y luego copiarla alrededor de los otros octantes. En coordenadas polares , la distribución acumulativa del ángulo Θ para la ubicación aleatoria ( X , Y ) en el valor θ viene dada por el área entre el triángulo ( 0 , 0 ) , ( 1 , 0 ) , ( 1 , tan θ ) y el arco del círculo que se extiende desde$(r,\theta)$$\Theta$$(X,Y)$$\theta$$(0,0), (1,0), (1,\tan\theta)$$(1,0)$a . Por lo tanto, es proporcional a$(\cos\theta,\sin\theta)$

de donde es su densidad

Podemos tomar muestras de esta densidad usando, por ejemplo, un método de rechazo (que tiene una eficiencia de ).$8/\pi-2 \approx 54.6479\%$

La densidad condicional de la coordenada radial es proporcional a r d r entre r = 1 y r = sec θ . Eso se puede muestrear con una fácil inversión del CDF.$R$$rdr$$r=1$$r=\sec\theta$

Si generamos muestras independientes , la conversión de nuevo a coordenadas cartesianas ( x i , y i ) muestrea este octante. Debido a que las muestras son independientes, el intercambio aleatorio de las coordenadas produce una muestra aleatoria independiente del primer cuadrante, según se desee. (Los intercambios aleatorios requieren generar solo una variable binomial única para determinar cuántas de las realizaciones intercambiar).$(r_i,\theta_i)$$(x_i,y_i)$

Cada realización de requiere, en promedio, una variante uniforme (para R ) más 1 / ( 8 π - 2 ) veces dos variables uniformes (para Θ ) y una pequeña cantidad de cálculo (rápido). Eso es 4 / ( π - 4 ) ≈ 4.66 variantes por punto (que, por supuesto, tiene dos coordenadas). Los detalles completos se encuentran en el siguiente ejemplo de código. Esta cifra representa 10,000 de más de medio millón de puntos generados.$(X,Y)$$R$$1/(8\pi-2)$$\Theta$$4/(\pi-4) \approx 4.66$

Aquí está el Rcódigo que produjo esta simulación y la cronometró.

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

Propongo la siguiente solución, que debería ser más simple, más eficiente y / o computacionalmente más barata que otras soluciones de @cardinal, @whuber y @ stephan-kolassa hasta ahora.

Implica los siguientes pasos simples:

$\min\{u_1,u_2\}, \max\{u_1,u_2\}$

$x$$y$$u_1 > u_2$

La intuición detrás de este algoritmo se muestra en la figura.

Los pasos 2a y 2b se pueden combinar en un solo paso:

El siguiente código implementa el algoritmo anterior (y lo prueba usando el código de @ 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")

Algunas pruebas rápidas arrojan los siguientes resultados.

Algoritmo /stats//a/258349 . Lo mejor de 3: 0,33 segundos por millón de puntos.

Este algoritmo Lo mejor de 3: 0.18 segundos por millón de puntos.

Bueno, se puede hacer de manera más eficiente , pero espero que no estés buscando más rápido .

$x$$x$

Wolfram te ayuda a integrar eso :

$F$$\int_0^1 f(y)dy$

$x$$t$$0$$1$$x$$F(x)=t$

$x$$y$$\sqrt{1-x^2}$$1$

$x$

Probablemente pueda acelerar bastante la inversión de CDF si invierte algo de pensamiento. Por otra parte, pensar duele. Yo personalmente elegiría muestras de rechazo, que es más rápido y mucho menos propenso a errores, a menos que tenga muy buenas razones para no hacerlo.

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