# How can I effectively performance-profile Dynamics?

How to optimize performance-wise a complex dynamic expression (like a GUI) with lots of dynamically updated components, which require different update-frequencies?

I was hesitant to ask this question as it does not focus on a very specific problem, but is about general speed (and memory) improvement tricks. The gui is a primitive scrolling racer where the user has to manipulate a controller to keep an object on a winding path. I did it for a cognitive experiment for humans but it definitely has potential in the gaming market :) Also - as far as I know - Mathematica was not used (and was not designed) to develop realtime platformer/racer games (or alike), so the question naturally arises: can Mathematica do it? This, I think, is untrodden land worthy of exploration. Below is a toy model of a game. I tried to keep it as abstract as possible to make it general and thus applicable to a wider domain. If you still think that this question is too localized/not really a question, please say so and I remove it.

Details of the code

The code might seem too long, but I assure you, it is not complicated. If the game is started with the Start button, the function start initiates a ScheduledTask that sets the in-game timer with updateFrequency = .05 seconds. The controller can be dragged continuously, and it generates a coordinate pair ${x_1, x_2}$, stored in ctrl, that is fed to the controlFunction, that defines the actual vertical position (y) of the yellow arrow (the "ship"). The responsible equation is:

$$y = y* + k_1 x_1 + k_2 x_2$$

where $y*$ is the $y$ value of the position of the arrow in the previous timestep. Now the hard part is, that from time to time, parameters $k_1$ and $k_2$ are randomly changed (every 100 steps, using the change function), so the controller is changed as well. The controller background always displayes the actual gradient of ${\varDelta}y$. The different background colors in each episode indicate that the controller has changed. I did not use Locator or LocatorPane, as those seemed to be unresponsive, especially when the underlying controller is changed. While the controller is updated continuously, the actual position of the arrow is only updated via the update function when the running ScheduledTask tells so (in every 0.05 sec). Also, moving the controller produces some sounds that helps the user to learn the control gradient.

