12

How to draw the image of a circle $x^2+(y-1)^2<1/4$ under the action of a transformation of the phase flow for the equation $\dot{x}=y,\ \dot{y}=-\sin x$? Here $\dot{x}$ means $dx/dt$. Any help or suggestions will be appreciated!

The following code shows how to plot the trace of a point under that action which may be helpful.

splot = 
  StreamPlot[{y, -Sin[x]}, {x, -4, 4}, {y, -3, 3}, StreamColorFunction -> "Rainbow"];
Manipulate[
  Show[splot, 
    ParametricPlot[
      Evaluate[First[{x[t], y[t]} /. 
        NDSolve[{x'[t] == y[t], y'[t] == -Sin[x[t]], Thread[{x[0], y[0]} == point]}, 
          {x, y}, {t, 0, T}]]], 
      {t, 0, T}, 
      PlotStyle -> Red]], 
  {{T, 2}, 1, 20}, 
  {{point, {3, 0}}, Locator}, 
  SaveDefinitions -> True]
m_goldberg
  • 107,779
  • 16
  • 103
  • 257
Eden Harder
  • 1,145
  • 6
  • 22

2 Answers2

18

One way is to create a Polygon and transform the vertices under the flow. I used NDSolve to solve the flow for initial points in a square containing the OP's disk. Then I made a listable Function that can be applied to a the vertices of the polygon.

Since only the flow depends on the time t, I used a GraphicsComplex so that the vertices come first as a list. That way I can apply flow to just that part and wrap it in Dynamic. That limits the updating (by the Kernel) to just the vertices (plus the redrawing by the Front End).

flow = Function[{t, a, b},
   Evaluate[{x[t, a, b], y[t, a, b]} /. 
     First @ NDSolve[{D[x[t, a, b], t] == y[t, a, b], 
        D[y[t, a, b], t] == -Sin[x[t, a, b]], 
        x[0, a, b] == a, y[0, a, b] == b},
        {x, y}, {t, 0, 20}, {a, -1/2, 1/2}, {b, 1/2, 3/2}]],
   Listable];
circlePts = With[{n = 100}, 
    Table[{0., 1.} + {Cos[t], Sin[t]}/2, {t, 0, 2 Pi - 2 Pi/n, 2 Pi/n}]];

Manipulate[
 Show[
  splot,
  Graphics[GraphicsComplex[
    Dynamic @ flow[t, circlePts[[All, 1]], circlePts[[All, 2]]],
    {Opacity[0.6], Red, Polygon[Range@Length@circlePts]}
    ]],
  AspectRatio -> Automatic
  ],
 {t, 0., 20.}
 ]

Manipulate animation

Michael E2
  • 235,386
  • 17
  • 334
  • 747
4

This can also be done using ParametricPlot, as I will show in code here below. Special thanks to Michael E2 for sorting out a bug and proposing polar coordinates. The alternative would have been to use RegionFunction.

Clear[x, y]

sol[px_, py_] := sol[px, py] = First@NDSolve[{
     x'[t] == y[t],
     y'[t] == -Sin[x[t]],
     Thread[{x[0], y[0]} == {px, py}]
     }, {x, y}, {t, 0, 20}]

pos[px_, py_, T_] := Through[({x, y} /. sol[px, py])[T]]

pp[t_] := pp[t] = ParametricPlot[
   pos[r Cos[theta], 1 + r Sin[theta], t], {r, 0, 0.5}, {theta, 0, 
    2 Pi}, PlotPoints -> {3, 30}, Mesh -> False
   ]

splot = StreamPlot[{y, -Sin[x]}, {x, -4, 4}, {y, -3, 3}, StreamColorFunction -> "Rainbow"];

Array[pp, 20];

Manipulate[Show[splot, pp[t]], {t, 0, 20, 1}]

Observe that memoization is used to make this fast, that is why I have that seemingly useless line Array[pp, 20] in there. It ensures that once the manipulate is displayed it will be entirely smooth. It's not necessary and depends on one's purpose. I was initially worried about speed, but I am happy to report that with memoization in place it is not very slow at all.

C. E.
  • 70,533
  • 6
  • 140
  • 264
  • Thanks very much! But why you write 'sol[px_, py_] := sol[px, py] =' and 'pp[t_] := pp[t] =' to define functions? – Eden Harder Oct 27 '13 at 01:05
  • @EdenHarder This is a case of simple memoization to improve speed, read this for details: http://mathematica.stackexchange.com/a/25150/731 – C. E. Oct 27 '13 at 01:12