5
$\begingroup$

Tossing 4 points on a circle at a time, and calculate the chance of all 4 points on the upper part of the circle.

An illustration for this

This is very simple by math:

$$\left( \frac{1}{2} \right)^4 = 0.0625$$

But I want do a simulation in Mathematica.

po = RandomVariate[UniformDistribution[{{0, 1}, {0, 2 Pi}}], 40000000];
f[m_, n_] := {m Cos[n], m Sin[n]};
Apply[f, po, {1}] // Partition[#, 4] & // 
   Select[#, AllTrue[Last /* GreaterEqualThan[0]]] & // 
  Length // AbsoluteTiming

it takes around 140 seconds for this code to finish.

Is there a way to speed this up?

Improve this question
$\endgroup$
  • $\begingroup$ Do not post unsearchable images of equations. Instead typeset using MathJax. $\endgroup$ – David G. Stork Jul 15 '20 at 4:18
  • $\begingroup$ @DavidG.Stork I only know a few about Tex. Could you edit it for me? $\endgroup$ – kile Jul 15 '20 at 4:26
6
$\begingroup$

We get additional speed-up combining RandomPoint with UnitStep,Total and Min or Count:

n = 10^6;

SeedRandom[1];

RepeatedTiming[
 Total[Min /@ UnitStep[RandomPoint[Disk[], {n/4, 4}][[All, All, 2]]]]]

{0.099, 15733}

SeedRandom[1];

RepeatedTiming[
  Count[4] @ Total[UnitStep[RandomPoint[Disk[], {n/4, 4}][[All, All, 2]]], {2}]]

{0.11, 15733}

versus the method from Bob Hanlon's answer:

SeedRandom[1];

RepeatedTiming[
 RandomPoint[Disk[], n] // Partition[#, 4] & // 
   Select[#, AllTrue[Last /* GreaterEqualThan[0]]] & // Length]

{0.8295, 15733}
Improve this answer
$\endgroup$
6
$\begingroup$

It is more efficient to use RandomPoint and RandomPoint distributes the points uniformly over the region.

Clear["Global`*"]

f[m_, n_] := {m Cos[n], m Sin[n]};

n = 80000;

To accurately compare the two methods, the point generation needs to be included in the timing.

RepeatedTiming[
 po = RandomVariate[
   UniformDistribution[{{0, 1}, {0, 2 Pi}}], n];
 (Apply[f, po, {1}] // Partition[#, 4] & // 
      Select[#, AllTrue[Last /* GreaterEqualThan[0]]] & // Length)/(n/4) // N]

(* {0.160, 0.06455} *)

Note that the points cluster near the origin.

ListPlot[f @@@ po, AspectRatio -> 1]

enter image description here

RepeatedTiming[
 ((pp = RandomPoint[Disk[], n]) // Partition[#, 4] & // 
      Select[#, AllTrue[Last /* GreaterEqualThan[0]]] & // Length)/(n/4) // N]

(* {0.0423, 0.0619} *)

ListPlot[pp, AspectRatio -> 1]

enter image description here

Improve this answer
$\endgroup$
  • $\begingroup$ f[m_, n_] := {Sqrt[m] Cos[n], Sqrt[m] Sin[n]} fixes the distribution problem and it only slows it down by a small fraction but RandomPoint is still faster. When generating $10^6$ points in a vectorized fashion, I found that it took 0.020 seconds versus 0.0256 with RandomPoint, so then they are about equivalent. $\endgroup$ – C. E. Jul 15 '20 at 8:35
  • $\begingroup$ @C.E. why can adding Sqrt solve that problem? Can you explain? $\endgroup$ – kile Jul 16 '20 at 12:45
  • $\begingroup$ @kile Have a look here. $\endgroup$ – C. E. Jul 16 '20 at 16:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.