Search code examples
wolfram-mathematicawolfram-cdf

code that plots fast outside Manipulate, but plots slow inside Manipulate. Help in finding out why


Given code which plots result of a solution to ODE using a fast algorithm using Dynamics directly, I find that it plots the solution very fast on the screen.

I integrated this algorithm into Manipulate[], and noticed that the plotting part is now much slower that it was before.

I spend 4 hrs on this, and can't see why this is. I hope someone can spot the problem and what the issue is.

The algorithm is the one just posted today by Leonid in his answer to my other question here (thanks again Leonid!)

The algorithm is very fast, and also renders the plot fast. But it uses Dynamics directly. I'd like to use it inside Manipulate.

I did integrate it into Manipulate, as best as I know how, as the code is advanced for me, I am not sure if I did it right, but the result is correct.

The plot does work and generate the correct plot, as the original algorithm, but now the speed of plotting is now much slower. All parameters are the same in both cases (i.e. the problem parameters). This is an issue I have been struggling with for long time. How to speed up the fps when using Manipulate.

So, the problem could be in my integrating it to run inside Manipulate, I made something not efficient, or it could be because Manipulate already uses DynamicModule[] and this had a side effect in making the plot rendering slower or the whole process slower.

I'll post my Manipulate code, which I integrating Leonid code in (I tried many different ways, and they all plot slow, this is one version below).

