# Finding minima / minimum curve in ListPlot3D

I have a bunch of data trialstuff corresponding to {x,y,z}, which I put here.

I am plotting a graph of it:

ListPlot3D[Flatten[trialstuff, 1], ColorFunction -> "TemperatureMap"]


which gives me this:

where I wrote by hand the "line" which looks like the minima.

1) Is there a way I can find the position in the xy plane of the minimum?

2) If I know the minimum of zero, can I "solve" the equation to find where in the xy plabe the ListPlot3D is zero?

--

With this data and this code:

iF = Interpolation[Join @@ trialstuff];
pnt = Flatten[{{x, y} /. #[[2]], #[[1]]}] &@
NMinimize[{iF[x, y], 1 <= x <= Sqrt[30], 100 <= y <= 400}, {x, y}]
Show[Plot3D[iF[x, y], {x, 1.1, Sqrt[30] - 0.1}, {y, 101, 399},
BoundaryStyle -> None, Boxed -> False,
ColorFunction -> "DarkTerrain",
MeshFunctions -> {# &, #2 &,
ConditionalExpression[Derivative[1, 0][iF][#, #2],
Derivative[2, 0][iF][#, #2] > 0] &,
ConditionalExpression[Derivative[0, 1][iF][#, #2],
Derivative[0, 2][iF][#, #2] > 0] &},
Mesh -> {{3.1622776600251727}, {228.06175994426033}, {0}, {0}},
MeshStyle -> {Magenta, Green, Directive[Red, Thick],
Directive[Yellow, Thick]},
PlotLegends ->
LineLegend[{Magenta, Green, Directive[Red, Thick],
Directive[Yellow, Thick]}, {StringForm["{, y, iF[, y]}",
NumberForm[pnt[[1]], 4], NumberForm[pnt[[1]], 4]],
StringForm["{x, , iF[x, ]}", NumberForm[pnt[[2]], 4],
NumberForm[pnt[[2]], 4]],
StringForm["{, y, iF[, y]}", Superscript[x, "*"][y],
Superscript[x, "*"][y]],
StringForm["{x, , iF[x, ]}", Superscript[y, "*"][x],
Superscript[y, "*"][x]]}]],
Graphics3D[{Orange, AbsolutePointSize[10], Point[pnt]}]]


I get this picture:

What are the other random mesh lines?

iF = Interpolation[Join @@ data];
pnt = Flatten[{{x, y} /. #[[2]], #[[1]]}] &@
NMinimize[{iF[x, y], 1 <= x <= 5, 100 <= y <= 500}, {x, y}]


{3.19945, 206.337, 811.46}

Show[Plot3D[iF[x, y], {x, 1, 5}, {y, 100, 300}, BoundaryStyle -> None, Boxed -> False,
MeshFunctions -> {# &, #2 &,
ConditionalExpression[Derivative[1, 0][iF][#, #2],
Derivative[2, 0][iF][#, #2] > 0] &,
ConditionalExpression[Derivative[0, 1][iF][#, #2],
Derivative[0, 2][iF][#, #2] > 0] &},
Mesh -> {{3.199454}, {206.337}, {0}, {0}},
MeshStyle -> {Magenta, Green, Directive[Red, Thick],  Directive[Yellow, Thick]},
PlotLegends ->  LineLegend[{Magenta, Green, Directive[Red, Thick],
Directive[Yellow, Thick]},
{StringForm["{, y, iF[, y]}", NumberForm[pnt[[1]], 4], NumberForm[pnt[[1]], 4]],
StringForm["{x, , iF[x, ]}", NumberForm[pnt[[2]], 4],  NumberForm[pnt[[2]], 4]],
StringForm["{, y, iF[, y]}", Superscript[x, "*"][y], Superscript[x, "*"][y]],
StringForm["{x, , iF[x, ]}", Superscript[y, "*"][x],  Superscript[y, "*"][x]]}]],
Graphics3D[{Orange, AbsolutePointSize[10], Point[pnt]}]]


where $x^*(y) = ArgMin_x \ iF(x,y)$ and $y^*(x) = ArgMin_y \ iF(x,y)$.

• Thanks this is great. Just for me to understand. What exactly is the red line and what are you specifying in the MeshFunctions with the derivatives? Jun 12, 2018 at 11:28
• @SuperCiocia, the red line is the locus of minima of iF[x,y] with respect to x for given y, the yellow line the locus of minima of iF[x,y] with respect to y for given x. I added a legend.
– kglr
Jun 12, 2018 at 11:53
• Thanks this is great. ON my plot though there are some other random yellow and red lines that appear for the mesh. Is there a way I can post a picture of what I mean on a comment? Jun 12, 2018 at 14:35
• @SuperCiocia, you can update your question with the issue and related picture.
– kglr
Jun 12, 2018 at 14:38
• I added an edit, thanks. Jun 12, 2018 at 14:57

The minima curve is to be refined but this is a start:

takeXSlicesMinima[data_List] := With[{xValues = data[[All, 1]]},
Table[
First@TakeSmallestBy[Select[data, #[[1]] == xValue &], Last, 1],
{xValue, DeleteDuplicates@xValues}
]
];

takeYSlicesMinima[data_List] := With[{yValues = data[[All, 2]]},
Table[
First@TakeSmallestBy[Select[data, #[[2]] == yValue &], Last, 1],
{yValue, DeleteDuplicates@yValues}
]
];

With[{data = Flatten[trialstuff, 1]},
With[{minimaCurvePoints = takeYSlicesMinima@data},
Show[
ListPlot3D[data, ColorFunction -> "TemperatureMap"],
Graphics3D[{Red, [email protected],
Point@minimaCurvePoints,
Line@minimaCurvePoints
}]
]
]
]


You probably only need one of the two functions defined above, depending on whether you want to take the minima using X or Y slices.