Question

Ive been having some trouble using Plot to graph a complicated composite function.

I am trying to plot the ArgMax of a composite function F[].

F[] involves several levels of nested composite functions, many of which involve Solve[] and Min[] or Max[].

I don’t have any problems with the way F[] performs in my program (with the possible exception of how it renders in Plot), so I wont include the lengthy code that defines F[] and its underlying simpler functions, for now.

When I try to use

Plot[FindArgMax[F[],{vars}], I get a very fast return on my output, which is mostly correct, except for the fact that I get a range with some buggy false values, which appear to be rendered as incorrect vertical segments over a portion of the plot.

I have evaluated F[] over the range where the bugginess is happening, and have confirmed that the proper values are in line with the smooth curve shown in the second pic below.

Plot[NArgMax[[F[],{vars}], I get a correct plot which does not include the bugginess/false vertical segments, but it takes a considerably longer time.

I cant post a second link, but the NArgMax plot generates the same picture as above, but smooth and without the holes and vertical segments.

Without getting into the specifics of F[], is there a quick and easy way to coax FindArgMax into working properly here? Basically, is this a common issue with Plot that has a well known fix, or do I need to devote more time to recoding my definitions of F[] and the underlying composite functions if I want to be able to use the fast FindArgMax command in my Plot?

Thanks in advance for any help, from a first timer here on the forum. 🙂

EDIT: Sample code from the troublesome portion of my program:

 a = 3000; b = 1/10; cc = 1/10; d = 1;


G1[x_, y_] := a Log[b x + cc  y + d]

Gx1[x_, y_] := Derivative[1, 0][G1][x, y];
Gy1[x_, y_] := Derivative[0, 1][G1][x, y];

piPP1 = {y, x};

c1ycrit0[fy_, mu1_] := 
 Max[0, Flatten[
     Solve[Gy1[x, y] == fy mu1 && piPP1[1] == piPP1[[2]], y, 
      x]][1][[2]]]

c1xcrit1[fx_, fy_, mu1_] := Max[Quiet[
   Flatten[
      Solve[Gx1[x, 
         Flatten[Solve[piPP1[1] == piPP1[[2]], y]][1][[2]]] == 
        mu1 fx, x]][1][[2]]], 
  Quiet[Flatten[
      Solve[Gx1[x, 
         Max[0, Flatten[
             Solve[Gy1[x, y] == fy*mu1 && piPP1[1] == piPP1[[2]], y,
               x]][1][[2]]]] == mu1 fx, x]]][1][[2]]]

c1xcrit2[fx_, fy_, mu1_, T1_] := 
 Max[Quiet[
   Flatten[Solve[T1 == x fx + fy c1ycrit0[fy, mu1] , x, 
       y]][1][[2]]], 
  Quiet[Flatten[
      Solve[{piPP1[1] == piPP1[[2]], T1 == x fx + fy piPP1[[2]]}, x,
        y]][1][[2]]]]

Manipulate[
 Quiet[Plot[(fx - xc) Max[0, 
     Min[c1xcrit1[fx, fy, mu1], c1xcrit2[fx, fy, mu1, T1]]], {fx, 0, 
    fxMax}, PlotRange -> {{0, fxMax}, {0, xPTmax}}]],
 {{mu1, 10, Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 
  100}, {{fy, 10}, 0, 100}, {{T1, 100}, 0, 1000}, {{fxMax, 50}, 0, 
  100}, {{xPTmax, 100}, 0, 400}, ContinuousAction -> None]

BRX[fy_, xc_, mu1_, T1_] := 
 Quiet[FindArgMax[(fx - 
      xc) (Min[{c1xcrit1[fx, fy, mu1], 
       c1xcrit2[fx, fy, mu1, T1]}]), {fx, xc}]]

BRX1[fy_, xc_, mu1_, T1_] := 
 Quiet[NArgMax[(fx - 
      xc) (Min[{c1xcrit1[fx, fy, mu1], c1xcrit2[fx, fy, mu1, T1]}]), 
   fx]]

Manipulate[
 xBR = Plot[BRX[fy, xc, mu1, T1], {fy, 0, hmax}, 
   PlotRange -> {{0, hmax}, {0, hmax}}], {{mu1, 10, 
   Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 10}, {{T1, 100}, 0, 
  1000}, {{hmax, 40}, 0, 100}, ContinuousAction -> None]

Manipulate[
 xBR1 = Plot[BRX1[fy, xc, mu1, T1], {fy, 0, hmax}, 
   PlotRange -> {{0, hmax}, {0, hmax}}], {{mu1, 10, 
   Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 10}, {{T1, 100}, 0, 
  1000}, {{hmax, 40}, 0, 100}, ContinuousAction -> None]

Further edit: Changing the starting point “xc” for solving for “fx” in the BRX[] function drastically changes the result of the plot, which leads me to believe that it might be unlikely that I will be able to usefully use FindArgMax at all. I suppose that the derivatives are all a little too screwy due to all the MINs and MAXs in the underlying functions. Im still hopeful that there is a fix here that will enable to use FindArgMax, but Im a lot less optimistic after trying a few of the things suggested so far.

Thanks again to everyone for your help so far! 🙂

Answer 1

Relevant answer (see below for original)

Looking at your code, the problem is really about understanding delayed/immediate evaluation in Mathematica. For example, observe how nicely the following renders, compared to your first Manipulate.

Manipulate[
 Plot[Evaluate[(fx - xc) Max[0, 
     Min[c1xcrit1[fx, fy, mu1], c1xcrit2[fx, fy, mu1, T1]]]], {fx, 0, 
   fxMax}, PlotRange -> {{0, fxMax}, {0, xPTmax}}], {{mu1, 10, 
   Subscript[Mu, 1]}, 0, 100}, {{xc, 3}, 0, 100}, {{fy, 10}, 0, 
  100}, {{T1, 100}, 0, 1000}, {{fxMax, 50}, 0, 100}, {{xPTmax, 100}, 
  0, 400}]

As you can see, the only difference is an Evaluate which evaluates the expression to be plotted once and for all, instead of doing all the symbolical math over each time a new plot is needed. I suspect adding Evaluate in a similar way to your other plots would do the trick once you get your errors fixed.

If you want to learn how you should have coded the above, here are some study points:

• Learn about Rule (->) and ReplaceAll (./): Instead of saying Flatten[{{y->x+2}}[[1]][[2]], you should use y/.First[{{y-> x+2}}].
• Drop the Quiet‘s. All of them. Now! 😉 Really — unless you are completely sure what you are doing, Quiet will just be hiding your mistakes from you.
• Learn about Set (=) vs SetDelayed (:=). As an example, see below how I would have implemented your c1xcrit1: Using = instead of := means that all the symbolic math is done once when x1xcrit1 is defined rather than every time it is evaluated.

I hope this helps a bit — but really, if you want to use Mathematica you should find a tutorial or something to teach you the basics.

c1xcrit1[fx_, fy_, mu1_] = With[{
   y1 = y /. First@Solve[piPP1[[1]] == piPP1[[2]], y], 
   y2 = y /. First@Solve[Gy1[x, y] == fy*mu1 && piPP1[[1]] == piPP1[[2]], y, x]
   },Max[
     x /. First@Solve[Gx1[x, y1] == mu1 fx, x], 
     x /. First@Solve[Gx1[x, y2] == mu1 fx, x]]]

Original answer

The two functions you are comparing use very different algorithms: FindArgMax is a convenience front-end to FindMaximum, while NArgMax is a front-end to NMaximize. Comparing the methods available for the two functions

• FindMaximum/FindArgMax: ConjugateGradient, PrincipalAxis, LevenbergMarquardt, Newton, and QuasiNewton (all differential methods),
• NArgMax/NMaximize: NelderMead, DifferentialEvolution, SimulatedAnnealing and RandomSearch (all pointwise methods).

To put it another way: use FindMaximum or FindArgMax for nice functions, where the derivatives yield useful information. For nasty function, use NArgMax/NMaximize.

Since FindArgMax almost works, I’ll assume your function is nice.
For the differential methods the evolution is first done symbolically in an attempt to establish an analytical expression for the gradient. Quoting from the docs: “FindArgMax first localizes the values of all variables, then evaluates f with the variables being symbolic, and then repeatedly evaluates the result numerically.”

It sounds like your F is sufficiently complicated that symbolic evaluation is not going to go anywhere. If this is the case then prevent symbolic evaluation by wrapping. Also, adding a cache at the same time rarely hurts:

Fnum[args__/;And@@(NumericQ/@{args})]:=Fnum[args]=F[args]

You might think that this will be as slow as the NArgMax, but in many cases you will find that the QuasiNewton algorithms are impressively good at building an estimate of the derivatives it needs.

Given that we don’t know your F this is of course complete guesswork — but I hope it helps a bit.