0
$\begingroup$

I need desperately your help. I have the following code. My problem is that there is an error (you see it in the picture) and I can't find. Then Mathematica gives me for the global Min two wrong points. The real point would be {-2.5,0} and not {1.5,1.5},{1.5,-1.5}. In addition I want subdivide the other points in local Max and local Min. I don't know how it's done. In addition it would be great, if the label of the points would appear in a better way (better fitted,....I don't know how it is called. But the label the way it is right now is a bit confusing and ugly).

pts = {{1.5, 1.5}, {1.5, -1.5}, {2.5, 0}, {2.5, 1.94}, {2.5, -1.94}, {-2.5, 0}, {2, 2}, {-2, 2}, {2, -2}, {-2, -2}, {2.5, 2}, {-2.5, 2}, {-2.5, -2}, {2.5, -2}}; f[x_, y_] = y^4 - 3 x y^2 + x^3;

f[x, y] == f[x, -y]

True

FindMaximum[{f[x, y], -2.5 <= x <= 2.5, -2 <= y <= 2}, {x, y}] // Rationalize[#, 10^-7] &

{32, {x -> -2, y -> 2}}

maxPts = {{x, y}, {x, -y}} /. %[[-1]]

{{-2, 2}, {-2, -2}}

FindMinimum[{f[x, y], -5/2 <= x <= 5/2, -2 <= y <= 2}, {x, y}, WorkingPrecision -> 50] // N

{-1.6875, {x -> 1.5, y -> -1.5}}

minPts = {{x, y}, {x, -y}} /. %[[-1]]

{{1.5, -1.5}, {1.5, 1.5}}

Solve[{D[f[x, y], x] == 0, D[f[x, y], y] == 0, -2.5 <= x <= 2.5, -2 <= y <= 2}, {x, y}] // Union // Quiet

{{x -> 0, y -> 0}, {x -> 1.5, y -> -1.5}, {x -> 1.5, y -> 1.5}}

saddlePts = {{x, y}} /. %[[1]]

{{0, 0}}

otherPts = Complement[pts, maxPts, minPts, saddlePts];

n = 1; Legended[ContourPlot[f[x, y], {x, -2.5, 2.5}, {y, -2, 2}, Contours -> {Automatic, 50}, BoundaryStyle -> Directive[Gray, Thick], Frame -> False, BoundaryStyle -> Directive[Red, Thick], ContourShading -> None, Axes -> True, AxesLabel -> {x, y}, PlotRange -> {{-3, 3}, {-2.5, 2.5}}, LabelStyle -> Directive[Magenta, Bold], Epilog -> {PointSize[0.015], Darker[Green], Point[otherPts], Text[Style[ToString[f @@ #], Bold, Darker[Green], Background -> Yellow], #, {0, (-1)^(n++) 1.5}] & /@ otherPts, Red, Point[maxPts], Text[Style[ToString[f @@ #], Bold, Red, Background -> Yellow], #, {0, (-1)^(n++) 1.5}] & /@ maxPts, Orange, Point[minPts], Text[Style[ToString[f @@ #], Bold, Orange, Background -> Yellow], #, {0, (-1)^(n++) 1.5}] & /@ minPts, Darker[Blue], Point[saddlePts], Text[Style[ToString[f @@ #], Bold, Darker[Blue], Background -> Yellow], #, {0, (-1)^(n++) 1.5}] & /@ saddlePts}], PointLegend[{Red, Darker[Green], Darker[Blue], Orange, Lighter[Green]}, {"global Max", "local Max", "Saddle", " global Min", "local Min"}]]

enter image description here

The legend is shown in Mathematica. I didn't know how to copy it as well.

$\endgroup$
  • $\begingroup$ Can you show us an example of what you feel is a more aesthetically pleasing style of labelling points? $\endgroup$ – image_doctor May 30 '15 at 9:06
  • $\begingroup$ Can you clarify what you mean by sub-divide the local minima/maxima ? $\endgroup$ – image_doctor May 30 '15 at 9:31
  • $\begingroup$ I have for example 10 points. 1 is the global Max, 1 the global Min, 5 are local Min and 3 are local Max $\endgroup$ – Hanna May 30 '15 at 9:51
  • $\begingroup$ more aestetically would be no yellow background is needed as the values are readable without it. They are simply displayed in a "perfect" place. $\endgroup$ – Hanna May 30 '15 at 9:52
  • $\begingroup$ If you do not want the yellow backgrounds on your labels, just delete the, Background -> Yellow statements from your ContourPlot command. $\endgroup$ – image_doctor May 30 '15 at 10:15
2
$\begingroup$

FindMinimum returns local minima.

You need Minimize which will return the global minimum.

Minimize[{f[x, y], -5/2 <= x <= 5/2, -2 <= y <= 2}, {x, y}, 
  WorkingPrecision -> 50] // N

{-15.625, {x -> -2.5, y -> 0.}}

$\endgroup$
  • $\begingroup$ This is just a part of my question $\endgroup$ – Hanna May 30 '15 at 11:48

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.