1
$\begingroup$

The code below pretty much looks like and does what I want it to. However, it is sluggish. I realize I have many calculations, and perhaps this is the best I can hope for. But if anybody has any idea how to streamline this to improve the performance of this Manipulate command, I would appreciate your input.

c = 1
Manipulate [
 Labeled[
  Overlay [{
    Plot [{{0.8 + x/(0.1 + (a*x))}, {0.8 + 
        x/(0.1 + (b* x))}, {0.8 + (c*x)}}, {x, 0, 1.6}, 
     PlotRange -> {0, 2.4}, AspectRatio -> 1.50,
     Ticks -> {{
        {x /. 
          Last[FindMaximum[{(0.8 + x/(0.1 + (a*x))) - (0.8 + (c*x)), 
             0 <= x <= 1.6}, {x, 0}]], 
         "1", {(0.8 + (x /. 
                Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                   0 <= x <= 1.6}, {x, 
                   0}]])/(0.1 + (a*(x /. 
                    Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                    0 <= x <= 1.6}, {x, 0}]]))))/1.6, 0}},
        {x /. 
          Last[FindMaximum[{(0.8 + x/(0.1 + (b*x))) - (0.8 + (c*x)), 
             0 <= x <= 1.6}, {x, 0}]], 
         "s", {(0.8 + (x /. 
                Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (b*x))) - (0.8 + (c*x)), 
                   0 <= x <= 1.6}, {x, 
                   0}]])/(0.1 + (a*(x /. 
                    Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (b*x))) - (0.8 + (c*x)), 
                    0 <= x <= 1.6}, {x, 0}]]))))/1.6, 
          0}}}, {{(0.8 + (x /. 
              Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                 0 <= x <= 1.6}, {x, 

                    0}]])/(0.1 + (a*(x /. 
                  Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                    0 <= x <= 1.6}, {x, 0}]])))), 
         "1", {(x /. 
             Last[FindMaximum[{(0.8 + 
                   x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                0 <= x <= 1.6}, {x, 0}]])/1.6, 0}},
        {(0.8 + (x /. 
              Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                 0 <= x <= 1.6}, {x, 
                 0}]])/(0.1 + (b* (x /. 
                  Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                    0 <= x <= 1.6}, {x, 0}]])))), 
         "s", {(x /. 
             Last[FindMaximum[{(0.8 + 
                   x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                0 <= x <= 1.6}, {x, 0}]])/1.6, 0}},
        {(0.8 + (x /. 
              Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (b*x))) - (0.8 + (c*x)), 
                 0 <= x <= 1.6}, {x, 
                 0}]])/(0.1 + (a*(x /. 
                  Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (b*x))) - (0.8 + (c*x)), 
                    0 <= x <= 1.6}, {x, 0}]])))), 
         "r", {(x /. 
             Last[FindMaximum[{(0.8 + 
                   x/(0.1 + (b*x))) - (0.8 + (c*x)), 
                0 <= x <= 1.6}, {x, 0}]])/1.6, 0}}, {0.8, 
         "     ", {1, 0.02}}}}],
    Plot [{{(x/(0.1 + (a*x))) - (c*x)}, {(x/(0.1 + (b * x))) - (c*
          x)}}, {x, 0, 1.6}, PlotRange -> {0, 2.4},   
     AspectRatio -> 1.5, 
     Ticks -> {{{x /. 
          Last[FindMaximum[{(0.8 + x/(0.1 + (a*x))) - (0.8 + (c*x)), 
             0 <= x <= 1.6}, {x, 0}]], 
         "1", {(0.8 + (x /. 
                Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                   0 <= x <= 1.6}, {x, 
                   0}]])/(0.1 + (b* (x /. 
                    Last[FindMaximum[{(0.8 + 
                    x/(0.1 + (a*x))) - (0.8 + (c*x)), 
                    0 <= x <= 1.6}, {x, 0}]]))))/1.6, 0}}}
       , {{0.8, "     ", {1, 0.02}}}}]}],
  {"Benefit-Cost              Benefit or Cost     ", "Effort"}, {Left,
    Bottom}, RotateLabel -> True],
 {{a, 1, "1"}, 1.2, 0.6}, {{b, 0.6, "s"}, 1.2, 0.6}]

Still shot of Manipulate function

