1
$\begingroup$

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!

| improve this question | |
$\endgroup$
  • $\begingroup$ Integration is costly, so it's not a great thing to dump into a dynamic construct. $\endgroup$ – LLlAMnYP May 7 '15 at 23:38
  • $\begingroup$ 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. $\endgroup$ – LLlAMnYP May 7 '15 at 23:41
  • $\begingroup$ 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. $\endgroup$ – Trav May 7 '15 at 23:43
  • $\begingroup$ 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? $\endgroup$ – LLlAMnYP May 7 '15 at 23:52
  • 1
    $\begingroup$ 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. $\endgroup$ – LLlAMnYP May 8 '15 at 0:06
1
$\begingroup$

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.

| improve this answer | |
$\endgroup$
  • $\begingroup$ 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) $\endgroup$ – Michael E2 Jun 7 '15 at 17:00

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.