4
$\begingroup$

How can I achieve a 3D visual of a concentric layered sphere (like an onion), where the radius of each layer is tick-marked using a logarithmic scale?

Specifically, my project is to realize the following:

1) Layer the first sphere like the concentric rings of an onion, with the innermost layer having a thickness of "e" (Euler's number), and the outermost layer at an infinite distance having a thickness of 1. So, cutoff the concentric sphere display at some "x" radius, where "x" is 1 < x < e.

2) Mesh each layer's surface. Also draw x,y,z axes with logarithmically scaled tickmarks starting from the origin.

3) Cut out a big quarter slice of the whole sphere so that we can see its inside. Like this: https://scx1.b-cdn.net/csz/news/800/2019/magnetismdis.jpg

4) Apply a rotation to each layer, with the outermost layer completing a cycle in "1" unit time while the innermost layer completes a cycle in "e" (= 2.7) unit time.

5) Superpose on this first sphere a likewise onion layered second but Euclidean sphere. The latter's axes' tickmarks should be of a linear scale. Cut out too its quarter slice from some other angle to show its inside. Also apply uniform rotation to all its layers in similar fashion.

$\endgroup$
7
  • $\begingroup$ Is this animated? I feel like you’re expecting/describing an animated visual and not a static one $\endgroup$ Commented Jan 10, 2020 at 16:50
  • $\begingroup$ Yes morbo, I aim to have an animated visual in the end. The first step is to have the concentric spheres placed correctly. MarcoB's code gave concentric spheres, but they should start at an innermost thickness of "e" and decrease to 1 as the radial distance goes to infinity. $\endgroup$ Commented Jan 10, 2020 at 17:09
  • $\begingroup$ perhaps you could draw by hand a (very) basic example of what you’re looking for...i didnt quite understand what was being asked either. If i get a chance i’ll make an attempt in the next time. $\endgroup$ Commented Jan 10, 2020 at 17:51
  • $\begingroup$ Concentric spheres with ever-decreasing thickness is sort of represented here: researchgate.net/profile/AW_Vreman/publication/301713180/figure/… $\endgroup$ Commented Jan 10, 2020 at 17:58
  • 1
    $\begingroup$ @Ozan I recommend that you post a self-answer to your question with the progress you’ve made so far, and update it as you figure out more parts of the solution. The more code you share, the more likely it is that somebody else might be able to provide the missing piece towards a full answer if they don’t have to start from zero. $\endgroup$
    – MarcoB
    Commented Jan 11, 2020 at 20:15

2 Answers 2

12
$\begingroup$

This should take care of your first and third requirements. I do not understand the others well, so I might wait for clarification.

SphericalPlot3D[
  Evaluate[E^Range[0, 1, 0.2]],
  {θ, 0, 3 Pi/2}, {ϕ, 0, 3 Pi/2}
]

concentric spheres

$\endgroup$
3
  • $\begingroup$ Thank you MarcoB for the prompt answer, and sorry for my delay in replying. I have added the axes too in this fashion: Show[Graphics3D[ MapThread[{Black, Arrow@Tube@{{0, 0, 0}, #1}, Text[#2, #1, {0, -1}]} &, {4 IdentityMatrix[3], {x, z, y}}], Boxed -> False], SphericalPlot3D[ Evaluate[E^Range[0, 1, 0.2]], {[Theta], 0, 3 Pi/2}, {[Phi], 0, 3 Pi/2}] ] $\endgroup$ Commented Jan 10, 2020 at 14:30
  • $\begingroup$ This is a repeat from my response to morbo above: After some experimentation, I could align the concentric spheres according to a logarithmic scale. Here is the code so far: Show[Graphics3D[ MapThread[{Black, Arrow@Tube@{{0, 0, 0}, #1}, Text[#2, #1, {0, -1}]} &, {2 IdentityMatrix[3], {x, z, y}}], Boxed -> False], SphericalPlot3D[ Evaluate[Range[-2, 2, 1/E]^(1/E)], {[Theta], 0, Pi}, {[Phi], 0, 3 Pi/2}] ] $\endgroup$ Commented Jan 10, 2020 at 20:46
  • $\begingroup$ This is a repeat from my response to morbo above: I think this range is now both correct and aesthetically pleasing: Range[1, N[4 E], (N[4 E] - 1)/5]^(1/E) $\endgroup$ Commented Jan 10, 2020 at 21:41
0
$\begingroup$

Below is a recapitulation of the progress so far upon the suggestion of MarcoB. The code provided by MarcoB was modified as such:

Show[Graphics3D[
MapThread[{Black, Arrow@Tube@{{0, 0, 0}, #1}, 
Text[#2, #1, {0, -1}]} &, {3 IdentityMatrix[3], {x, z, y}}], 
Boxed -> False], 
SphericalPlot3D[
Evaluate[(E^2/2)*
Range[1, N[4 E], (N[4 E] - 1)/5]^(1/N[E])], {\[Theta], 0, 
Pi}, {\[Phi], 0, 3 Pi/2}], Axes -> True, 
AxesStyle -> {Red, Green, Blue}, FaceGrids -> All ]

Thus, it also includes x,y,z axes that both stick out from the origin AND envelop the 3D visual as a box. (They stick out alright, but alas, with no tickmarks as yet!)

Notice that I am still somewhat unsure about the "logarithmic scale ordering" of the concentric spheres. Because of the difficulty of seeing the axes starting from the origin, I had a hard time understanding the spaces between the concentric spheres. Eventually I think I managed to hand-input the correct thickness (Euler's number for the innermost sphere) that gets decreased to 1 as the radial distance goes to infinity.

Other items as part of the formulated question on top still remain. There is still the issue of rotating each of the concentric spheres and superposing on this setup another set of spheres that radiate out linearly.

Thanks!

$\endgroup$
3
  • $\begingroup$ Despite my hopeful estimations, I think the RANGE (1 to E) is determined as a squishing of the concentric spheres from the outside to the inside (towards the origin), and I am back to the drawing board... $\endgroup$ Commented Jan 12, 2020 at 18:51
  • $\begingroup$ Evaluate[Log[Range[N[E], N[E^E], (N[ E^E - E])/5]]] seems to give a better calibrated range compared to the earlier Evaluate[Range[1, N[E^E], (N[ E^E - 1])/5]^(1/N[E])]. The deceptive part is owing to the resulting increments being very similar. $\endgroup$ Commented Jan 16, 2020 at 18:34
  • $\begingroup$ The updated reverse range can be expressed as: Evaluate[Log[Range[N[E^E], N[E], (N[E - E^E])/5]]]. Yet I still cannot get the range to correctly align with the axes. The innermost sphere's radius should be "e", and the outermost spheres radius should asymptotically approach "1". $\endgroup$ Commented Jan 16, 2020 at 18:36

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.