2
$\begingroup$

I have a parametric function {x[t],y[t]}. I then do

xArgMax = NArgMax[{x[t], y[t]>= 0, 0<= t <=1}, t]
{xx,yx} = {x[xArgMax], y[xArgMax]}. 

I do the symmetric thing for y, to get {xy,yy}. The thing is that I will Plot[{x[t],y[t]}, {t,0,1}] later on, so it seems it would be efficient to find {{xx,yx},{xy,yy}} while gathering data points for the plot. Is there a utility for this? I know that Plot[-args-][[1]] contains lots of coordinates for the visual representation.

I want to eventually put this all into a Manipulate, so I need as much efficiency as possible.

EDIT: both x and y have the form

u[a,b][t] = [a t^b + (1-a) (1-t^.8)^(b/.8) ]^(1/b)

where they vary in parameters. Typical parameters are .5,.5 for x and, say, .3,1 for y. The differential approach can't help because typically the solutions will be on the boundary.

$\endgroup$
0

3 Answers 3

3
$\begingroup$

Perhaps something like:

f = 6 + # Sin[# + Pi] -  Cos[Pi #/4] &;
g = # Cos[# + Pi/3]/2 - 1/12 Sin[Pi #] &;

Plot[{f[t], g[t]}, {t, 0, 3 Pi}, PlotStyle -> {Red, Blue}, Mesh -> {{0}, {0}},
 MeshFunctions -> {ConditionalExpression[f'[#], f''[#] < 0 && g[#] > 0] &,
       ConditionalExpression[g'[#], g''[#] < 0 && f[#] > 0] &},
 MeshStyle -> {Directive[PointSize[Large], Red], Directive[PointSize[Large], Blue]},
 PlotLegends -> {Style["f", Red, 14], Style["g", Blue, 14]}]

Mathematica graphics

Cases[Normal@plt, Point[x_] :> x, Infinity]

{{4.8209, 11.5918}, {4.8209, 2.16128},
{5.43663, 10.5002}, {5.43663, 2.74547}}

Versus direct computation:

xArgMax = NArgMax[{f[t], g[t] >= 0, 0 <= t <= 3 Pi}, t];
yArgMax = NArgMax[{g[t], f[t] >= 0, 0 <= t <= 3 Pi}, t];

{xArgMax, #@xArgMax} & /@ {f, g}

{{4.8209, 11.5918}, {4.8209, 2.16131}}

{yArgMax, #@yArgMax} & /@ {f, g}

{{5.43663, 10.5002}, {5.43663, 2.74547}}

$\endgroup$
3
  • $\begingroup$ ... this will mark all local maxima satisfying the conditions, not only the global maxima for the two functions. $\endgroup$
    – kglr
    May 15, 2016 at 22:48
  • $\begingroup$ Thanks for this, I didn't know about MeshFunctions. Unfortunately, I can't use this approach, and my reputation isn't high enough to mark your answer as "useful". $\endgroup$ May 15, 2016 at 23:11
  • $\begingroup$ As I mentioned in the new edit, for many parameter values, the extremal values will be found at the boundary. Thus, the derivatives are uninformative. Sorry, I should have given an example for x and y with my initial question. $\endgroup$ May 15, 2016 at 23:15
3
$\begingroup$

As example functions I'll use

x[t_] := (0.5 (1 - t^0.8)^0.625 + 0.5 t^0.5)^2
y[t_] := (0.7 (1 - t^0.8)^0.125 + 0.3 t^0.1)^10

To get the points that were calculated while plotting, one can use Reap and Sow.

{plot, {tValues, xValues, yValues}} = 
  Reap@ParametricPlot[{Sow[x[Sow[t, "t"]], "x"], Sow[y[t], "y"]}, {t, 0, 1}];

Because ParametricPlot does some evaluations before the final plotting points are produced, one has to remove these pre-evaluations.

tValues = Drop[tValues, 4];
xValues = Drop[xValues, 4];
yValues = Drop[yValues, 3];

The different maxima based on the plotting points are

xtMax = Transpose[{tValues, xValues}][[Ordering[xValues, -1][[1]]]]
ytMax = Transpose[{tValues, yValues}][[Ordering[yValues, -1][[1]]]]
yxMax = Transpose[{xValues, yValues}][[Ordering[yValues, -1][[1]]]]
xyMax = Transpose[{yValues, xValues}][[Ordering[xValues, -1][[1]]]]
{0.420465, 0.420448}
{0.199283, 0.472206}
{0.399565, 0.472206}
{0.420442, 0.420448}

This information can be used for the starting values to find a more precise local maximum.

max = FindMaximum[{Max[x[t], y[t]]}, {t, First@ytMax, First@xtMax}]

{0.472206, {t -> 0.199335}}

Show[{
  ListPlot[Transpose[{xValues, yValues}], PlotStyle -> Black],
  plot,
  Graphics[{PointSize[0.02], Orange, Point[yxMax], Orange, Point[xyMax], 
   PointSize[0.01], Red, Point[{x[t], y[t]} /. Rest@max]}]}]

Show

ListPlot[Transpose[{tValues, xValues}], Epilog -> {PointSize[0.02], Red, Point[xtMax]}]

xt

ListPlot[Transpose[{tValues, yValues}], Epilog -> {PointSize[0.02], Red, Point[ytMax]}]

yt

$\endgroup$
1
$\begingroup$

So I found a method that might be of interest, but i'm not sure it's optimal.

rawPlotData =  ParametricPlot[{x[t], y[t]}, {t, 0, 1}][[1]]; (* get plot data *)
plotData = Apply[List, rawPlotData[[1, 3, 2]]][[1]]; 

Index (1,3,2) of rawPlotData has a Line[-data-] object where -data- contains all the points. I don't know if this is the address for all Plot-type objects. Apparently if you use Cases you can search for the Line object directly.

{xOpt, yOpt} =  Flatten[Ordering[plotData[[All, #]], -1] & /@ {1, 2}];
{xx, xy} = plotData[[xOpt]]
{xy, yy} = plotData[[yOpt]]

This gets me what I need to put into Manipulate. However, I would think that plotData would be a useful input to NArgMax to speed the search for a more precise answer.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.