How to evenly distribute points inside a sphere?

Question

SpherePoints[] gives me a fairly even distribution of points on the surface of a sphere. However, following this, I can have a much better distribution (although the computational cost is very high for 50-100 points).

Edit 1:

EquilibriumPoints[n_, level_: 1] := 
 Setting@DynamicModule[{x, y, z, vars, potential, sphereconstr, rpts, 
 thetapts, phipts, spherepts, cartpts, initpts, sol, spherepoints},
 vars = Join[Array[x, n], Array[y, n], Array[z, n]];
 potential = 
 Sum[((x[i] - x[j])^2 + (y[i] - y[j])^2 + (z[i] - z[j])^2)^-(1/
     2), {i, 1, n - 1}, {j, i + 1, n}];
 sphereconstr = 
 Table[x[i]^2 + y[i]^2 + z[i]^2 <= (1/level)^2, {i, 1, n}];
 rpts = ConstantArray[1, n];
 thetapts = Table[N@Sin[i], {i, 0, Pi, Pi/(n - 1)}]; 
 phipts = Table[N@Cos[i], {i, 0, Pi, Pi/(n - 1)}];
 spherepts = {rpts, thetapts, phipts};
 cartpts = 
 CoordinateTransformData["Spherical" -> "Cartesian", "Mapping", 
  spherepts];
 initpts = Flatten[Transpose[cartpts]];
 sol = FindMinimum[{potential, sphereconstr}, 
 Thread[{vars, initpts}]];
 spherepoints = Table[{x[i], y[i], z[i]}, {i, 1, n}] /. sol[[2]]
]

Edit 2

Now I find, for n = 11 the minimum distance among the points becomes less than 1(0.977845).

Therefore, for n = 20, I split the points into two levels in the following way:

n = 20;
pts = EquilibriumPoints[n];
min = Min@
   Table[EuclideanDistance[pts[[i]], pts[[j]]], {i, 1, 
     Length@pts - 1}, {j, i + 1, Length@pts}];
ptsnew = If[min < 1, 
  Join[EquilibriumPoints[Ceiling[n/2], 1], 
   EquilibriumPoints[Floor[n/2], 2]], pts];

Now the points can be visualized in the following way:

Show[Graphics3D[{PointSize[0.02], Red, Point[ptsnew]}], 
 Graphics3D[{Opacity[0.3], Ellipsoid[{0, 0, 0}, {1, 1, 1}]}], 
 Graphics3D[{Opacity[0.3], Ellipsoid[{0, 0, 0}, {0.5, 0.5, 0.5}]}], 
 Boxed -> False]

I think I have got it right. Now I need to automate the process to detect the number of levels given the number of points and determine how many points to be distributed at what level.

How can I do this?

Have you checked the answers at this question? https://mathematica.stackexchange.com/questions/119329/how-to-get-n-equidistributed-points-on-the-unit-sphere — kirma, Sep 18 '18 at 15:12
@kirma Yes, I know these solutions as well. However, all these solutions give the spherical distribution at one level while I need this at multiple levels depending on the number of points. — user36426, Sep 18 '18 at 15:23
I would want to point out that if all your points are on a distance of 1 or less from every other point and your outer sphere has a radius of 1, the points are going to be on one side of the sphere(s) to maintain this constraint. Maybe this is not actually the constraint you really wanted? — kirma, Sep 18 '18 at 15:41

How to evenly distribute points inside a sphere?

0 Answers0