Erzeugen Sie effizient Punkte zwischen Einheitskreis und Einheitsquadrat

Ich möchte Samples aus der hier definierten blauen Region generieren:

Die naive Lösung besteht darin, eine Zurückweisungsabtastung im Einheitenquadrat zu verwenden, dies liefert jedoch nur einen Wirkungsgrad von (~ 21,4%). $1-\pi/4$

Gibt es eine Möglichkeit, wie ich effizienter probieren kann?

— Cam.Davidson.Pilon
quelle

Tipp : Verwenden Sie Symmetrie, um Ihre Effizienz geringfügig zu verdoppeln.

— Kardinal

Oh wie: Wenn der Wert (0,0) ist, kann dies auf (1,1) abgebildet werden? Ich liebe diese Idee

— Cam.Davidson.Pilon

@ Kardinal Sollte es nicht die Effizienz vervierfachen? Sie können in und dann über die x-Achse, die y-Achse und den Ursprung spiegeln.

[0, \dots, 1] \times [0, \dots, 1]

$[0,\ldots,1] \times [0,\ldots,1]$

— Martin Krämer

@Martin: Über die vier symmetrischen Bereiche hinweg haben Sie Überlappungen, mit denen Sie sorgfältiger umgehen müssen.

— Kardinal

@Martin: Wenn ich verstehe, was Sie beschreiben, erhöht das die Effizienz überhaupt nicht . (Sie haben einen Punkt gefunden und kennen jetzt drei andere - in einem Bereich, der viermal so groß ist -, die entweder innerhalb der Einheitsscheibe liegen oder nicht, mit der Wahrscheinlichkeit eins, je nachdem, ob

tut. Wie hilft das?) Der Punkt der Effizienzsteigerung ist die Erhöhung der Akzeptanzwahrscheinlichkeit für jedes erzeugte

. Vielleicht bin ich derjenige, der dicht ist?

(x, y)

$(x,y)$

(x, y)

$(x,y)$

— Kardinal

Antworten:

Reichen zwei Millionen Punkte pro Sekunde aus?

Die Verteilung ist symmetrisch: Wir müssen die Verteilung nur für ein Achtel des vollen Kreises berechnen und dann um die anderen Oktanten kopieren. In Polarkoordinaten ist die kumulative Verteilung des Winkels für den zufälligen Ort beim Wert durch die Fläche zwischen den Dreiecken und der Kreisbogen von $(r,\theta)$ $\Theta$ $(X,Y)$ $\theta$ $(0,0), (1,0), (1,\tan\theta)$ bis . Es ist dabei proportional zu $(1,0)$ $(\cos\theta,\sin\theta)$

F_{Θ} (θ) = Pr (Θ \leq θ) \propto \frac{1}{2} \tan (θ) - \frac{θ}{2},

$F_\Theta(\theta) = \Pr(\Theta \le \theta) \propto \frac{1}{2}\tan(\theta) - \frac{\theta}{2},$

woher seine Dichte ist

f_{Θ} (θ) = \frac{d}{d θ} F_{Θ} (θ) \propto \tan^{2} (θ) .

$f_\Theta(\theta) = \frac{d}{d\theta} F_\Theta(\theta) \propto \tan^2(\theta).$

Wir können aus dieser Dichte beispielsweise eine Rückweisungsmethode (mit einem Wirkungsgrad von ) . $8/\pi-2 \approx 54.6479\%$

Die bedingte Dichte der Radialkoordinate ist proportional zu zwischen und . Das kann mit einer einfachen Inversion der CDF abgetastet werden. $R$ $rdr$ $r=1$ $r=\sec\theta$

Wenn wir unabhängige Abtastwerte erzeugen Umwandlung in kartesische Koordinaten diesen Oktanten ab. Da die Abtastwerte unabhängig sind, wird durch zufälliges Vertauschen der Koordinaten je nach Wunsch ein unabhängiger Zufallsabtastwert aus dem ersten Quadranten erzeugt. (Für die zufälligen Auslagerungen muss nur eine einzige Binomialvariable generiert werden, um zu bestimmen, wie viele Realisierungen ausgetauscht werden müssen.) $(r_i,\theta_i)$ $(x_i,y_i)$

Jede solche Realisierung von erforderlich ist , im Durchschnitt einer einheitlichen Veränderlichen (für ) sowie mal zwei einheitliches variates (für ) und eine geringe Menge (schnell) Berechnung. Das sind Variationen pro Punkt (der natürlich zwei Koordinaten hat). Vollständige Details finden Sie im folgenden Codebeispiel. Diese Zahl zeigt 10.000 von mehr als einer halben Million generierten Punkten. $(X,Y)$ $R$ $1/(8\pi-2)$ $\Theta$ $4/(\pi-4) \approx 4.66$

Hier ist der RCode, der diese Simulation erstellt und zeitgesteuert hat.

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

— whuber
quelle

Ich verstehe diesen Satz nicht: "Da die Samples unabhängig sind, wird durch systematisches Vertauschen der Koordinaten bei jedem zweiten Sample ein unabhängiges Zufallsmuster aus dem ersten Quadranten erzeugt, wie gewünscht." Es scheint mir, dass ein systematischer Austausch der Koordinaten bei jedem zweiten Sample stark abhängige Samples erzeugt. Zum Beispiel scheint es mir, dass Ihre Implementierung in Code eine halbe Million Samples in einer Reihe aus demselben Oktanten generiert?

— A. Rex

