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$
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$ Commented Jul 15, 2020 at 4:26

2 Answers 2

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.