Decorating Easter Eggs with the Planets

Staff Picks
, , , , , , ,
1

PlanetEaster.jpg
PlanetEaster.jpg800×401 49.5 KB

Just thought I’d share this fun little exercise. First, we need to get the textures to use.

textures = 
  ImageReflect[#, Right] & /@ 
   EntityValue["Planet", "CylindricalEquidistantTexture"];

Then, we need to plot parametric surfaces that look like eggs and apply the textures to them.

GraphicsGrid[Partition[With[{l = .75, a = 1, b = 1},
     ParametricPlot3D[
      Evaluate[
       RotationMatrix[
         Pi/2, {0, 1, 
          0}].{l Cos[t] + (a + b Cos[t]) Cos[t], (a + b Cos[t]) Sin[
           t] Cos[p], (a + b Cos[t]) Sin[t] Sin[p]}], {p, 0, 
       2 Pi}, {t, 0, Pi}, Mesh -> None, Boxed -> False, Axes -> False,
       Lighting -> "Neutral", PlotStyle -> Texture[#], 
      ViewPoint -> Left, PlotPoints -> 50, Background -> Black, 
      SphericalRegion -> True, ViewAngle -> Pi/6]] & /@ textures, 4], 
 Spacings -> {0, 0}, ImageSize -> 800]
15 Likes
2

2015-11-02_10-07-11.png

  • Congratulations! This post is now featured in our Staff Pick column as distinguished by a badge on your profile of a Featured Contributor! Thank you, keep it coming!
3

Jeff, this is really nice and funny! I was thinking about some “easter idea” myself, but in vain. Here a minor remark: The texture could still be improved using TextureCoordinateFunction -> ({#4, #3} &). My code then reads (I changed your egg function a bit):

textures = EntityValue["Planet", "CylindricalEquidistantTexture"];
GraphicsGrid[
 Partition[
  With[{l = .75, a = 1, b = 1}, 
     ParametricPlot3D[
      Evaluate[{(a + b Cos[t]) Sin[t] Cos[p], (a + b Cos[t]) Sin[
          t] Sin[p], -l Cos[t] - (a + b Cos[t]) Cos[t]}], {p, 0, 
       2 Pi}, {t, 0, Pi}, Mesh -> None, Boxed -> False, Axes -> False,
       Background -> Black, Lighting -> "Neutral", ViewPoint -> Left, 
      PlotPoints -> 50, SphericalRegion -> True, ViewAngle -> Pi/6, 
      PlotStyle -> Texture[#], 
      TextureCoordinateFunction -> ({#4, #3} &)]] & /@ textures, 4], 
 Spacings -> {0, 0}, ImageSize -> 800]

PlanetEgg.jpg
PlanetEgg.jpg800×401 53.5 KB

Regards and happy Easter! – Henrik

7 Likes
4

Awesome idea! I wonder if this can be really printed on eggs - it’d be greatly educational for kids. Following @Michael Hale idea here I suggest using RevolutionPlot3D, it simplifies things a bit and avoids a seam in texture. Here is my take. First define a function for a single egg:

eggPLANET[texture_]:=RevolutionPlot3D[{-Sin[t]1.3^Cos[t],1.4Cos[t]},{t,0,Pi},
	PlotStyle->{Texture[ImageRotate[texture,Pi/2]]},Mesh->None,
	Lighting->"Neutral",Boxed->False,Axes->False,PlotPoints->50,
	Background->Black,SphericalRegion->True,ViewAngle->.27]

Note simplicity of formula. Then map it as Jeff did but in 2-eegs width for better resolution, like a vertical poster:

GraphicsGrid[Partition[eggPLANET/@textures, 2],Spacings ->{0, 0},ImageSize->1000]

435trwghfds.jpg
435trwghfds.jpg1000×1999 298 KB

6 Likes
5

Someone else will have to try this on my behalf for this particular application (as I do not currently have Mathematica), but whenever I wanted to experiment with textures on an egg-like surface, I tended to use Yamamoto’s ovals:

tex = PlanetData["Earth", "CylindricalEquidistantTexture"];
Manipulate[RevolutionPlot3D[{(1 - h Sin[u/2]^2) Sin[u]/2, Sin[u/2]^2 + h (Sin[u]/2)^2},
                            {u, 0, ?}, Axes -> None, Boxed -> False,
                            Lighting -> "Neutral", Mesh -> None, PlotPoints -> 45,
                            PlotStyle -> Directive[Specularity[1/2, 5], Texture[tex]],
                            TextureCoordinateFunction -> ({#5, #4} &)],
            {{h, 3/5, "Distortion"}, 0, 1}, SaveDefinitions -> True]

where the setting h == 0 is the conventional sphere. I personally prefer h == 7/10, so you could do something like

With[{h = 7/10},
     Table[RevolutionPlot3D[{(1 - h Sin[u/2]^2) Sin[u]/2, Sin[u/2]^2 + h (Sin[u]/2)^2},
                            {u, 0, ?}, Axes -> None, Boxed -> False,
                            Lighting -> "Neutral", Mesh -> None, PlotPoints -> 45, 
                            PlotStyle -> Directive[Specularity[1/2, 5], Texture[tex]], 
                            TextureCoordinateFunction -> ({#5, #4} &)],
          {tex, EntityValue["Planet", "CylindricalEquidistantTexture"]}]] // (GraphicsGrid[Partition[#, 4]] &)

if you want to see the whole set of planetary eggs.

3 Likes
6

Your eggs are all balanced on their pointy ends!

2 Likes
7

Yes! It’s quite easy to do in the outer space :wink: