13
$\begingroup$

I have seen very nice dynamic graphics created by users of Ma. I would like to get help whether the following graphics can be created using Ma. I was not able to create the dynamic picture here. Therefore, I have the link here for original graphics: link to original graphics Beautiful Dance of the Earth and Venus around the Sum

$\endgroup$
  • 1
    $\begingroup$ Ooooh, yeah, the one where they pretend that 365.25/224.7=13/8 because it's prettier, and, you know, who cares ;-). (Which is to say: the nice, closed structure is only approximately there, as good a job as that video does at pretending it's exact. As long as you keep that in mind, then yeah, it's quite pretty.) $\endgroup$ – Emilio Pisanty May 18 '16 at 0:39
  • $\begingroup$ @Emilio, that's why I went for the curated data instead of the idealized model, where it can be seen that the tracks are manifestly not epicycloids. ;) $\endgroup$ – J. M. will be back soon May 18 '16 at 3:31
7
$\begingroup$

I did some time ago.

tv = 225;
te = 365.25;
rv = 0.72;
re = 1;
e[t_] := {Cos[2 Pi t/te], Sin[2 Pi t/te]};
v[t_] := 0.72 {Cos[2 Pi t/tv], Sin[2 Pi t/tv]};
vis[t_, s_] := Graphics[
  {Yellow, PointSize[0.05], Point[{0, 0}], White, Circle[{0, 0}, 1], 
   Circle[{0, 0}, 0.72], Blue, PointSize[0.03],
   Point[v[t]], Red, Point[e[t]],
   White,
   Table[Line[{v[j], e[j]}], {j, 0, t, s}]}, Background -> Black]

Visualizing the cosmic dance:

tbl = Table[vis[t, Pi], {t, 0, 1000 Pi, 5 Pi}];

This was exported as a gif (this is a down sampled version).

enter image description here

$\endgroup$
  • $\begingroup$ Thank you Ubpdqn for taking time to answer this question . I really appreciate it. $\endgroup$ – ramesh May 18 '16 at 5:43
  • $\begingroup$ @ramesh thank you. I learned a lot from all the answers. I just happened to have a 'canned answer'. :) $\endgroup$ – ubpdqn May 18 '16 at 6:09
12
$\begingroup$

Here's something that is nowhere near the sophistication of the original, but might get you started.

The following assumes an orbital period for Venus of 225 days (thanks Michael!), and an average orbital distance from the sun of 0.72 AU (from very superficial Google searches).

Table[
  Module[
   {venus, earth},
   venus = 0.72 AngleVector[2 Pi/225 d];
   earth = AngleVector[2 Pi/365 d];
   {
    Orange, Disk[{0, 0}, 0.1],
    Opacity[0.2], Gray, Through[{Point, Line}[{earth, venus}]]
   }
  ],
  {d, 1, 10 365, 4}
] // Graphics

Mathematica graphics

You will have to play with the step and duration of your simulation to obtain different effects.

$\endgroup$
  • $\begingroup$ Venus's orbital period is 225 days, not 295 days. (And its rotation period is 245 days, but that's another story.) $\endgroup$ – Michael Seifert May 17 '16 at 18:21
  • $\begingroup$ @Michael, oops you are right! I can't even copy numbers from Google anymore :-) Fixed! $\endgroup$ – MarcoB May 17 '16 at 18:24
  • $\begingroup$ @Michael and Marco: UnitConvert[PlanetData["Venus", "OrbitPeriod"], "Days"] ;) $\endgroup$ – J. M. will be back soon May 17 '16 at 18:35
  • 1
    $\begingroup$ @J.M. Yep, I should have done that, but for my visceral aversion to the way access to curated data and units are currently implemented... $\endgroup$ – MarcoB May 17 '16 at 18:40
  • $\begingroup$ Can't argue with that. :) $\endgroup$ – J. M. will be back soon May 17 '16 at 18:46
11
$\begingroup$

