# Slow program- Mathematica shuts down

I've been trying to draw dynamic pictures of level sets of certain polynomials. The code right now looks like that :

 n = 2;
dp[w_, z__] := ((-1)^(n))*
Product[w - Complex @@ zz, {zz, {z}}]/
Product[Complex @@ zz, {zz, {z}}]
dp[w, Sequence @@ z] (* not really needed here*)
Integrate[dp[w, Sequence @@ z], w] (*not really needed either*)

DynamicModule[{z = RandomReal[{1, 2}, {n, 2}]},
Dynamic[
Show[ContourPlot[
With[{w = x + I*y},
Abs[Integrate[dp[Q, Sequence @@ z], Q] /. Q -> w] - Abs[w]] ==
0, {x, -15, 15}, {y, -15, 15}, ImageSize -> Large, Axes -> True],
Graphics[
Evaluate@
Table[With[{i = i}, Locator[Dynamic[z[[i]]]]], {i, n}]]]]]


What this does is it builds a polynomial $dp(w)$ having n roots (think of this as the derivative of some polynomial $p(w)$) and it retrieves the anti-derivative that corresponds to const=0, $p(w)$, by integrating. Then I want to draw dynamic pictures of the level curves $|p(w)|=|w|$ that I can change by moving the roots of $p'(w)$ (dp[w] in the code ) around. It seems to work for n<=3 but it's very slow and for n>3 the program shuts down. Is there anyway to prevent this/make the program faster? I would like to be able to work with at least n=6. Any help is appreciated!

• Integration is costly, so it's not a great thing to dump into a dynamic construct. – LLlAMnYP May 7 '15 at 23:38
• However, your code (with the exception of all locators moving in sync on M version 8) runs fine at n=6 on my machine. Not particularly smooth, but 10 fps or so. – LLlAMnYP May 7 '15 at 23:41
• Do you think it might be a lot faster if I replace the integral by a finite Riemann sum ( possibly with lots of terms) ? Also, do you know if there's a way to interactively input the roots, say by clicking on the plane ? If so, I might be able to avoid the dynamic construct. – Trav May 7 '15 at 23:43
• It's certainly possible to input the roots like that, though I can't off the top of my head say exactly how, I'd need to browse the documentation for a bit first. The best solution by far would be to find an analytical expression for the integral. I'm not sure, how you intend to get a Riemann sum for an indefinite integral here. Does the code run much slower on your machine, than on mine? – LLlAMnYP May 7 '15 at 23:52
• I suggest coding the analytical expression for the antiderivative. It is quite trivial. Compare the output of Expand[Product[Q-q[i],{i,n}]] with the output of Subsets[Range[n],n]. That should give a good clue how to programatically write down an analytical expression. – LLlAMnYP May 8 '15 at 0:06

I have tuned your code a bit and it now works reasonably on v.10. 7 locators are ok, 10 gets terrible, but nothing crashes.

This is the integral of your function. You can compare it to Integrate[dp[w, z], w]:

p[w_, n_Integer, z__] :=
Sum[Total@(((-1)^n w^(n - i + 1))/(n - i + 1)
Times @@@ Subsets[-(Complex @@@ {z}), {i}]), {i, 0, n}]/
Times[Sequence @@ (Complex @@@ {z})]


I have made it a function of n too, to localize the variables as much as possible.

DynamicModule[{z, n = 10}, z = RandomReal[{1, 2}, {n, 2}];
Dynamic[Show[
ContourPlot[
With[{w = x + I*y}, Abs[p[w, n, Sequence @@ z]] - Abs[w]] ==
0, {x, -15, 15}, {y, -15, 15}, ImageSize -> Large, Axes -> True],
Graphics[
Evaluate@
Table[With[{i = i}, Locator[Dynamic[z[[i]]]]], {i, n}]]]]]


As you can see, n is now assigned a value within the module. Try starting small and working up. n=6 should not be a problem.

• Evaluate[With[{w = x + I*y}, Abs[p[w, n, Sequence @@ z]] - Abs[w]] == 0] will speed things up, so that n >= 10 is good. (+1) – Michael E2 Jun 7 '15 at 17:00