2
$\begingroup$

I created the following code, but the contours are drawn slowly with the movement of the slider, could you advise me how I should optimize the code?

Manipulate[ Module[{VF, VB, InvQ, K1, K2},
VF = 1/3/(p - 1);
VB = p*VF;
K1 = VB*(VB + VF)/(2 VB + VF)^2*2116800;
IncomeQ[q_] = InvQ /. Solve[q == 840 (VB + VF)/(2 VB) - VF/(2 VB)*InvQ, InvQ];
Income[q1_, q2_] = 3*(840*q1 - VB/(VB + VF)*q1*q1 - VF/(VB + VF)*q1*q2);
IncomeK = 
ContourPlot[{Income[q1, q2] == 529200, Income[q2, q1] == 529200, 
 Income[q1, q2] == K1, Income[q2, q1] == K1}, {q1, 0, 1700}, {q2, 0, 1700}, 
ContourLabels -> None, PlotPoints -> 50, 
PerformanceGoal :> "Speed", ContourStyle -> Black];
demande = 
   Plot[{Tooltip[840 (VB + VF)/(2 VB) - VF/(2 VB)*q, "STC"], 
 IncomeQ[q]}, {q, 0, 1700}, 
   PlotRange -> {{-.5, 1700}, {-30, 1700}}, ImageSize -> {250, 200}];
center =
RegionPlot[(Income[q1, q2] >= K1 && Income[q2, q1] >= K1), {q1, 0, 
 1700}, {q2, 0, 1700}, PlotPoints -> 20, BoundaryStyle -> None, 
PlotStyle -> Gray]; 
Show[demande, center, IncomeK]], {{p, 6, \[Beta]/\[CurlyPhi]}, 1, 11, 0.2, Appearance -> "Labeled"}, TrackedSymbols -> p]
$\endgroup$
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – user9660 Nov 11 '14 at 21:34
  • $\begingroup$ Does this help? mathematica.stackexchange.com/questions/1428/… $\endgroup$ – MOON Nov 11 '14 at 22:58
  • $\begingroup$ Dear @Elizabeth, your very nice code could be improved if you try to avoid the zeroes that eventually appear in th computation. For example, when we set (beta,phi) ->0 the program gives some computational errors. Changing (p-1) by (p-1.00000000000000001) woulb be sufficient to cinrcunvent this problem. In relation to the time o processing maybe you can plot some graphs in a same step....just a silly suggestion....good look! $\endgroup$ – robson denke Nov 12 '14 at 2:12
2
$\begingroup$

A few things:

  • PlotPoints -> 50 will cause a significant slow down in ContourPlot.
  • PerformanceGoal -> "Speed" is the default setting when a control is being moved. You don't really gain anything using this setting inside Manipulate. I use ControlActive to switch between custom fast and slow settings for things like PlotPoints and MaxRecursion, when the default behavior is unsatisfactory.
  • The proper syntax for the TrackedSymbols option is TrackedSymbols :> {p}.

The ContourPlot and RegionPlot in your code duplicate some of the calculation. We can get a similar result with ParametricPlot using MeshShading. ContourPlot generally does a slightly better but slower job, but see if ParametricPlot is good enough. It is noticeably faster.

Manipulate[Module[{VF, VB, InvQ, K1, K2}, VF = 1/3/(p - 1);
  VB = p*VF;
  K1 = VB*(VB + VF)/(2 VB + VF)^2*2116800;
  IncomeQ[q_] = 
   InvQ /. Solve[q == 840 (VB + VF)/(2 VB) - VF/(2 VB)*InvQ, InvQ];
  Income[q1_, q2_] = 
   3*(840*q1 - VB/(VB + VF)*q1*q1 - VF/(VB + VF)*q1*q2);
  IncomeK = ParametricPlot[{q1, q2}, {q1, 0, 1700}, {q2, 0, 1700},
    PlotPoints -> ControlActive[25, 50],  (* change numbers to balance speed/quality *)
    MeshFunctions -> {Income[#1, #2] &, Income[#2, #1] &},
    Mesh -> {{529200, K1}}, 
    MeshStyle -> Directive[Opacity[1], Thick, Black],
    MeshShading -> {{None, None, None}, {None, Gray, Gray}, {None, 
       Gray, None}}];
  demande = 
   Plot[{Tooltip[840 (VB + VF)/(2 VB) - VF/(2 VB)*q, "STC"], 
     IncomeQ[q]}, {q, 0, 1700}, 
    PlotRange -> {{-.5, 1700}, {-30, 1700}}, 
    ImageSize -> {250, 200}];
  Show[demande, IncomeK]], {{p, 1.2, β/φ}, 1, 11, 0.2,
   Appearance -> "Labeled"},
 TrackedSymbols :> {p}]

Mathematica graphics

Note: The default setting for PerformanceGoal is ControlActive["Speed", "Quality"]. The setting "Speed" in plot functions reduces the number of PlotPoints and MaxRecursion, unless you set these explicitly. So the setting PlotPoints -> 50 overrides part of the "Speed" setting.

$\endgroup$
1
$\begingroup$

One very simple suggestion would be to change the exact integers in your code to real numbers. Some guidance on why this is important can be found on this site here.

This simple change certainly makes the automatic animation of this Manipulate run more smoothly than the original. The rest of your code looks fine to me: it's not obvious what else can be improved on.

Manipulate[Module[{VF, VB, InvQ, K1, K2}, VF = 1./3/(p - 1.0000001);
  VB = p*VF;
  K1 = VB*(VB + VF)/(2 VB + VF)^2.*2116800.;
  IncomeQ[q_] = 
   InvQ /. Solve[q == 840. (VB + VF)/(2 VB) - VF/(2 VB)*InvQ, InvQ];
  Income[q1_, q2_] = 
   3.*(840.*q1 - VB/(VB + VF)*q1*q1 - VF/(VB + VF)*q1*q2);
  IncomeK = 
   ContourPlot[{Income[q1, q2] == 529200., Income[q2, q1] == 529200., 
     Income[q1, q2] == K1, Income[q2, q1] == K1}, {q1, 0, 1700}, {q2, 
     0, 1700}, ContourLabels -> None, PlotPoints -> 50, 
    PerformanceGoal :> "Speed", ContourStyle -> Black];
  demande = 
   Plot[{Tooltip[840. (VB + VF)/(2 VB) - VF/(2 VB)*q, "STC"], 
     IncomeQ[q]}, {q, 0, 1700}, 
    PlotRange -> {{-.5, 1700}, {-30, 1700}}, ImageSize -> {250, 200}];
  center = 
   RegionPlot[(Income[q1, q2] >= K1 && Income[q2, q1] >= K1), {q1, 0, 
     1700}, {q2, 0, 1700}, PlotPoints -> 20, BoundaryStyle -> None, 
    PlotStyle -> Gray];
  Show[demande, center, IncomeK]], {{p, 6., \[Beta]/\[CurlyPhi]}, 1, 
  11, 0.2, Appearance -> "Labeled"}, TrackedSymbols -> p]

enter image description here

$\endgroup$

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.