DynamicModule[{
optimumFunction = Sin[#*\[Pi]/100] &, (* defines the winding optimum zone *)
updateFrequency = .05, (* update plot every 0.05 seconds *)
xFrame = 100, (* horizontal range to show (last 100 steps) *)
yFrame = 30, (* default vertical range to show *)
maxTime = 1000, (* length of a run. Real word time is ~ 0.05 * 1000 = 50 sec *)
episodeNum = 5, (* number of different episodes: each episode lasts 200 timesteps *)

active, controlActive, ctrl, data, time, \[Theta], \[Rho], y,
yRange, xRange, gradient, crosshair, ship, episodeColors,
episodeBorders,
reset, sound, start, stop, update, change, controlFunction
},

(* Internal functions *)
reset[] := (active = False; ctrl = {0, 0}; data = {}; time = 0; y = 0; change[]; update@0);
sound[{x_, y_}, vol_] := Sound[SoundNote[Floor@Rescale[controlFunction[x, y], {-1, 1}, {-20, 40}], .3, "Strings"], SoundVolume -> vol];
start[] := (active = True; RunScheduledTask[update@(time++), {updateFrequency, \[Infinity]}]);
update[t_] := Block[{xAll, yAll, n = 2},
y = y + controlFunction @@ ctrl; (* update the position of the ship *)
data = Append[data, {t, y}]; (* save position of the ship *)
yRange = ({Min[Min@#, -{-1.5, 1.5}], Max[Max@#, {-1.5, 1.5}]}*1.3) &@(Last /@ Take[data, -Min[yFrame, Length@data]]); (* calculate vertical and horizontal ranges to show on the scrolling plot*)
xRange = {Max[0, time - xFrame], Max[xFrame, time]};
xAll = N@Abs@(Subtract @@ xRange); (* absolute x-range shown *)
yAll = N@Abs@(Subtract @@ yRange); (* absolute y-range shown *)
\[Theta] = Mod[ArcTan @@ #, 2 \[Pi], 0] &@ If[t < n, {1, 0}, (data[[-1]] - data[[-n]])/{xAll, yAll}]; (* rotation angle of the arrow, dependent on previous steps and the actual plot range used *)
If[0 < t < maxTime \[And] Mod[t, maxTime/episodeNum] == 0, change[]]; (* change controllers *)
If[t >= maxTime, stop[]]; (* stop run *)
];
change[] := (
\[Rho] = RandomReal[{-.5, .5}, 2]; (* \[Rho] = {k1, k2}, the two random parameters of the gradient *)
controlFunction = {#1, #2}.\[Rho] &; (* the control function defining the gradient *)
DensityPlot[(controlFunction[x, y]), {x, -1, 1}, {y, -1, 1},
ImageSize -> 200,
ColorFunction -> ((Lighter@
ColorData["Rainbow"][Rescale[#, {-1, 1}]]) &),
ColorFunctionScaling -> False,
PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}, Mesh -> {{{0, Thick}}},
MeshFunctions -> {#3 &}];
);

(* Initialization *)
crosshair =
Graphics[{White, Disk[{0, 0}, 1.5], Darker@Blue, Disk[], Blue,
AbsoluteThickness@1, Circle[{0, 0}, 1.5], Line@{{0, -2}, {0, 2}},
Line@{{-2, 0}, {2, 0}}}, ImageSize -> 15];
ship = Graphics[{FaceForm@Yellow, EdgeForm@{Gray, Thick}, Polygon@{{0, -1}, {4, 0}, {0, 1}, {0, -1}}}, ImageSize -> 30];
episodeBorders = Partition[Range[0, maxTime, maxTime/episodeNum], 2, 1];
episodeColors = {Hue[.66, 1, 1], Hue[.13, .8, 1], Hue[.23, 1, .8], Hue[.5, .4, .6], Hue[.74, 1, .8]};
reset[]; (* initialize first episode *)

(* Output *)
Panel@Grid[{{
Column@{

(* Buttons *)
Row@{
Dynamic@Button[If[active, "Stop", "Start"], If[active, stop[], start[]]],
Button["Reset", stop[]; reset[]]
},

(* Controls *)
Framed@Dynamic[
If[! active,
Graphics[{}, Frame -> False, ImageSize -> 200,
ImagePadding -> 5, Background -> GrayLevel@.9],
EventHandler[Dynamic[
If[controlActive, ctrl = Clip@MousePosition@"Graphics"; EmitSound@sound[ctrl, .5]];
Graphics[{
Polygon[{{-1, -1}, {-1, 1}, {1, 1}, {1, -1}},
VertexTextureCoordinates -> {{0, 0}, {0, 1}, {1, 1}, {1, 0}}],
Dynamic@Inset[crosshair, ctrl]
}, Frame -> False, ImageSize -> 200, ImagePadding -> 0],
TrackedSymbols :> {controlActive}],
{
"MouseDown" :> (controlActive = True;),
"MouseUp" :> (controlActive = False;)
}]],
},

(* Scrolling pane *)
Panel[Dynamic[
Show[
(* background colors *)
{FaceForm@{Opacity@.2, #1}, EdgeForm@None,
Rectangle @@ {{First@#2, -100}, {Last@#2, 100}}} &,
{episodeColors, episodeBorders}],
PlotRange -> {Automatic, yRange}],

(* initial/terminal gray edge (before time 0 and after maxTime *)
Plot[0, {t, 0 - maxTime*.1, 0}, PlotStyle -> None, FillingStyle -> GrayLevel@.9, Filling -> {1 -> Top, 1 -> Bottom}, PlotRange -> {Automatic, yRange}],
Plot[0, {t, maxTime, maxTime*1.1}, PlotStyle -> None, FillingStyle -> GrayLevel@.9, Filling -> {1 -> Top, 1 -> Bottom}, PlotRange -> {Automatic, yRange}],

(* desired zone (winding path) *)
Plot[{optimumFunction@t - .5, optimumFunction@t,
optimumFunction@t + .5}, {t, Max[0, time - xFrame] - 20,
Max[xFrame, time] + 100},
PlotStyle -> {None,
Directive[GrayLevel[0, .7], AbsoluteThickness@3, Dashed],
None}, FillingStyle -> Hue[.3, 8, .8, .5],
Filling -> {1 -> {3}}],

(* ship & trajectory *)
Graphics[{GrayLevel@.6, AbsoluteThickness@2,
Dynamic@Line@Most@data,
Inset[Rotate[ship, \[Theta]], Last@data]}],

(* options *)
PlotRange -> {xRange, yRange},
ImageSize -> Full, AspectRatio -> Full,
Frame -> True, FrameTicks -> False, Axes -> False,
GridLines -> {Range[0, maxTime, maxTime/episodeNum], None},
Method -> {"GridLinesInFront" -> True}
],
TrackedSymbols :> {yRange, xRange, time, y, \[Theta], active}
], ImageSize -> {800, 400}]
}}, Alignment -> {Left, Center}]]


I know that the best advice here is that

• only update if necessary;
• only update the smallest minimum that needs to be updated.

I was keeping that in mind during development. Most of the scrolling graphics are pre-generated (the sine wave and background colors as rectangles) and only the PlotRange is changed dynamically. Explicit TrackedSymbols are used to update only those symbols that should be updated. Still, the gui is lagging: the controller follows the moused with a reasonably large lag, that does not feel smooth. Also, during every episode change, there is a short pause. Now, this lagging is inacceptable: my first Commodore had only 64 KB memory, but it could run such games way smoother than Mathematica.

1. How can I understand what uses up time during dynamic evaluation (considering that I do not want to print AbsoluteTiming values all the time)? How can I profile such a gui?
2. How can I improve the code further to give a smooth feeling?

I should tell here that this code uses a lot of stuff from all around Mathematica.SE, so if you run into some familiar lines, don't be surprised. Thanks for all your helpful input. Also thanks for Oleksandr for the title!

EDIT at 7. 8. 2012

According to Rojo's profiling and comments in chat, here is a modified version of the scrolling output (just replace the original internal Panel[Dynamic[Show[...]]] with the code below. It removes the wrapping Dynamic around Show and instead uses a dynamically updated PlotRange (also I moved the Dynamics in the ship and trajectory to the inside of Inset and Line). Now while this updates much faster, and any check on xRange and yRange indicates that they are updated correctly at every timestep, the displayed plot range is only updated when the controller is moved, meaning that if the controller is not touched, the ship will just move out of the range on the right (clearly unwanted).

Panel[Show[
{FaceForm@{Opacity@.2, #1}, EdgeForm@None, Rectangle @@ {{First@#2, -100}, {Last@#2, 100}}} &,
{episodeColors, episodeBorders}]],

(* initial/terminal gray edge *)
Plot[0, {t, 0 - maxTime*.1, 0}, PlotStyle -> None, FillingStyle -> GrayLevel@.9, Filling -> {1 -> 100, 1 -> -100}],
Plot[0, {t, maxTime, maxTime*1.1}, PlotStyle -> None, FillingStyle -> GrayLevel@.9, Filling -> {1 -> 100, 1 -> -100}],

Plot[{optimumFunction@t - .5, optimumFunction@t, optimumFunction@t + .5}, {t, 0, maxTime}, PlotStyle -> {None, Directive[GrayLevel[0, .7], AbsoluteThickness@3, Dashed], None}, FillingStyle -> Hue[.3, 8, .8, .5], Filling -> {1 -> {3}}],

(* ship & trajectory *)
Graphics[{GrayLevel@.6, AbsoluteThickness@2, Line@Dynamic@Most@data,Inset[Rotate[ship, Dynamic@\[Theta]], Dynamic@Last@data]}],

(* options *)
PlotRange -> Dynamic[{xRange, yRange}, TrackedSymbols :> {xRange, yRange}],
ImageSize -> Full, AspectRatio -> Full, ImagePadding -> Automatic,
Frame -> True, FrameTicks -> False, Axes -> False,
GridLines -> {Range[0, maxTime, maxTime/episodeNum], None},
Method -> {"GridLinesInFront" -> True}
], ImageSize -> {800, 400}]

-
It would be nice to investigate why it doesn't update properly, but it seems buggy to me... Just change that Dynamic[{xRange so something with sideeffects and it works. For example, Dynamic[xRange=xRange;{xRange, yRange}] – Rojo Jul 8 '12 at 13:30
Better fix: Dynamic[Refresh[{xRange, yRange}]]. Btw, fixed a few bugs in the profiler – Rojo Jul 8 '12 at 14:40
@Rojo Indeed it works with Refresh, but it would be nice to know why it does not work without it. These are the inconsistent annoyances that make it so hard to master Dynamic. A more detailed explanation could be posted as an answer. – István Zachar Jul 8 '12 at 17:23
No idea why. Hope someone does, but I suspect, it's one of those bugs that make it hard to work with dynamic as you said ;). However, it's by using this more and reporting that we get them to improve this, right? – Rojo Jul 8 '12 at 17:35

I'll post a function based on the title of the question. You wrap your dynamic code in profileDynamics optionally passing the option "Print"->True (defaults to False). It should be noted that this can only profile the explicit Dynamics that are on the code. Nested dynamics that are generated at runtime are not profiled by this

ClearAll[profileDynamics];
Options[profileDynamics] = {"Print" -> False};
profileDynamics[d_, OptionsPattern[]] :=
With[{print = OptionValue["Print"]},
Module[{counter = {}},
DynamicModule[{diag, start, tag},
diag[] :=
CreateDocument[
Column[{Button["Reset counter", counter = start],
Dynamic@Grid[
Join[{{"Dynamic expression", "Count", "Time"}},
MapAt[Short, #, 1] & /@ counter]]}]];
CellPrint@
ExpressionCell[Button["See profiling information", diag[]]];
d //. {i : Annotation[_, {tag, ___}] :> i,
e : Dynamic[sth : Except[First[{_, tag}]], rest___] :>
With[{pos = 1 + Length@counter,
catalog =
Annotation[
InputForm@e, {tag, Unique["profileDynamicsannot"]}]},
AppendTo[counter, {catalog, 0, 0.}];
Dynamic[
First@{Refresh[
If[print, Print[catalog]]; ++counter[[pos, 2]];
(counter[[pos, 3]] += First@#; Last@#) &[
AbsoluteTiming[Refresh[sth]]], None], tag}, rest] /;
True]} // (start = counter; #) &]]]


Applying this to the code in question yields

A zoom to the most interesting part, tells us that the big Dynamic[Show was run 67 times for a total of half a second when I played a few seconds with the game.

-
Can you also post an simple case and a screenshot of useful info in that case provided by profileDynamics ? – Vitaliy Kaurov Jul 8 '12 at 0:30
@VitaliyKaurov, edited – Rojo Jul 8 '12 at 0:45
Fixed a few bugs – Rojo Jul 8 '12 at 14:37
Works beaurifully for the posted example. Though unfortunately it returns a table of 0 "Count" and "Times" values for the full version of my code (A much more complicated DynamicModule). I'm gonna do a bit of debugging... – István Zachar Jul 9 '12 at 18:13
Concerning nested Dynamics: ReplaceRepeated obviously won't work because of infinite replacement. I've tried to apply a replaceBackward function instead of your /. which makes the replacements from inside-out. It recognized all the Dynamics, but of course any outer Dynamic will be represented in the profiler report as an expression containing the code profileDynamics injected into it. One thing I can think of is to replace whatever was injected with the original when it comes to printing the results (i.e. structural replacements done inside the MapAt. – István Zachar Jul 9 '12 at 20:47