2
$\begingroup$

I came across a problem where I would like to animate small (but important!) oscillations around some state. Here I attach a very very simplified example.

This is a working example of my problem:

μ = 1/10;
η = 1/90;

points = {{0, 5*(1 + μ Cos[t])}, {1, 3*(1 + η Sin[t])}};

Animate[
  Show[
    ListPlot[points /. t -> tmax, 
      Joined -> True, AxesOrigin -> {0, 0}, 
      AspectRatio -> 1/2, PlotRange -> {{0, 1.1}, {0, 6}}], 
    ListPlot[points /. t -> tmax, PlotStyle -> Red]], 
  {tmax, 0, 50}, 
  AnimationRate -> 10, AnimationRunning -> False]

enter image description here

In the above both μ and η are big and the oscillations are visible. However, what if the parameters are smaller, for example:

μ = 1/1000000;
η = 1/900000;

In that case I can't see a damn thing and the animation is useless.

Any ideas on how to zoom-in to specific areas or enhance the oscillations (but not VIA manually changing the numerical value for μ or η)?

EDIT: In reality I am working with the following function for y coordinate: DROPBOX LINK and looks something like this enter image description here

$\endgroup$
  • $\begingroup$ Why don't you change the PlotRange? It seems you should take the problem the other way round: what do you want to show? Manipulate just did what you asked it to do. $\endgroup$ – anderstood Nov 9 '16 at 21:05
  • $\begingroup$ @anderstood: PlotRange won't do the job. Remember that I am trying to visualize oscillations with amplitude of micro/nano-meters while the relative difference in the position of point 1 and 2 is measured on a completely different scale (meters). Take attached working case for example: The relative difference in height is 2 m, while I want to somehow visualize the oscillations with amplitude of micrometers. I could use PlotRange to zoom in one point only, but that's not what I want or need. $\endgroup$ – skrat Nov 9 '16 at 21:28
  • $\begingroup$ I don't understand how you expect to see something moving in a scale where it corresponds to less than a pixel. I guess it's not possible if you want to keep the scale and do not want to amplify the motion. $\endgroup$ – anderstood Nov 9 '16 at 21:39
  • $\begingroup$ @anderstood Missunderstanding: enhancing the motion (the oscillation amplitudes) is exactly what I want but NOT via manually changing the numerical values of μ or η because in reality the equation for y coordinate is a bit more complex that the example here. In my OP I added an example of a function I am working with. So if anybody finds a way to enhance the oscillating part... - that would save my life. $\endgroup$ – skrat Nov 9 '16 at 22:07
2
$\begingroup$

I would make the animation quite differently than the way you propose.

  1. use a frame with custom y-coordinate ticks that magnify the y-coordinate values.

  2. use Graphics rather than ListPlot and Show.

  3. define points as a function.

With this approach the code is quite simple:

With[{μ = 1/10, η = 1/9},
  points[t_] := {{0, .5 + μ Cos[t]}, {1, .3 + η Sin[t]}}]
