Can I label a point in a Plot3D? and how

Question

This question comes after I received some nice answers of yours, concerning the labeling of intersection points of two curves in the , see hereHow to label intersection point in Plot

The answers I received were really proffesional but quite difficult for my level, so I decided to create my own a more "brutal" algorith , like this:

In[76]:= Clear["Global`*"]

In[175]:= Solve[{2 x^2-3 y-7==0,3 x+4 y+1==0},{x,y}]

Out[175]= {{x->1/16 (-9-Sqrt[881]),y->1/64 (11+3 Sqrt[881])},{x->1/16 (-9+Sqrt[881]),y->1/64 (11-3 Sqrt[881])}}

In[179]:= N[{{x->1/16 (-9-Sqrt[881]),y->1/64 (11+3 Sqrt[881])},{x->1/16 (-9+Sqrt[881]),y->1/64 (11-3 Sqrt[881])}}]

Out[179]= {{x->-2.4176,y->1.5632},{x->1.2926,y->-1.21945}}

In[186]:= Show[ContourPlot[{2 x^2-3 y-7==0,3 x+4 y+1==0},{x,-10,10},{y,-5,50},PlotRange->{{-5,5},{-5,6},All}],ListPlot[{{1/16 (-9-Sqrt[881]),1/64 (11+3 Sqrt[881])},{1/16 (-9+Sqrt[881]),1/64 (11-3 Sqrt[881])}}->{"{-2.417,1.563}","{1.292,-1.219}"},LabelingFunction->Bottom]] Out[186]=

That is fine for me at the moment but then I wanted to do a similar thing in a Plot3D, for example I wanted to label the minimum point in the sphere function:

Notice that I can find the minimum first but the difficulty for me is to use the ListPlot[] here with Plot3D[], inside the Show[].

Can you give me any advise please?

Answer 1

You can use ListPointPlot3D with the option LabelingFunction to make labeled 3D points and use Show to combine it with graphics produced by Plot3D:

f[x_, y_] := (x - 1.5)^2 + (y - 1)^2

p3d = Plot3D[f[x, y], {x, -3, 5}, {y, -3, 5},
   BoxRatios -> 1, 
   ColorFunction -> (Directive[Opacity[.5], ColorData["Rainbow"][#3]] &), 
   PlotRange -> {{-3, 5}, {-3, 5}, Automatic}, Mesh -> None];

min = {##, f[##]}& @@ NArgMin[{(x-1.5)^2 + (y-1)^2,-3 <= x <= 5, -3 <= y <= 5}, {x, y}]

{1.5, 1., 2.01633*10^-18}

lpp3d = ListPointPlot3D[{min}, 
   PlotStyle -> Directive[PointSize[Large], Red], 
   LabelingFunction -> (Callout[#, Below] &)];

Show[ p3d, lpp3d, PlotRange -> All]

Another example:

SeedRandom[77]
randompoints = {##, f@##} & @@@ Round[RandomPoint[Rectangle[{-3, 3}, {5, 5}], 3], .01]

{{-3., 3.95, 28.9525}, {4.34, 4.13, 17.8625}, {-1.48, 3.81, 16.7765}}

lpp3d2 = ListPointPlot3D[List /@ randompoints, 
  PlotLegends -> (ToString /@ randompoints), 
  LabelingFunction -> Callout];

Show[p3d, lpp3d2, PlotRange -> All]