8
$\begingroup$

I am trying to do a simple thing really, plot a sequence of spheres with increasing radii and I used a Do-loop to do it, but nothing happens, Please suggest what I can do to get the result I want?

Do[
  ContourPlot3D[x^2 + y^2 + z^2 == i, {x, 0, 10}, {y, 0, 10}, {z, 0, 10}],  
  {i, 0, 10}]

It should be a series of spheres almost side by side

See the image; the spheres should be stepped with different origins.

enter image description here

$\endgroup$
4
  • $\begingroup$ What is your desired end goal? An animation of some sort? Or perhaps all on the same graph? We can help! Welcome to Mma.SE. As a start, Do does not actually return anything unless explicitly informed to do so. $\endgroup$ Commented Sep 7, 2019 at 5:39
  • $\begingroup$ I have told Do to do a ContourPlot3D. I want simply a sequence of spheres with increasing radius in a 3D plot as mentioned. $\endgroup$
    – Betty
    Commented Sep 7, 2019 at 5:47
  • $\begingroup$ Right right, so Do wasn’t told to Return that evaluation. See here: “Unless an explicit Return is used, the value returned by Do is Null.” Are you trying to Show a sequence of these on the same plot at the same time? Or output sequence of them in a List, such as with a Table? You could also Animate the sequence, or wrap it in a Manipulate so you have control over it! $\endgroup$ Commented Sep 7, 2019 at 5:56
  • $\begingroup$ That is okay it sort of does what I want but I do not want manipulation but a superposition all spheres but they have changing origin, so that they are almost side by side $\endgroup$
    – Betty
    Commented Sep 7, 2019 at 6:10

2 Answers 2

12
$\begingroup$

Equally spaced radii

spacing = 1;
radii = spacing Range[10];
ClearAll[tr]
tr[n_] := (n^2 - 1) / 2 / spacing;

You can use tr and radii with

ContourPlot

