Finding optimal points in contours produced by ListContourPlot

Question

I have a list of data for use in ListContourPlot in the form of:

data={{x1,y1,v1},{x2,y2,v2},...};

Let's say the values of v range from -1 to 1. When plotted, it is clear there are optimal points on the contours that are produced (e.g, for contour 0.5, there is a minimal value of x).

Is there an automatic way to obtain such values from the plot (i.e. as opposed to using plot coordinates)? If so, would there dependence on the interpolation order?

UPDATE: The data would look something like this:

Imagine I have a ton of these plots and want to find the minimal value of x on the 0.5 contour for each of them.

Answer 1

The desired minimum value can be obtained from the ListContourPlot as follows. In the absence of specified data, use

data = Flatten[Table[{x, y, x - (y - 2/3)^2}, {x, 0, 1, .01}, {y, 0, 1, .01}], 1];

Next, use ListContourPlot to generate a Mesh curve corresponding to the desired contour, here 0.5. (In principle, a Contour curve could be used instead of a Mesh curve, but doing so is less convenient.)

plt = ListContourPlot[data, Mesh -> {{.5}}, MeshFunctions -> {(#3) &},
   MeshStyle -> Thick, Contours -> 0, FrameLabel -> {x, y}, 
   ImageSize -> Large, LabelStyle -> Directive[Black, Bold, Medium]]

along with a spurious error message that can be ignored.

Flatten::argb: Flatten called with 0 arguments; between 1 and 3 arguments are expected.Flatten::argb: Flatten called with 0 arguments; between 1 and 3 arguments are expected.

Evidently, ListContourPlot does not like Contours -> 0. Next, extract the Line corresponding to the curve,

lst = Cases[plt[[1]] // Normal, Line[z_] -> z, Infinity][[1]];

and determine the minimum point,

min = MinimalBy[lst, First] // Last
(* {0.500011, 0.67} *)

which visibly is correct. A sometimes slightly more accurate value can be obtained by

int = Interpolation[Reverse /@lst];
FindMinimum[int[y], {y, min // Last}]
(* {0.50001, {y -> 0.670422}} *)

Here, it is no better than min.

Answer 2

My solution was to first make an interpolating function f from the discrete data:

vdata=data[[1 ;;,3]];
f = Interpolation[Transpose[{data[[1;;,1;;2]], vdata}], InterpolationOrder -> 1];

Then, I made a loop to increment x and y by inc and apply in f[x,y] until the contour of interest was reached at minimal x-value ans:

contour = 0.5;
inc=0.001;
Do[
   v = f[x, y];
   If[v >= contour, {ans = x, Break[]}];
, {x, 0, 1, inc}, {y, 0, 1, inc}];

Not efficient, but it worked for my particular problem.

Answer 3

Construct an interpolation function, take its derivative (which results in a new interpolation function), then plot the zero contour of that:

data = Flatten[
   Table[{x, y, x - (x/2 + y - 2/3)^2}, {x, 0, 1, .01}, {y, 0, 
     1, .01}], 1];
int = Interpolation[data];
dy = D[int[x, y], y]
Show[{
  ContourPlot[int[x, y], {x, 0, 1}, {y, 0, 1}],
  ContourPlot[dy, {x, 0, 1}, {y, 0, 1}, Contours -> {0}, 
   ContourShading -> False]}]

if you need specific points on the contours, extract that line and interpolate:

c = Interpolation[{int[Sequence @@ ##], ##} & /@ (First@
      Cases[Normal@
        ContourPlot[dy, {x, 0, 1}, {y, 0, 1}, Contours -> {0},
         ContourShading -> False] , Line[pts_] :> pts , Infinity])];
Show[{
  ContourPlot[int[x, y], {x, 0, 1}, {y, 0, 1},
   Epilog -> {Red, PointSize[.025], 
     Point[Table[c[v], {v, 0, 1, .2}]]}]}]

note this is a little different input example than the other answer.