3
$\begingroup$

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:

enter image description here

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?

--

EDIT after kglr answer

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:

enter image description here

What are the other random mesh lines?

$\endgroup$

2 Answers 2

5
$\begingroup$
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]}]]

enter image description here

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

$\endgroup$
7
  • $\begingroup$ 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? $\endgroup$ Commented Jun 12, 2018 at 11:28
  • $\begingroup$ @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. $\endgroup$
    – kglr
    Commented Jun 12, 2018 at 11:53
  • $\begingroup$ 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? $\endgroup$ Commented Jun 12, 2018 at 14:35
  • $\begingroup$ @SuperCiocia, you can update your question with the issue and related picture. $\endgroup$
    – kglr
    Commented Jun 12, 2018 at 14:38
  • $\begingroup$ I added an edit, thanks. $\endgroup$ Commented Jun 12, 2018 at 14:57
2
$\begingroup$

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
     }]
   ]
  ]
 ]

enter image description here

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.

$\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.