Vorrei generare campioni dalla regione blu definita qui:
La soluzione ingenua è utilizzare il campionamento del rifiuto nel quadrato dell'unità, ma ciò fornisce solo un'efficienza di (~ 21,4%).
C'è un modo per campionare in modo più efficiente?
Vorrei generare campioni dalla regione blu definita qui:
La soluzione ingenua è utilizzare il campionamento del rifiuto nel quadrato dell'unità, ma ciò fornisce solo un'efficienza di (~ 21,4%).
C'è un modo per campionare in modo più efficiente?
Risposte:
Faranno due milioni di punti al secondo?
La distribuzione è simmetrica: dobbiamo solo elaborare la distribuzione per un ottavo del cerchio completo e quindi copiarla attorno agli altri ottanti. In coordinate polari , la distribuzione cumulativa dell'angolo per la posizione casuale al valore è data dall'area tra il triangolo e l'arco del cerchio che si estende da a . È quindi proporzionale aΘ ( X , Y ) θ ( 0 , 0 ) , ( 1 , 0 ) , ( 1 , tan θ ) ( 1 , 0 ) ( cos θ ,
da dove la sua densità è
Possiamo campionare da questa densità usando, diciamo, un metodo di rifiuto (che ha efficienza ).
La densità condizionale della coordinata radiale è proporzionale a tra e . Ciò può essere campionato con una semplice inversione del CDF.r d r r = 1 r = sec θ
Se generiamo campioni indipendenti , la conversione in coordinate cartesiane campiona questo ottante. Poiché i campioni sono indipendenti, lo scambio casuale delle coordinate produce un campione casuale indipendente dal primo quadrante, come desiderato. (Gli scambi casuali richiedono la generazione di una sola variabile binomiale per determinare quante realizzazioni scambiare.)( x i , y i )
Ciascuna di tali realizzazioni di richiede, in media, una variazione uniforme (per ) più volte due variate uniformi (per ) e una piccola quantità di calcolo (veloce). Sono variate per punto (che, ovviamente, ha due coordinate). I dettagli completi sono nell'esempio di codice seguente. Questa cifra traccia 10.000 di oltre mezzo milione di punti generati.R 1 / ( 8 π - 2 ) Θ 4 / ( π - 4 ) ≈ 4.66
Ecco il R
codice che ha prodotto questa simulazione e l'ha cronometrato.
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 seguente soluzione, che dovrebbe essere più semplice, più efficiente e / o computazionalmente più economica rispetto alle altre soluzioni di @cardinal, @whuber e @ stephan-kolassa finora.
Implica i seguenti semplici passaggi:
1) Disegna due campioni uniformi standard:
2a) Applicare la seguente trasformazione di taglio al punto (i punti nel triangolo in basso a destra sono riflessi nel triangolo in alto a sinistra e saranno "un- riflesso "in 2b): [ x
2b) Swap e se .y u 1 > u 2
3) Rifiuta il campione se all'interno del cerchio dell'unità (l'accettazione dovrebbe essere di circa il 72%), ovvero:
L'intuizione dietro questo algoritmo è mostrata nella figura.
I passaggi 2a e 2b possono essere uniti in un unico passaggio:
2) Applicare la trasformazione del taglio e scambiare
Il codice seguente implementa l'algoritmo sopra (e lo verifica usando il codice @ 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")
Alcuni test rapidi producono i seguenti risultati.
Algoritmo /stats//a/258349 . Meglio di 3: 0,33 secondi per milione di punti.
Questo algoritmo. Meglio di 3: 0,18 secondi per milione di punti.
Bene, si può fare in modo più efficiente , ma spero proprio che tu non stia cercando più velocemente .
L'idea sarebbe di campionare prima un valore , con una densità proporzionale alla lunghezza della sezione blu verticale sopra ogni valore :x
Wolfram ti aiuta a integrare questo :
Quindi la funzione di distribuzione cumulativa sarebbe questa espressione, ridimensionata per integrarsi a 1 (cioè, divisa per ).
Ora, per generare il tuo valore , scegli un numero casuale , distribuito uniformemente tra e . Quindi trova tale che . Cioè, dobbiamo invertire il CDF ( campionamento di trasformazione inversa ). Questo può essere fatto, ma non è facile. Né veloce.
Alla fine, dato , scegli una casuale distribuita uniformemente tra e .
Di seguito è riportato il codice R. Nota che sto pre-valutando il CDF su una griglia di valori , e anche in questo caso ci vogliono alcuni minuti.
Probabilmente puoi accelerare un po 'l'inversione del CDF se investi un po' di pensiero. Poi di nuovo, il pensiero fa male. Io personalmente andrei per il campionamento di rifiuto, che è più veloce e molto meno soggetto a errori, a meno che non ho avuto molto buone ragioni per non farlo.
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="")