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?

$\endgroup$
2
  • $\begingroup$ Do not post unsearchable images of equations. Instead typeset using MathJax. $\endgroup$ Commented Jul 15, 2020 at 4:18
  • $\begingroup$ @DavidG.Stork I only know a few about Tex. Could you edit it for me? $\endgroup$
    – kile
    Commented Jul 15, 2020 at 4:26

2 Answers 2

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

$\endgroup$
3
  • $\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.
    Commented Jul 15, 2020 at 8:35
  • $\begingroup$ @C.E. why can adding Sqrt solve that problem? Can you explain? $\endgroup$
    – kile
    Commented Jul 16, 2020 at 12:45
  • $\begingroup$ @kile Have a look here. $\endgroup$
    – C. E.
    Commented Jul 16, 2020 at 16:29

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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