3
$\begingroup$

Is it possible to create a GIF animation like the one shown below, using Mathematica?

prism


UPDATE

I have mainly two puzzles:

  1. How do I obtain the rendered trigonometric curves (unnecessarily animated);- So I want to know what kind of Mathematica commands can create a "3D rendered tube" like curves per the parametric equations? -- I mean curves that look like the ones in the picture below:

tube1tube2

  1. How do I make sure these curves are smoothly continuous even after being refracted; I also need some clues in representing the equations of the curves (in parametric form or other forms), before and after being refracted; In order to handle the refraction smoothly and continuously, I think parametric equation forms of the curves are necessary since some of the curves may have only implicit form.

For example:

wave

This photo was found from the Internet; I need such clues to create similar GIF animations using Mathematica;

Before creating similar GIF animations, I need to solve the two puzzles; I think there is no other obstacle for me to create it;

Update$^{(2)}$

I am not simply requesting code, answers resolve the two questions mentioned and illustrated with photos above will be accepted. I hope this can be made clearer.

However, there is no reason that I refuse answers with codes which can create similar GIF photos.

Now there is already acceptable answer. I will try to work on it.

$\endgroup$
  • 1
    $\begingroup$ Yes, this is possible. Which of Mathematica plotting commands cause you trouble? $\endgroup$ – Sjoerd C. de Vries Sep 10 '14 at 10:10
  • $\begingroup$ Are these curves by 3D plots or other command? I just have no idea of it. Do you have an answer to it? I am eager to learn it $\endgroup$ – LCFactorization Sep 10 '14 at 10:18
  • $\begingroup$ I will update my question. $\endgroup$ – LCFactorization Sep 10 '14 at 10:31
  • 2
    $\begingroup$ have you tried something, or did you just find a picture and want someone to write code for you to recreate it? There is no dark side in the moon, really. Matter of fact, it's all dark. $\endgroup$ – george2079 Sep 10 '14 at 12:08
  • 4
    $\begingroup$ Usually we discourage "GimmeTehCodez" questions. See the meta post here. There are exceptions but they should be rare. $\endgroup$ – Jens Sep 10 '14 at 17:05
4
$\begingroup$

Here is an example of a function drawn along a parametric path:

 points = {{0, 0}, {1, 1}, {1.8, 1.8}, {2, 2}, {3, 3/2}, {4, 1}};
 path = BSplineFunction[points];
 ipath = Interpolation[
      Transpose@({Prepend[Accumulate[Norm /@ Differences@#], 0], #} &@
          Table[path@x, {x, 0, 1, .01}])];
 plen = ipath[[1, 1, 2]];
 d2 = Derivative[1]@ipath;
 Show[{ParametricPlot[path@x, {x, 0, 1}], 
       ParametricPlot[ipath@x - (1 + (x/plen)^2) Sin[40 x + 10 x^2] 
          {1, -1} Normalize[Reverse@d2@x]/10, {x, 0, plen}], 
       ListPlot[points, Joined -> True, PlotStyle -> Dashed]}, 
       PlotRange -> All]

enter image description here

Note the trick here is to get the parametric representation in terms of the path length.

3D version:

Show[Graphics3D@
      Tube@Table[
         Append[ipath@x - (1 + (x/plen)^2) Sin[
            20 x + 5 x^2] {1, -1} Normalize[Reverse@d2@x]/10 , 0],
             {x, 0, plen, .01}], Boxed -> False]

enter image description here

$\endgroup$
4
$\begingroup$

You could try something like this

Animate[
 Graphics[{
   Black, Rectangle[{0, 0}, {120, 100}],
   EdgeForm[{Thick, GrayLevel[0.6]}], GrayLevel[0.3], 
   Triangle[{{110, 10}, {10, 10}, {60, 90}}],
   EdgeForm[None], GrayLevel[0.8], 
   Polygon[{{0, 30}, {0, 35}, {35, 50}, {31, 43}}], Inset[
    Plot[.0025 t Sin[c .25 t], {t, 0, 100}, Axes -> False, 
     PlotRange -> {{0, 100}, {-1.5, 1.5}}]
    , {64, 45}]
   }]
 , {c, 12, 8}]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you! this is very useful. Let's neglect the refraction index difference when using Snell's law. Only from KnotData related commands I saw 3D tube like curve redenring, e.g.: Graphics3D[{Orange, Specularity[White, 70], KnotData[{8, 3}, "ImageData"]}, Boxed -> False, ViewPoint -> {0, 0.1, 5}] $\endgroup$ – LCFactorization Sep 10 '14 at 12:54
  • $\begingroup$ @LCFactorization check the edit. Is it the rendering effect for the sin curves you asking for? $\endgroup$ – Phab Sep 10 '14 at 13:09
  • $\begingroup$ I have posted 3D curve examples to illustrate my request; additionally, did you notice how the original GIF sin curves handle refractions? this is another question of mine. When the curve intersects the edge of medium, the transmission direction changes but the curves are kept as smoothly continuous. $\endgroup$ – LCFactorization Sep 10 '14 at 13:13
  • $\begingroup$ In order to handle the refraction smoothly and continuously, I think parametric equation form of the curves is necessary since some of them might have only implicit form. $\endgroup$ – LCFactorization Sep 10 '14 at 13:20
4
$\begingroup$

I'll leave the animation to somebody else:

refWave[{x1_, y1_}, {m1_, m2_}, h_, d_, f_, x_] := {x, 
   y1 + (x - x1) (m1 + (m2 - m1) With[{t = Clip[Rescale[x - x1, {-h, h}], {0, 1}]}, 
                                      t^2 (3 - 2 t)])} + 
   d Sin[2 π f x] Normalize[{-Piecewise[{{m1, x - x1 < -h}, {m2, h < x - x1}},
                                        (m1 + m2)/2 + (m2 - m1) (x - x1)
                                                      (3/2 - ((x - x1)/h)^2)/h], 1}]

ParametricPlot[Table[refWave[With[{u = 1/2 + t/10}, {-Sqrt[3]/2 (u - 1), (3 u - 1)/2}],
                             {1/10 + t/20, 1/3 - 3 t/2}, 1/20, 1/50, 8/(5/4 - t), x],
                     {t, 7/10, 1/10, -1/10}] // Evaluate, {x, -1/2, 3/2},
               AspectRatio -> Automatic, Axes -> None, Background -> Black, 
               Epilog -> {White, Polygon[{{-17/(20 Sqrt[3]), 3/20},
                                          {-6 Sqrt[3]/25, 7/25},
                                          {-3/2, (12 Sqrt[3] - 5)/250},
                                          {-3/2, (17 Sqrt[3] - 45)/300}}]}, 
               PlotRange -> {{-3/2, 3/2}, {-3/4, 5/4}}, 
               PlotStyle -> (RGBColor /@ {"#9400D3", "#4B0082", "#0000FF",
                                          "#00FF00", "#FFFF00", "#FF7F00", "#FF0000"}), 
               Prolog -> {Directive[FaceForm[GrayLevel[1/10]],
                                    EdgeForm[Directive[Gray, Thick]]], RegularPolygon[3]}]

prism

$\endgroup$

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.