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!
n=6
on my machine. Not particularly smooth, but 10 fps or so. $\endgroup$Expand[Product[Q-q[i],{i,n}]]
with the output ofSubsets[Range[n],n]
. That should give a good clue how to programatically write down an analytical expression. $\endgroup$