Streng genommen funktioniert dieser Ansatz nicht ganz (für iid-Punkte), da er eine identische Anzahl von Abtastwerten in den beiden Oktanten erzeugt: Die Abtastwerte sind daher abhängig. Wenn Sie nun unbefangene Münzen umwerfen, um den Oktanten für jede Probe zu bestimmen ...

— Kardinal

@ Cardinal Sie sind richtig; Ich werde das beheben - ohne (asymptotisch) die Anzahl der zu generierenden Zufallsvariablen zu erhöhen!

— Whuber

Genau genommen (und auch hier nur im rein theoretischen Sinne) erfordert Ihre Modifikation im Fall der endlichen Stichprobe keine zusätzlichen einheitlichen Zufallsvariablen. Das heißt: Konstruieren Sie aus der allerersten einheitlichen Zufallsvariablen die Kippsequenz aus den ersten

Bits. Verwenden Sie dann den Rest (Zeiten

) als erste erzeugte Koordinate.

n

$n$

2^{n}

$2^n$

— Kardinal

@ Xi'an Ich konnte keine bequem berechenbare Inverse erhalten. Ich kann es etwas besser machen, indem ich eine Stichprobe aus der Verteilung mit einer Dichte zurückweise, die proportional zu

(der Wirkungsgrad ist

), auf Kosten der Berechnung eines Arkussins .

2 \sin (θ)^{2}

$2\sin(\theta)^2$

(4 - π) / (π - 2) \approx 75 %

$(4-\pi)/(\pi-2)\approx 75\%$

— Whuber

Ich schlage die folgende Lösung vor, die einfacher, effizienter und / oder rechnerisch billiger sein sollte als andere Lösungen von @cardinal, @whuber und @ stephan-kolassa.

Es umfasst die folgenden einfachen Schritte:

1) Zeichnen Sie zwei einheitliche Standardproben:

u_{1} \sim U n ich f (0, 1) u_{2} \sim U n ich f (0, 1) .

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

2a) Wende die folgende Scherumwandlung auf den Punkt (Punkte im unteren rechten Dreieck werden zum oberen linken Dreieck reflektiert und sie werden "nicht reflektiert" in 2b): $\min\{u_1,u_2\}, \max\{u_1,u_2\}$

[\begin{matrix} x \\ y \end{matrix}] = [\begin{matrix} 1 \\ 1 \end{matrix}] + [\begin{matrix} \frac{\sqrt{2}}{2} & - 1 \\ \frac{\sqrt{2}}{2} - 1 & 0 \end{matrix}] [\begin{matrix} Mindest {u_{1}, u_{2}} \\ max {u_{1}, u_{2}} \end{matrix}] .

$\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) Vertausche und wenn . $x$ $y$ $u_1 > u_2$

3) Die Probe ablehnen, wenn sie sich innerhalb des Einheitskreises befindet (die Akzeptanz sollte bei 72% liegen), dh:

x^{2} + y^{2} < 1.

$x^2 + y^2 < 1.$

Die Intuition hinter diesem Algorithmus ist in der Abbildung dargestellt.

Die Schritte 2a und 2b können zu einem einzigen Schritt zusammengefasst werden:

2) Scherumwandlung anwenden und tauschen

x = 1 + \frac{\sqrt{2}}{2} Mindest (u_{1}, u_{2}) - u_{2} y = 1 + \frac{\sqrt{2}}{2} Mindest (u_{1}, u_{2}) - u_{1}

$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$

Der folgende Code implementiert den obigen Algorithmus (und testet ihn mit @ whubers Code).

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

Einige Schnelltests ergeben die folgenden Ergebnisse.

Algorithmus /stats//a/258349 . Best of 3: 0,33 Sekunden pro Million Punkte.

Dieser Algorithmus. Best of 3: 0,18 Sekunden pro Million Punkte.

— Luca Citi
quelle

+1 Sehr gut gemacht! Vielen Dank, dass Sie sich für eine durchdachte, clevere und einfache Lösung entschieden haben.

— Whuber

Großartige Idee! Ich dachte über eine Zuordnung von der Einheit sq zu diesem Teil nach, dachte jedoch nicht an eine unvollständige Zuordnung und dann an ein Ablehnungsschema. Danke, dass du meine Gedanken erweitert hast!

— Cam.Davidson.Pilon

Gut, effizienter geht es nicht, aber ich hoffe, Sie suchen nicht schneller .

$x$ $x$

f (x) = 1 - \sqrt{1 - x^{2}} .

$f(x) = 1-\sqrt{1-x^2}.$

Wolfram hilft Ihnen dabei, das zu integrieren :

\int_{0}^{x} f (y) d y = - \frac{1}{2} x \sqrt{1 - x^{2}} + x - \frac{1}{2} Arcsin x .

$\int_0^x f(y)dy = -\frac{1}{2}x\sqrt{1-x^2}+x-\frac{1}{2}\arcsin x.$

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

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

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

$x$

Sie können die CDF-Inversion wahrscheinlich erheblich beschleunigen, wenn Sie ein wenig nachdenken. Andererseits tut das Denken weh. Ich persönlich würde für die Ablehnung Sampling gehen, die schneller ist und weniger fehleranfällig, es sei denn , ich hatte sehr gute Gründe , nicht zu tun .

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

— S. Kolassa - Setzen Sie Monica wieder ein
quelle

Ich frage mich, ob die Verwendung von Chebyshev-Polynomen zur Approximation der CDF die Auswertungsgeschwindigkeit verbessern würde.

— Sycorax sagt Reinstate Monica

@Sycorax, nicht ohne Änderungen; siehe zb die chebfun-behandlung algebraischer singularitäten an den endpunkten .

— JM ist kein Statistiker