4
$\begingroup$

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}]

rad = 0.4; 
plot = ParametricPlot3D[{rad*Sin[θ] Cos[ϕ], rad*Sin[θ] Sin[ϕ], rad*Cos[θ]}, 
       {θ, 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?

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

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]

enter image description here

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.

$\endgroup$
2
$\begingroup$

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]]]

enter image description here

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]]]

enter image description here

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – ABCD Oct 23 '17 at 11:50
  • $\begingroup$ You need to change the origin of the sphere. Check the new answer. $\endgroup$ – Sumit Oct 23 '17 at 13:01

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.