Ball Point Picking

Author

Eric W. Weisstein
March 14, 2017

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/BallPointPicking.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/BallPointPicking.html.

©2017 Wolfram Research, Inc. except for portions noted otherwise

Code

Special cases

p==1

Simplify[PDF[ProbabilityDistribution[((Exp[-((Abs[x])^p)])/(2Gamma[1+(1/p)])),{x,-∞,∞}],x]/.p->1,x∈Reals]

PDF[ExponentialDistribution[1],x]

p==2

Simplify[PDF[ProbabilityDistribution[((Exp[-((Abs[x])^p)])/(2Gamma[1+(1/p)])),{x,-∞,∞}],x]/.p->2,x∈Reals]

PDF[NormalDistribution[0,1/Sqrt[2]],x]

p==3

Simplify[PDF[ProbabilityDistribution[((Exp[-((Abs[x])^p)])/(2Gamma[1+(1/p)])),{x,-∞,∞}],x]/.p->3,x∈Reals]

2D

Monte Carlo

With[{n=Round[((2^2)/π)10^5]},Length[pts2=Select[pts=RandomReal[{-1,1},{n,2}],#.#<1&]]]//Timing

Graphics[{Point[Take[pts2,10^4]],Opacity[.1],Disk[]}]

Exact

Length[pts=RandomPointInBall[10^5,2]]//Timing

Select[Norm/@pts,#>1&]

Graphics[{Point[Take[pts,10^4]],Opacity[.1],Disk[]}]

3D

Monte Carlo

With[{n=Round[((2^3)/((4/3)π))10^5]},Length[pts2=Select[pts=RandomReal[{-1,1},{n,3}],#.#<1&]]]//Timing

Graphics3D[Point[Take[pts2,10^4]],Boxed->False,Method->{"ShrinkWrap"->True}]

bug(330521):  Graphics3D[Point[RandomPoint[Ball[], 10^3]], Boxed -> False, Method -> {"ShrinkWrap" -> True}] fails to ShrinkWrap in V11.1

RandomPoint

Graphics3D[Point[RandomPoint[Ball[],10^4]],Boxed->False,Method->{"ShrinkWrap"->True}]

bug(330521):  Graphics3D[Point[RandomPoint[Ball[], 10^3]], Boxed -> False, Method -> {"ShrinkWrap" -> True}] fails to ShrinkWrap in V11.1

Exact

RandomPointInBall[n_,d_:3,p:2]:=Module[{
x=RandomVariate[NormalDistribution[0,1/Sqrt[2]],{n,d}],
y=RandomVariate[ExponentialDistribution[1],n]
},
((#1)/(((#2+Total[((Abs[#1])^p)]))^(1/p)))&@@@Transpose[{x,y}]
]

RandomPointInBall[n_,d_:3,p_]:=Module[{
x=RandomVariate[ProbabilityDistribution[((Exp[-((Abs[x])^p)])/(2Gamma[1+(1/p)])),{x,-∞,∞}],{n,d}],
y=RandomVariate[ExponentialDistribution[1],n]
},
((#1)/(((#2+Total[((Abs[#1])^p)]))^(1/p)))&@@@Transpose[{x,y}]
]

pts=RandomPointInBall[10^5,3];//Timing

Select[Norm/@pts,#>1&]

Graphics3D[{Point[Take[pts,10^4]],Opacity[.1],Sphere[]},Boxed->False]