Note that the inset "gridlines" that track the movements of the curves, together with their labels, are customized "Ticks". I tried using gridlines, but this had the disadvantage of still needing ticks so that I could have the labels (I could not figure out how to label the gridlines themselves). I also tried inserting lines with Epilog, but again ran into the same problem.

For improving the performance of Manipulate, I am aware of the "ContinousAction->False" command, but would prefer not to use that, if possible. I am also familiar with the "ControlActive" command, but I was unable to get it to work and am not sure it would make much difference anyway with my simple line plots.

Finally, I don't think it is my computer (2015 Apple MacBook Pro, 3.1 GHz Intel Core i7). But if my code runs smooth as silk on yours, then maybe the problem IS my computer.

$\endgroup$
2
$\begingroup$

If you want to use a particular maximum five times, there is no need to calculate it five times.

c = 1
f[x_, p_] := (0.8 + x/(0.1 + (p*x)));

Manipulate[
 max1 = x /. Last[FindMaximum[{f[x, a] - (0.8 + (c*x)), 0 <= x <= 1.6}, {x, 0}]];
 max2 = x /. Last[FindMaximum[{f[x, b] - (0.8 + (c*x)), 0 <= x <= 1.6}, {x, 0}]];
 Labeled[Show[{
  Plot[{ {f[x, a]}, {f[x, b]}, {0.8 + (c*x)}},
     {x, 0, 1.6}, 
     PlotRange -> {0, 2.4}, 
     AspectRatio -> 1.50, 
     Ticks -> {
       {{max1, "1", {f[max1, a]/1.6, 0}}, {max2, "s", {f[max2, a]/1.6, 0}}}, 
       {{f[max1, a], "1", {(max1)/1.6, 0}}, {f[max1, b], "s", {(max1)/1.6, 0}}, 
        {f[max2, a], "r", {(max2)/1.6, 0}}, {0.8, "     ", {1, 0.02}}}}
  ],
  Plot[{{(x/(0.1 + (a*x))) - (c*x)}, {(x/(0.1 + (b*x))) - (c*x)}}, 
    {x, 0, 1.6}, 
    PlotRange -> {0, 2.4}, 
    AspectRatio -> 1.5, 
    Ticks -> {{{max1, "1", {(0.8 + (max1)/(0.1 + (b*(max1))))/1.6, 0}}}, 
              {{0.8, "     ", {1, 0.02}}}}]}
  ], 
  {"Benefit-Cost              Benefit or Cost    ", "Effort"}, 
  {Left, Bottom}, 
  RotateLabel -> True
], 
{{a, 1, "1"}, 1.2, 0.6}, {{b, 0.6, "s"}, 1.2, 0.6}
]
$\endgroup$
  • $\begingroup$ Kuba, your reply greatly simplified the code. Thank you very much for this. Also, for some reason, your use of the Show command in replace of my original Overlay command resulted in the Ticks for the second plot not appearing. When I changed your Show to Overlay, all the Ticks are there. $\endgroup$ – kwsockman Oct 7 '15 at 12:40
  • $\begingroup$ @kwsockman Missed that. It's because Show only respects options from the very first argument. In Overlay you have to keep sizes and margins the same that's why I've switched. $\endgroup$ – Kuba Oct 7 '15 at 12:42
  • $\begingroup$ Also, despite your substantial simplification of my code (plus using Overlay instead of Show), I still do not notice much enhancement in performance. In some ways yours is definitely quicker. For example, if you click the little box next to one of the Manipulate scroll bars in order to show the animation controls and then you dial in a number and hit return, yours is much faster than mine. However, when I simply drag the scroll bars, I am hard-pressed to notice a difference in performance between yours and mine. Still, I appreciate your input for all the reasons above. Thanks again. $\endgroup$ – kwsockman Oct 7 '15 at 12:45
  • $\begingroup$ Oops. I wrote too soon. Yours works noticeably better now. I reverted to your Show command and then put the Ticks from the second argument up in the first argument. Maybe that helped or maybe my computer just needed to rest. Thanks again. $\endgroup$ – kwsockman Oct 7 '15 at 12:54
  • $\begingroup$ @kuba I mis-clicked the down arrow and now it won't let me change my vote. Sorry. It says that if the answer is edited I can change my vote. Email me if you edit and I will correct the mis-click. jacklavigne@att.net $\endgroup$ – Jack LaVigne Oct 9 '15 at 0:37

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.