Manipulate[

 Module[{ll = emptyList[], sol, plot, t, y, angle, 
   llaux = emptyList[]},
  plot[] := 
   Graphics[{Hue[0.67`, 0.6`, 0.6`], Line[fromLinkedList[ll]]}, 
    AspectRatio -> 1/GoldenRatio, Axes -> True, 
    AxesLabel -> {"time", "angle"}, 
    PlotRange -> {{0, max}, {-Pi/4, Pi/4}}, PlotRangeClipping -> True];

  llaux = ll;
  sol := First@
    NDSolve[{y''[t] + 0.01 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4, 
      y'[0] == 0}, y, {t, time, time + 1}];
  angle := y /. sol;

  ll := With[{res = 
      If[llaux === emptyList[] || pop[llaux][[1]] != time, 
       addToList[llaux, {time, angle[time]}],(*else*)llaux]},
    llaux = res];

  Dynamic[plot[]]
  ]
 ,
 {{time, 0, "run"}, 0, max, Dynamic@delT, AnimationRate -> 1, 
  ControlType -> Trigger}, {{delT, 0.01, "delT"}, 0.01, 1, 0.01, 
  Appearance -> "Labeled"},
 {{y0, Pi/4, "y(0)"}, -Pi, Pi, Pi/100, Appearance -> "Labeled"},
 {{yder0, 0, "y'(0)"}, -1, 1, .1, Appearance -> "Labeled"},
 {{linkedList, {}}, None},

 TrackedSymbols :> {time},
 Initialization :> (
   max = 200;
   toLinkedList[data_List] := Fold[linkedList, linkedList[], data]; 
   fromLinkedList[ll_linkedList] := 
    List @@ Flatten[ll, Infinity, linkedList]; 
   addToList[ll_, value_] := linkedList[ll, value];
   pop[ll_] := Last@ll;
   emptyList[] := linkedList[];
   )
 ]

Here is the original code, exactly the same as was posted by Leonid here, but I added the 2 parameters at the top, so both versions will be running the exact same parameter to compare speed more easily. You'll notice when you run this, how fast the plot generate on the screen compare to the above.

I'd like help in finding why the difference in speed. I am now going by the assumption that the speed difference in plotting is due to Dyanmics interaction inside Manipulate, since I know the algorithm is very fast outside.

max = 200; delT = 0.01;

ClearAll[linkedList, toLinkedList, fromLinkedList, addToList, pop, 
  emptyList];

(*SetAttributes[linkedList,HoldAllComplete];*)
toLinkedList[data_List] := Fold[linkedList, linkedList[], data];
fromLinkedList[ll_linkedList] := 
  List @@ Flatten[ll, Infinity, linkedList];
addToList[ll_, value_] := linkedList[ll, value];
pop[ll_] := Last@ll;
emptyList[] := linkedList[];

Clear[getData];
Module[{ll = emptyList[], time = 0, restart, plot, y}, 
 getData[] := fromLinkedList[ll];

 plot[] := 
  Graphics[{Hue[0.67`, 0.6`, 0.6`], Line[fromLinkedList[ll]]}, 
   AspectRatio -> 1/GoldenRatio, Axes -> True, 
   AxesLabel -> {"time", "angle"}, 
   PlotRange -> {{0, max}, {-Pi/4, Pi/4}}, PlotRangeClipping -> True];

 DynamicModule[{sol, angle, llaux}, 
  restart[] := (time = 0; llaux = emptyList[]);
  llaux = ll;
  sol := First@
    NDSolve[{y''[t] + 0.01 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4, 
      y'[0] == 0}, y, {t, time, time + 1}];
  angle := y /. sol;

  ll := With[{res = 
      If[llaux === emptyList[] || pop[llaux][[1]] != time, 
       addToList[llaux, {time, angle[time]}],(*else*)llaux]},
    llaux = res
    ];

  Column[{
    Row[{Dynamic@delT, Slider[Dynamic[delT], {0.01, 1., 0.01}]}],
    Dynamic[time, {None, Automatic, None}], 
    Row[{Trigger[Dynamic[time], {0, max, Dynamic@delT}, 
       AppearanceElements -> {"PlayPauseButton"}],
      Button[Style["Restart", Small], restart[]]}
     ],
    Dynamic[plot[]]}, Frame -> True
   ]
  ]
 ]

enter image description here

Thanks again for any hints or things to try.

Update

Ok, this is getting interesting. I never knew one can make a CDF just using Dynamics, I thought one must use Manipulate. But I was wrong. I just tried one, and it actually works! Here it is on my site, a simulation of damped driven pendulum (which exhibits chaotic motion due to presence of driven force on the joint), written just using Dynamics, no Manipulate.

The code for the above is the following:

DynamicModule[{sol, angle, bob, r, time = 0, animationRate = 1},
 (*simulation of damped and driven pendulum, exhibit chaotic motion*)

 Dynamic@Grid[{
    {Trigger[Dynamic[time], {0, Infinity, 0.01}, animationRate, 
      AppearanceElements -> {"PlayPauseButton", "ResetButton"}], 
     Style["time (sec)", 10], Dynamic[time]},
    {
     Dynamic@Show[Graphics[{
         {Dashed, Gray, Thin, Circle[{0, 0}, 1]},
         {Red, Thick, Line[{{0, 0}, bob}]},
         {Blue, PointSize[0.1], Point[bob]}
         }, ImagePadding -> 10], ImageSize -> 300], SpanFromLeft
     }}, Frame -> True, Alignment -> Left],

 Initialization :>
  (
   sol := 
    First@NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 1.5 Cos[t], 
       y[0] == Pi/4, y'[0] == 0}, y, {t, time, time + 1}, 
      Sequence@ndsolveOptions];
   bob := {Sin[(y /. sol)[time]], - Cos[(y /. sol)[time]]};

   ndsolveOptions = {MaxSteps -> Infinity, 
     Method -> {"StiffnessSwitching", 
       Method -> {"ExplicitRungeKutta", Automatic}}, 
     AccuracyGoal -> 10, PrecisionGoal -> 10};
   )
 ]

enter image description here

This is my very first CDF using direct dynamics. If you like to see the difference in performance in updating of the screen, here is a version of the above, using Manipulate. I did not notice much difference in this case, but notice this is plotting the pendulum position, no buffering is needed, and no data handling. Simply plot of point by point of the bob position.

Manipulate[
 (
  sol = First@
    NDSolve[{y''[t] + 0.1 y'[t] + Sin[y[t]] == 1.5 Cos[t], 
      y[0] == Pi/4, y'[0] == 0}, y, {t, time, time + 1}, 
     Sequence@ndsolveOptions];
  bob = {Sin[(y /. sol)[time]], - Cos[(y /. sol)[time]]};

  Show[Graphics[{
     {Dashed, Gray, Thin, Circle[{0, 0}, 1]},
     {Red, Thick, Line[{{0, 0}, bob}]},
     {Blue, PointSize[0.1], Point[bob]}
     }, ImagePadding -> 10], ImageSize -> 300]
  ),

 {{time, 0, "run"}, 0, Infinity, 0.01, AnimationRate -> animationRate,
   AppearanceElements -> {"PlayPauseButton", "ResetButton"}},

 Initialization :>
  (
   animationRate = 1;
   ndsolveOptions = {MaxSteps -> Infinity, 
     Method -> {"StiffnessSwitching", 
       Method -> {"ExplicitRungeKutta", Automatic}}, 
     AccuracyGoal -> 10, PrecisionGoal -> 10};
   )
 ]

I think that one can now make a CDF from just Dynamics is very interesting.


Solution

  • It is a matter of AnimationRate. Setting this the same in both gives identical timings (kind of hard to time triggers btw): Evaluate:

        Clear[getData];
    Module[{ll = emptyList[], time = 0, restart, plot, y, timeinit}, 
     getData[] := fromLinkedList[ll];
     timeinit[n_ /; 0.01 < n < .5] := (init = AbsoluteTime[]);
     plot[] := 
      Graphics[{Hue[0.67`, 0.6`, 0.6`], Line[fromLinkedList[ll]]}, 
       AspectRatio -> 1/GoldenRatio, Axes -> True, 
       AxesLabel -> {"time", "angle"}, 
       PlotRange -> {{0, max}, {-Pi/4, Pi/4}}, PlotRangeClipping -> True, 
       PlotLabel :> 
        Row[{"seconds used: ", (timeinit[time]; 
           If[time < 1, "", Round[AbsoluteTime[] - init]])}]];
     DynamicModule[{sol, angle, llaux}, 
      restart[] := (time = 0; llaux = emptyList[]);
      llaux = ll;
      sol := First@
        NDSolve[{y''[t] + 0.01 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4, 
          y'[0] == 0}, y, {t, time, time + 1}];
      angle := y /. sol;
      ll := With[{res = 
          If[llaux === emptyList[] || pop[llaux][[1]] != time, 
           addToList[llaux, {time, angle[time]}],(*else*)llaux]}, 
        llaux = res];
      Column[{Row[{Dynamic@delT, 
          Slider[Dynamic[delT], {0.01, 1., 0.01}]}], 
        Dynamic[time, {None, Automatic, None}], 
        Row[{Trigger[Dynamic[time], {0, max, Dynamic@delT}, 
           AppearanceElements -> {"PlayPauseButton"}, 
           AnimationRate -> 15], 
          Button[Style["Restart", Small], restart[]]}], Dynamic[plot[]]}, 
       Frame -> True]]]
    

    (* and: *)

        Manipulate[
     Module[{ll = emptyList[], sol, plot, t, y, angle, 
       llaux = emptyList[], timeinit, init},
      timeinit[n_ /; 0.01 < n < .5] := (init = AbsoluteTime[]);
      plot[] := 
       Graphics[{Hue[0.67`, 0.6`, 0.6`], Line[fromLinkedList[ll]]}, 
        AspectRatio -> 1/GoldenRatio, Axes -> True,
        PlotLabel :> 
         Row[{"seconds used: ", (timeinit[time]; 
            If[time < 1, "", Round[AbsoluteTime[] - init]])}],
        AxesLabel -> {"time", "angle"}, 
        PlotRange -> {{0, max}, {-Pi/4, Pi/4}}, PlotRangeClipping -> True];
      llaux = ll;
      sol := First@
        NDSolve[{y''[t] + 0.01 y'[t] + Sin[y[t]] == 0, y[0] == Pi/4, 
          y'[0] == 0}, y, {t, time, time + 1}];
      angle := y /. sol;
      ll := With[{res = 
          If[llaux === emptyList[] || pop[llaux][[1]] != time, 
           addToList[llaux, {time, angle[time]}],(*else*)llaux]}, 
        llaux = res];
      Dynamic[plot[]]], {{time, 0, "run"}, 0, max, Dynamic@delT, 
      AnimationRate -> 15, ControlType -> Trigger}, {{delT, 0.01, "delT"},
       0.01, 1, 0.01, Appearance -> "Labeled"}, {{y0, Pi/4, "y(0)"}, -Pi, 
      Pi, Pi/100, Appearance -> "Labeled"}, {{yder0, 0, "y'(0)"}, -1, 
      1, .1, Appearance -> "Labeled"}, {{linkedList, {}}, None}, 
     TrackedSymbols :> {time}, Initialization :> (max = 200;
       toLinkedList[data_List] := Fold[linkedList, linkedList[], data];
       fromLinkedList[ll_linkedList] := 
        List @@ Flatten[ll, Infinity, linkedList];
       addToList[ll_, value_] := linkedList[ll, value];
       pop[ll_] := Last@ll;
       emptyList[] := linkedList[];)]