Might as well...

eorb = PlanetData["Earth", "OrbitPath"];
vorb = PlanetData["Venus", "OrbitPath"];

dl = DateRange[{2010, 1, 1}, {2015, 12, 31}, "Week"];

epos = Table[QuantityMagnitude[UnitConvert[
             PlanetData["Earth", EntityProperty["Planet",
                                                "HelioCoordinates", {"Date" -> dates}]], 
                                           "AstronomicalUnit"]], {dates, dl}];

vpos = Table[QuantityMagnitude[UnitConvert[
             PlanetData["Venus", EntityProperty["Planet",
                                                "HelioCoordinates", {"Date" -> dates}]], 
                                           "AstronomicalUnit"]], {dates, dl}];

Graphics[{{Orange, vorb}, {LightBlue, eorb},
          {Directive[Opacity[2/3, White]], MapThread[Line[{##}] &, {epos, vpos}]}} /.
          v_ /; VectorQ[v, NumericQ] :> Most[v], Background -> Black]

that ain't an epicycloid

(N.B. See the revision history for a version that uses AstronomicalData[]. For some reason (all the associated gymnastics with Entity[], perhaps), that was faster than using PlanetData[])

$\endgroup$
  • $\begingroup$ This is what you get if you go back further in time. $\endgroup$ – J. M. will be back soon May 17 '16 at 19:09
  • $\begingroup$ Thank you J. M. for taking time to answer this question . I really appreciate it. $\endgroup$ – ramesh May 18 '16 at 5:44
6
$\begingroup$

With the caveat that it has zero physical meaning whatsoever, here you go:

\[Omega]v = 365.25/225;
rv = 0.72;
lines = Table[Line[{{Cos[t], Sin[t]}, rv {Cos[\[Omega]v t], Sin[\[Omega]v t]}}], {t, 0, 20 \[Pi], \[Pi]/40}];
Graphics[{White, Opacity[0.4], lines, Opacity[1], Red, Circle[], Circle[{0, 0}, rv]}, Background -> Black]

enter image description here

And if you want an animation, the following code should do the trick:

Manipulate[Graphics[{White, Opacity[0.4], Take[lines, i], Opacity[1], Red,  Circle[], Circle[{0, 0}, rv]}, Background -> Black], {i, 1, Length[lines], 1}]
$\endgroup$
  • $\begingroup$ Thank you Michael for taking time to answer this question . I really appreciate it. $\endgroup$ – ramesh May 18 '16 at 5:43
5
$\begingroup$

See for a start Cardioid or Cardioid, Wiki. If i'm not mistaken this stuff is called Line Art, String Art and Curve Stitching.

(Code Intellectual property of Matt Henderson of http://blog.matthen.com)

Manipulate[Graphics[{Table[Line[{{Sin[a], Cos[a]}, {Sin[a + 2 Pi/3 + t], 
Cos[a + 2 Pi/3]}}], {a, 0, 2 Pi - 0.001, Pi/50}]}, 
PlotRange -> {{-1, 1}, {-1, 1}}], {t, 0, 2 Pi}]

enter image description here

so you can work with:

rVenus = a/(1 + e*Cos[\[Theta]]) /. {a -> 0.723, e -> 0.0068, i -> 3.3947}
rEarth = a/(1 + e*Cos[\[Theta]]) /. {a -> 1, e -> 0.0167, i -> 0}

$\frac{0.723}{0.0068 \cos (\theta )+1}$

$\frac{1}{0.0167 \cos (\theta )+1}$

rv = 0.723

wv = 365.24/225.1

Graphics[Table[Line[{{Cos[rVenus], Sin[rVenus]}, rv {Cos[wv rVenus], Sin[wv 
rVenus]}}], {rVenus, 0, 10 \[Pi], \[Pi]/20}]]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you Louis for taking time to answer this question . I really appreciate it. $\endgroup$ – ramesh May 18 '16 at 5:44

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.