How to find maximum/minimum in ContourPlot?

The ContourPlot of Sin[x^3 + y] - 2 Cos[x y]==0 has a maximum around (-1.8,-2.3), see figure below. Is it possible to find it using for example FindRoot?

ContourPlot[Sin[x^3 + y] - 2 Cos[x y] == 0, {x, -2, -1}, {y, -4, -2},
Epilog -> {Red, AbsolutePointSize[5], Point[{-1.8, -2.35}]}]


Writing:

f[x_, y_] := Sin[x^3 + y] - 2 Cos[x y]

conditions = {f[x, y] == 0, -D[f[x, y], x]/D[f[x, y], y] == 0};

sol = FindRoot[conditions, {x, -2}, {y, -2}, WorkingPrecision -> 10][[All, 2]]

ContourPlot[Evaluate[conditions[[1]]], {x, -2, -1}, {y, -4, -2},
Epilog -> {Red, PointSize[Large], Point[sol]}]


I get:

{-1.812103489, -2.341140661}

which is what is desired.

• Perfect, Thanks @TeM – HD2006 Jun 24 at 12:25
• Just one more thing, assume that f(x,y) is a very complex function, in this case is it possible to evaluate the conditions numerically? – HD2006 Jun 24 at 13:06
• @HD2006: It depends what you mean by "complex"; give an example. – TeM Jun 24 at 13:10

Just an alternative without FindRoot using MeshFunction

f[x_, y_] := Sin[x^3 + y] - 2 Cos[x y]
ContourPlot[f[x, y] == 0, {x, -2, -1}, {y, -4, -2}, Mesh -> {{0}},
MeshStyle -> Red, MeshFunctions ->Function[{x, y}, Derivative[1, 0][f][x,y]/Derivative[0, 1][f][x, y]]]


This version finds all the extrema!

You can also post-process ContourPlot output to add to each Line its peak point(s):

ClearAll[addPeaks]
addPeaks = Normal[#] /. l:Line[x_, ___] :> {l, PointSize[Large], Point@MaximalBy[x, Last]}&


Examples:

addPeaks @ ContourPlot[Sin[x^3 + y] - 2 Cos[x y] == 0, {x, -2, -1}, {y, -4, -2}]


addPeaks @ ContourPlot[Evaluate[Sum[Sin[RandomReal[5, 2].{x, y}], {4}]],
{x, 0, 5}, {y, 0, 5},
Contours -> 5, ContourStyle -> (ColorData[97] /@ Range[5]),

• @chris, easiest/laziest way i can think of is to post-process: if cp = addPeaks @ContourPlot ... then define a pattern for points on the border using PlotRange[cp], i.e. borderpnts = Alternatives @@ (Point[{#}] & /@ Join @@ ({#, Reverse /@ #2} & @@ (Thread /@ Thread[{PlotRange[cp], Blank[]}]))); then use DeleteCases[cp, borderpnts, {0, Infinity}] – kglr Jul 1 at 7:36