3
$\begingroup$

What is the best approach to estimate, with Wolfram Mathematica, the expected Euclidean distance (in a $(n+1)$-dimensional space) between two points selected uniformly at random on a unit $n$-hemisphere?

The approach I have in mind uses an expression whose length is proportional to $n$, while I would like a simpler and more elegant approach.

$\endgroup$
5
$\begingroup$

Use a normal distribution to generate $n$ values and Normalize to get a point on the sphere. Make sure that the last coordinate always has the same sign using Abs. Generate millions of these points and estimate the mean distance between pairs:

n = 3;
topt[p_] := MapAt[Abs, Normalize[p], -1]
points = topt /@ RandomVariate[NormalDistribution[0, 1], {1000000, n}];
distances = EuclideanDistance @@@ Partition[points, 2];
Histogram[distances]
Mean[distances]

(* 1.13137 *)
$\endgroup$
  • 2
    $\begingroup$ In the limit for large $n$ the mean distance and distribution converge to the same results as the $n$-sphere distances. In other words, in high dimensions a single coordinate doesn't make much difference to the distances. Also I suspect for both spherical and hemispherical cases, the mean converges to $\sqrt{2}$ for high $n$ but that's just a guess. $\endgroup$ – flinty Nov 21 '20 at 17:50
  • 1
    $\begingroup$ Based on Roman's closed form in the previous question: Limit[2^(n - 1)*Gamma[n/2]^2/(Sqrt[\[Pi]]*Gamma[n - 1/2]), n -> \[Infinity]] is Sqrt[2]. $\endgroup$ – flinty Nov 21 '20 at 18:12
  • 1
    $\begingroup$ See that paper. $\endgroup$ – user64494 Nov 23 '20 at 6:14
2
$\begingroup$

Another way to do the sampling (taking advantage of the built in Sphere function and RandomPoint functionality (modified from a similar question on sampling from the surface of the sphere

distanceDistributionOnHalfSphere[dimensionality_, nSamples_:10^5] :=
  With[{
   (* take a few extra samples account for loss *)
   randomPointsOnSurfaceOfNSphere = RandomPoint[Sphere[dimensionality], {4*nSamples, 2}], 
   
   (* define an operator that deletes points when either last coordinate is negative *)
   upperHemisphere = DeleteCases[{{___, x_}, {___, y_}} /; (Negative[x] || Negative[y])]
   },
  
  (* apply operator to the list and compute list of distances *)
  EuclideanDistance @@@ upperHemisphere @ randomPointsOnSurfaceOfNSphere
  ]

(* Evaluate mean of the sample *)
MeanAround /@ distanceDistributionOnHalfSphere /@ Range[10]

(The $N=3$ result is in agreement with @flinty's result*)

$\endgroup$
  • $\begingroup$ Really great! Thank you @JoshuaSchrier ! $\endgroup$ – Penelope Benenati Nov 23 '20 at 13:46

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.