ContourPlot[Evaluate[(x - tr[#])^2 + y^2 == #^2 & /@ radii],
  {x, -1, 65}, {y, -10, 10}, 
  ContourStyle -> Thick, AspectRatio -> Automatic,  Frame -> False, ImageSize -> 1 -> 5]

enter image description here

ParametricPlot

ParametricPlot[Evaluate[{# Cos[t] + tr@#, # Sin[t]} & /@ radii], 
 {t, 0, 2 Pi}, 
 AspectRatio -> Automatic, PlotStyle -> Thick, Axes -> False,
 Frame -> False, ImageSize -> 1 -> 5]

same picture

Graphics

Graphics[{Thick, ColorData[97]@#, Circle[{tr@#, 0}, #]} & /@ radii]

same picture

ContourPlot3D

ContourPlot3D[Evaluate[(x - tr[#])^2 + y^2 + z^2 == #^2 & /@ radii], 
   {x, -1, 65}, {y, -10, 10}, {z, -15, 15}, 
   Mesh -> None, ContourStyle -> Opacity[.5], BoxRatios -> Automatic, 
   ViewPoint -> Front, Boxed -> False, Axes -> False , PlotPoints -> 60]

enter image description here

ParametricPlot3D

ParametricPlot3D[Evaluate[{# Cos[u] Sin[v] + tr@#, # Sin[u] Sin[v], # Cos[  v]} & /@ radii],
  {v, 0, Pi}, {u, 0, 2 Pi}, 
  Mesh -> None, BoundaryStyle -> None, PlotStyle -> Opacity[.5], 
  Axes -> False, Boxed -> False, BoxRatios -> Automatic, ViewPoint -> Front]

same picture

Graphics3D

styles = "DefaultPlotStyle" /. 
    (Method /. Charting`ResolvePlotTheme[Automatic, ContourPlot3D]);

Graphics3D[{Opacity[.5], styles[[#]], Sphere[{tr @ #, 0, 0}, #]} & /@ radii, 
  Boxed -> False, ViewPoint -> Front]

same picture

Random Radii

To get horizontal coordinates of the centers of the circles/spheres (1) Accumulate the diameters of circles/spheres in odd and even positions separately, (2) shift the second list by an arbitrary amount (by the average of the horizontal positions the two leftmost circles/spheres below), (3) riffle the two lists and (4) subtract the radii from the resulting list:

SeedRandom[1]
randomradii = RandomSample[Range @ 20, 10];
centers = Module[{origins = {0, Mean[Sort[#][[{1, 2}]]]}}, Riffle @@ 
 (Function[x, origins[[x]] + Accumulate[2 #[[x ;; ;; 2]]]] /@ {1, 2}) - #] &@ randomradii;

Using centers and randomradii with Graphics and Graphics3D:

Graphics[MapIndexed[{Thick, ColorData[97]@#2[[1]], 
  Circle[{centers[[#2[[1]]]], 0}, #]} &, randomradii]]

Graphics3D[MapIndexed[{Opacity[.5], ColorData[97]@#2[[1]], 
   Sphere[{centers[[#2[[1]]]], 0, 0}, #]} &, randomradii], 
  Boxed -> False, ViewPoint -> Front]

enter image description here

With sorted radii, for example,

SeedRandom[1]
randomradii = Sort@ RandomChoice[Range @ 20, 10];

we get

enter image description here

$\endgroup$
3
  • $\begingroup$ Can this be done without the use of Sphere[]? $\endgroup$
    – Betty
    Commented Sep 8, 2019 at 7:26
  • $\begingroup$ ParametricPlot3D and ContourPlot3D do not use Sphere[] $\endgroup$
    – kglr
    Commented Sep 9, 2019 at 18:02
  • $\begingroup$ Excellent work, it gives me a starting point for what I want to do - thank you. $\endgroup$
    – Betty
    Commented Sep 9, 2019 at 23:22
7
$\begingroup$

As mentioned in comments, Do does not return the plots. But why not just use Manipulate? This is what Manipulate meant for.

enter image description here

Manipulate[

 Module[{x, y, z, max},
  max = 10;
  ContourPlot3D[
   x^2 + y^2 + z^2 == r^2, {x, -max, max}, {y, -max, max}, {z, -max, max}, 
   PlotRange -> {{-max, max}, {-max, max}, {-max, max}}, 
   PerformanceGoal -> "Quality", 
   SphericalRegion -> True]
  ],

 {{r,5,"radius"}, 1, 10, 1, Appearance -> "Labeled",ContinuousAction->False},
 TrackedSymbols :> {r}
 ]

But if you really just need static 3D plots, you can do

makePlot[r_] := Module[{x, y, z, max},
   max = 10;
   ContourPlot3D[
    x^2 + y^2 + z^2 == r^2, {x, -max, max}, {y, -max, max}, {z, -max, max},
    PlotRange -> {{-max, max}, {-max, max}, {-max, max}},
    PerformanceGoal -> "Quality", SphericalRegion -> True,
    PlotLabel -> Row[{"Radius ", r}]]
   ];

   Grid[Partition[Table[makePlot[r], {r, 1, 9}], 3], Frame -> All, 

Spacings -> {1, 1}]

Mathematica graphics

To update for the new requirements posted:

makePlot[r_] := Module[{x, y, z, max},
   Sphere[{r^2 - 1, 0, 0}, r]
   ];
tab = Table[makePlot[r], {r, 1, 4}]
Graphics3D[tab, PlotRange -> All]

Mathematica graphics

$\endgroup$
3
  • $\begingroup$ See below I uploaded an image $\endgroup$
    – Betty
    Commented Sep 7, 2019 at 6:13
  • $\begingroup$ Nice answer! +1 I think the OP has defined their needs a bit more, though you’ll likely be able to accommodate quite considerably with these! $\endgroup$ Commented Sep 7, 2019 at 6:14
  • $\begingroup$ Can this be done without the use of the Sphere[] function? $\endgroup$
    – Betty
    Commented Sep 8, 2019 at 7:26

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.