# Plotting Spheres with dots

I want to create the four images as shown here. The third one I tried and the code is.

unitSphere = ParametricPlot3D[{Sin[θ] Cos[ϕ], Sin[θ] Sin[ϕ], Cos[θ]},
{θ, 0, Pi}, {ϕ, 0, 2 Pi}, PlotRange -> 1,
PlotStyle -> Directive[Opacity[0]], Mesh -> {11, 0},
MeshStyle -> GrayLevel[0.7], BoxRatios -> {1, 1, 1}]

{θ, 0, π}, {ϕ, 0, 2 π},ColorFunction -> (ColorData["Rainbow"][#3] &)]

Show[unitSphere, plot]


How can I get all the four with the outer sphere as dotted curves as shown in the figure?

• One way is to use MeshStyle -> {{Thickness[0.005], Dashing[0.005]}}. – Henrik Schumacher Oct 23 '17 at 10:30

This will get you pretty close, although you might want to play about a little with some of the parameters.

First, your unitSphere can easily be adapted to produce the points in the plot by

m = 14; n = 50;
unitspherepoints = Table[{Sin[θ] Cos[ϕ], Sin[θ] Sin[ϕ], Cos[θ]},
{θ, 0, Pi, π/m}, {ϕ, 0, 2 π, π/n}];

unitsphere = ListPointPlot3D[Flatten[unitspherepoints, 1], PlotStyle -> Purple];


where I've left m and n for you to tune.

One (easily generalizeable) way to go is to define a function that will make the "inner plots", given a centre and list of radii:

innerplot[centre_, rad_] :=
ParametricPlot3D[
centre + rad {Sin[θ] Cos[ϕ], Sin[θ] Sin[ϕ], Cos[θ]}, {θ, 0, π}, {ϕ, 0, 2 π},
Mesh -> 25, PlotStyle -> "SunsetColors"]


("SunsetColors" seemed closer than "Rainbow".) You could also use Ellipsoid here, but you probably want the Mesh that comes with ParametricPlot3D.

Next, we can create a list of centres and radii that appears to approximate those shown in your figure:

cenrad = {{{0, 0, 0}, {1, 1, 1}},
{{0, 0, 0}, {0.5, 0.5, 1}},
{{0, 0, 0}, {0.3, 0.5, 0.3}},
{{0, 0, 0.8}, {0.5, 0.5, 0.2}}};


Then innerplot @@@ cenrad will give you all the inner ellipsoids, but we want to add a couple of extras:

GraphicsGrid[Partition[
Show[unitsphere, innerplot[##],
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
AxesLabel -> {Subscript[a, 1], Subscript[a, 2], Subscript[a, 3]},
BoxRatios -> {1, 1, 1}] & @@@ cenrad,
2], ImageSize -> 700]


You can, of course, create your own cenrad lists. Just make sure that each element in the list has the form

{..., {{x, y, z}, {rx, ry, rz}}, ...}


where {x, y, z} is the centre and {rx, ry, rz} are the radii along the axes.

As an alternative way

spherepoint[r1_, r2_, r3_] = Table[{r1 Sin[q1] Cos[q2], r2  Sin[q1] Sin[q2], r3 Cos[q1] },
{q1, 0, Pi, Pi/8}, {q2, 0, 2 Pi, Pi/40}];

n1 = 1; n2 = 2; n3 = 2;
Show[ListPointPlot3D[spherepoint[n1,n2,n3], BoxRatios -> {1, 1, 1},
PlotStyle -> PointSize[Medium]],
Graphics3D[Sphere[{0, 0, 0}, 1]]]


You can get different configuration by changing n1,n2,n3. You can replace Graphics3D[Sphere[{0, 0, 0}, 1]] with your unitSphere.

You can move the sphere as well by shifting the origin. For above example, I choose {0,0,0}. Let's put it at {0, 0, 3/4 n3} with a larger radius for the points.

n1 = 2; n2 = 2; n3 = 4;
Show[ListPointPlot3D[spherepoint[n1, n2, n3], BoxRatios -> {1, 1, 1},
PlotStyle -> PointSize[Medium]],
Graphics3D[Sphere[{0, 0, 3/4 n3}, 1]]]


• Many thanks. How do I get the last one? I am not getting that by changing the parameters. Also, how can I get the same color as in the figure that I have posted? – ABCD Oct 23 '17 at 11:50
• You need to change the origin of the sphere. Check the new answer. – Sumit Oct 23 '17 at 13:01