15
$\begingroup$

Someone could get a similar solution like this animation?

enter image description here

I believe the solution is useful for demonstrations in class to other users who teach Math.

Spreading of a Thin Liquid Drop Under the Influence of Gravity, Rotation and Non-Uniform Surface Tension

$\endgroup$
  • 5
    $\begingroup$ If similar is needed then: 63200. "I declare that I have no idea how to get started" - very convenient :) You can always try a straightforward approach with Graphics3D Table Point and positions dependent of a parameter. p.s. useful search query animation + generative-art $\endgroup$ – Kuba Aug 4 '16 at 6:26
  • 1
    $\begingroup$ By your comment, now can I have an idea how to start :). If no one, for now, add a solution, I will trying through these references. Grateful. $\endgroup$ – LCarvalho Aug 4 '16 at 6:46
  • 3
    $\begingroup$ You might be interested in this. $\endgroup$ – J. M. will be back soon Aug 4 '16 at 6:59
  • 1
    $\begingroup$ @LeandroMacieldeCarvalho. I find that using the search bar within the site doesn't work all that great. When I have a question, I usually just google "mathematica stack exchange ..." where "..." are some key-words for what I'm looking for. You can also try searching within tags within the site by searching, for instance, for "[plotting] animation". $\endgroup$ – march Aug 4 '16 at 16:23
  • 1
    $\begingroup$ Also, it's very important to give the source whenever you post material that hasn't been generated by code you are posting. You may be violating copyright, $\endgroup$ – Jens Aug 11 '16 at 20:38
23
$\begingroup$

Thanks to J.M.

drop = SetAlphaChannel[#, ColorNegate@#] &@
  Binarize@Rasterize@
    ParametricPlot[{r Cos[t] (1 - Sin[t]), -3 + 
       r (5/2 (Sin[t] - 1) + 3)}, {t, 0, 2 Pi}, {r, 0, 1}, 
     BoundaryStyle -> None, Axes -> False, Frame -> False]

Something to start with:

circle = Table[
  Translate[
    Point[{##, 0} & @@@ CirclePoints[r, 10 + 20 r]], 
    {0, 0, Dynamic[f[#, t]] &@r}
  ], 
  {r, .5, 20, .5}
];

f[r_, t_] := UnitBox[(r - t)/(2 Pi) - .5] Sin[r - t]; 
t = -4 Pi; 

Column@{
  Trigger[Dynamic[t], {-4 Pi, 20}] ,
  Graphics3D[
   {AbsolutePointSize@2, circle,
    Dynamic @ If[t < -1.9 Pi, 
      Inset[drop, {0, 0, -(t + 2 Pi)}, Automatic, Scaled[{.03, .05}]], 
      {}
    ]
    },
   ViewVertical -> {0, 0, 1}, ImageSize -> 700, 
   PlotRange -> {20 {-1, 1}, 20 {-1, 1}, 10 {-1, 1}}, 
   ViewAngle -> Pi/16, Boxed -> False, ViewPoint -> {5, 0, 3}, 
   BoxRatios -> Automatic]}

enter image description here

$\endgroup$
  • 3
    $\begingroup$ beautiful...+1 can almost here the drop :) $\endgroup$ – ubpdqn Aug 4 '16 at 11:01
  • 1
    $\begingroup$ @ubpdqn Thanks, but let's be clear, it is not the prettiest one :) Though I don't care, my goal in such cases is to create something interactive rather than a neat gif. $\endgroup$ – Kuba Aug 4 '16 at 11:19
  • 2
    $\begingroup$ yes it would not be used in Disney CGI...but terse and perhaps motivates...I am off to sleep :) $\endgroup$ – ubpdqn Aug 4 '16 at 11:53
  • 1
    $\begingroup$ Great job! Now I will study your code. I am beginner and I am thrilled to see that there are several solutions using this software. $\endgroup$ – LCarvalho Aug 4 '16 at 21:25

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.