With[{scale = 10.^-5}, 
  yTicks = {#, # scale}& /@ Subdivide[.2, .6, 8]];

Manipulate[
  Graphics[
    {Line[points[t]], Red, AbsolutePointSize[5], Point[points[t]]},
    Frame -> True,
    FrameTicks -> {{yTicks, Automatic}, {Automatic, Automatic}},
    AspectRatio -> 1,
    PlotRange -> {{0, 1}, {.2, .6}},
    PlotRangePadding -> {.05, .025}],
  {t, 0, 2 π}]

demo

I did my coding in a Manipulate expression rather than an Animate expression because I find it easier to experiment with a Manipulate. However, it is trivial to convert between the two kinds of expressions, so you should have no trouble doing so.

Update

Here is a version that lets you set the parameters μ and η with sliders. I hope it addresses the issue you raised in the comment you made below.

Definitions

pts[t_, μ_, η_] := {{0, 5 + μ Cos[t]}, {1, 3 + η Sin[t]}}
yTicks[λ_] := Table[{i, N[i 10^-λ]}, {i, 1, 7, 1}]

Parameter controls

I define a custom slider to set the parameters because the built-in one doesn't offer something I need, which is to apply a scaling factor of 10^-λ to the values of the parameters which are displayed to the right of the sliders.

SetAttributes[delocalize, HoldFirst]
delocalize[symbl_Symbol] := 
  First @ StringSplit[SymbolName[Unevaluated @ symbl], "$"]

paramCntrl[var_Symbol, min_, max_, step_, λ_] :=
  Row[
    {delocalize[var], 
     " ", 
     Slider[Dynamic @ var, {min, max, step}], 
     " ", 
     Dynamic[var N[10^-λ]]}]

Animation

With[{λ = 6},
  DynamicModule[{μ, η},
    Panel[
      Column[
        {paramCntrl[μ, 0., 2., .1, λ],
         paramCntrl[η, 0., 2., .1, λ],
         Animate[
           Graphics[
             {Line[pts[t, μ, η]], Red, AbsolutePointSize[5], Point[pts[t, μ, η]]},
             Background -> White,
             Frame -> True,
             FrameTicks -> {{yTicks[λ], Automatic}, {Automatic, Automatic}},
             AspectRatio -> 1,
             PlotRange -> {{0, 1}, {1, 7}},
             PlotRangePadding -> {.1, .25},
             ImagePadding -> {{50, 5}, {15, 5}}],
           {t, 0, 2 π},
           Paneled -> False,
           AnimationRate -> .5,
           AnimationRunning -> False]}],
      Background -> Lighter[Gray, 0.8]]]]

animation

Notes

  1. I have given you two orders of magnitude over which to adjust μ and η.
  2. The values for μ and η shown in the above screen capture correspond to the values you gave in your question.
  3. The option AnimationRate -> 10 that you gave in your question is far too fast. I used AnimationRate -> .5.
  4. The solution I give here is rather more general than I think you actually need, but I believe is good provide more than is needed than to fall short.
  5. If I didn't use delocalize the labels to left of the parameter sliders would display as something like μ$123 and η$456.
| improve this answer | |
$\endgroup$
  • $\begingroup$ This seems like exactly what I need but I can't figure out how to zoom-in again after i change the parameters μ and η to smaller values. Can you help? $\endgroup$ – skrat Nov 10 '16 at 8:44
  • $\begingroup$ @skrat. I will look into it. It might be a little while before I can make an update because I'm busy with other things at the moment. It would help me to know the range of values over which the parameters are to vary. The order of 10^-6, which I used in my example, is already very small. How much smaller do you need to go? $\endgroup$ – m_goldberg Nov 10 '16 at 16:45
  • $\begingroup$ In my case the order of 10^-6 will do the job. $\endgroup$ – skrat Nov 10 '16 at 19:44
0
$\begingroup$

Presentation of an idea for the first animation:

\[Mu] = 1/10;
\[Eta] = 1/90;

points = {{0, 5 + \[Mu] Cos[t]}, {1, 3 + \[Eta] Sin[t]}};

a1 = Animate[
  Grid[{{Grid[{{ListPlot[{points /. t -> tmax, points /. t -> tmax}, 
         Joined -> {True, False}, 
         PlotStyle -> {Automatic, {Red, PointSize[Large]}}, 
         Axes -> None, AspectRatio -> Full, 
         PlotRange -> {{-0.05, .05}, {5. - 2 \[Mu], 5. + 2 \[Mu]}}, 
         Frame -> {{True, False}, {True, True}}], 
        ListPlot[{points /. t -> tmax, points /. t -> tmax}, 
         Joined -> {True, False}, 
         PlotStyle -> {Automatic, {Red, PointSize[Large]}}, 
         AxesOrigin -> {0, 0}, AspectRatio -> Full, 
         PlotRange -> {{0.95, 1.05}, {3. - 2 \[Mu], 3. + 2 \[Mu]}}, 
         Frame -> {{False, True}, {True, True}}, 
         FrameTicks -> {{True, All}, {All, True}}]}}]}, {Grid[{{Show[
         ListPlot[points /. t -> tmax, Joined -> True, 
          AxesOrigin -> {0, 0}, AspectRatio -> 1/2, 
          PlotRange -> {{-.1, 1.1}, {0, 6}}], 
         ListPlot[points /. t -> tmax, PlotStyle -> Red], 
         Frame -> True, FrameTicks -> {{All, All}, {All, True}}, 
         FrameTicksStyle -> {{Automatic, 
            Directive[FontOpacity -> 0]}, {Automatic, Automatic}}, 
         ImageSize -> 350]}}]}}], {tmax, 0, 50}, AnimationRate -> 10, 
  AnimationRunning -> False]

enter image description here

For the second case:

\[Mu] = 1/1000000;
\[Eta] = 1/900000;

points = {{0, 5 + \[Mu] Cos[t]}, {1, 3 + \[Eta] Sin[t]}};

ticks1 = {{-\[Mu], -Superscript[10, Log10@\[Mu]]}, {0, 0}, {\[Mu], 
    Superscript[10, Log10@\[Mu]]}};
ticks2 = {{1 - \[Mu], 1 - Superscript[10, Log10@\[Mu]]}, {1, 
    1}, {1 + \[Mu], 1 + Superscript[10, Log10@\[Mu]]}};

ticks3 = {{5. - \[Mu], 5 - Superscript[10, Log10@\[Mu]]}, {5, 
    5}, {5. + \[Mu], 5 + Superscript[10, Log10@\[Mu]]}};
ticks4 = {{3. - \[Mu], 3 - Superscript[10, Log10@\[Mu]]}, {3, 
    3}, {3. + \[Mu], 3 + Superscript[10, Log10@\[Mu]]}};

a2 = Animate[
  Grid[{{Grid[{{ListPlot[{points /. t -> tmax, points /. t -> tmax}, 
         Joined -> {True, False}, 
         PlotStyle -> {Automatic, {Red, PointSize[Large]}}, 
         Axes -> None, AspectRatio -> Full, 
         PlotRange -> {{-\[Mu], \[Mu]}, {5. - 2 \[Mu], 5. + 2 \[Mu]}},
          Frame -> {{True, False}, {True, True}}, 
         FrameTicks -> {{ticks3, True}, {ticks1, True}}], 
        ListPlot[{points /. t -> tmax, points /. t -> tmax}, 
         Joined -> {True, False}, 
         PlotStyle -> {Automatic, {Red, PointSize[Large]}}, 
         AxesOrigin -> {0, 0}, AspectRatio -> Full, 
         PlotRange -> {{1 - \[Mu], 1 + \[Mu]}, {3. - 2 \[Mu], 
            3. + 2 \[Mu]}}, Frame -> {{False, True}, {True, True}}, 
         FrameTicks -> {{All, ticks4}, {ticks2, 
            True}}]}}]}, {Grid[{{Show[
         ListPlot[points /. t -> tmax, Joined -> True, 
          AxesOrigin -> {0, 0}, AspectRatio -> 1/2, 
          PlotRange -> {{-.1, 1.1}, {0, 6}}], 
         ListPlot[points /. t -> tmax, PlotStyle -> Red], 
         Frame -> True, FrameTicks -> {{All, All}, {All, True}}, 
         FrameTicksStyle -> {{Automatic, 
            Directive[FontOpacity -> 0]}, {Automatic, Automatic}}, 
         ImageSize -> 350]}}]}}], {tmax, 0, 50}, AnimationRate -> 10, 
  AnimationRunning -> False]

enter image description here

| improve this answer | |
$\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.