Plotting minima of a mutivariable function

Question

Consider a function, z (x,y) = x^2 + y^2 + 3*x*y. For a range of x, I like to plot the minimum values of z. Specifically, suppose, when x = 1, we get z(1,y) = 1 + y^2 + 3y. And the function has a minimum at y=y_c=-3/2that is z_min(1)= z(1, -3/2) = -5/4.
This way, I like to plot all such z_min(x) in the range -10<=x<=10.

I am implementing it in the following way:

z = x^2 + y^2 + 3*x*y;
dzdy = D[z, y];
soln = Solve[dzdy == 0, y];
yc = y /. soln[[1]];
zmin = z /. y -> yc;
Plot[zmin, {x, -10, 10}, 
   AxesLabel -> {Style[Text["x"], 16], Style[Row[{Subscript["z", "min"], "(x) = z (x, ", Subscript["y","c"], "(x))"}], 16, Blue]},
   PlotStyle -> Blue]

I like to know if the coding can be written in an efficient and compact manner to obtain my desired plot. Does there exist dedicated built-in functions to plot such minima?

Answer 1

When the x is fixed, then we set {D[z, y] == 0, D[z, {y, 2}] >= 0} to get the local minimum.

f[x_, y_] := x^2 + y^2 + 3*x*y;
min = Plot3D[f[x, y], {x, -10, 10}, {y, -40, 40}, 
   MeshFunctions -> {Function[{x, y, z}, D[f[x, y], y] // Evaluate]}, 
   RegionFunction -> 
    Function[{x, y, z}, D[f[x, y], {y, 2}] > 0 // Evaluate], 
   Mesh -> {{0}}, MeshStyle -> Directive@{Thick, Red}, 
   PlotStyle -> None, BoundaryStyle -> None];
plot3D = 
  Show[Plot3D[f[x, y], {x, -10, 10}, {y, -40, 40}, Mesh -> None], min,
    PlotRange -> All, ViewProjection -> "Orthographic", 
   BoxRatios -> 1];
reg = ParametricRegion[{{x, f[x, y]}, {D[f[x, y], y] == 0, 
     D[f[x, y], {y, 2}] >= 0, -10 <= x <= 10}}, {x, y}];
plot2D = Region[Style[reg, Red], Axes -> True, AspectRatio -> 1];
{plot3D, plot2D}

• For the function f[x_,y_]:=x^2+y^2-3*x*y-x^2*y-x*y^2;

Clear["Global`*"];
f[x_, y_] := x^2 + y^2 + 3*x*y - x^2*y - x*y^2;
reg3d = ParametricRegion[{{x, y, f[x, y]}, {D[f[x, y], y] == 0, 
     D[f[x, y], {y, 2}] >= 0, -10 <= x <= 10, -20 <= y <= 20}}, {x, 
    y}];
plot3d = 
  HighlightMesh[
   DiscretizeRegion[reg3d, Axes -> True, BoxRatios -> 1, 
    PlotRange -> {{-10, 10}, {-20, 20}, {-50, 50}}], {Style[0, None], 
    Style[1, Directive@{Thick, Red}]}, ViewPoint -> Front, 
   ViewProjection -> "Orthographic"];
plot = Show[Plot3D[f[x, y], {x, -10, 10}, {y, -20, 20}, Mesh -> None],
    plot3d, BoxRatios -> 1];
reg = ParametricRegion[{{x, f[x, y]}, {D[f[x, y], y] == 0, 
     D[f[x, y], {y, 2}] >= 0, -10 <= x <= 10, -20 <= y <= 20}}, {x, 
    y}];
plot2D = 
  Region[Style[reg, Red], Axes -> True, AspectRatio -> 1, 
   PlotRange -> {{-10, 10}, {-50, 50}}];
{plot, plot3d, plot2D}

f[x_, y_] := x^2 + y^2 + 3*x*y - x^2*y - x*y^2;
Plot3D[f[x, y], {x, -10, 10}, {y, -20, 20}, 
 MeshFunctions -> Function[{x, y, z}, Evaluate@D[f[x, y], y]], 
 Mesh -> {{0}}, MeshStyle -> Red, 
 RegionFunction -> 
  Function[{x, y, z}, Evaluate[D[f[x, y], {y, 2}] >= 0]], 
 PlotPoints -> 80, MaxRecursion -> 4, BoundaryStyle -> None, 
 ClippingStyle -> None, Axes -> True, BoxRatios -> 1, 
 PlotRange -> {{-10, 10}, {-20, 20}, {-50, 50}}, PlotStyle -> None, 
 ViewPoint -> Front, ViewProjection -> "Orthographic"]

Answer 2

z = x^2 + y^2 + 3*x*y;
pt = {x, y, z} /. Minimize[{z, x == 1}, {x, y}][[2]];
Show[Plot3D[z, {x, -2, 2}, {y, -2, 2}, Mesh -> None], 
 Graphics3D[{Opacity[0.4], 
   InfinitePlane[{{1, 0, 0}, {1, 1, 0}, {1, 0, 1}}], Opacity[1], Red, 
   PointSize[0.04], Point[pt], Black, 
   Text[pt, pt, {-1, -2}, Background -> LightBlue]}]]

Update: based on comment

z = x^2 + y^2 + 3*x*y;
min = Minimize[{z, x == a}, {x, y}][[2]];
p = {x, z} /. min
q = {x, y, z} /. min;
ParametricPlot[p, {a, -10, 10}, AspectRatio -> 1]
Show[Plot3D[z, {x, -10, 10}, {y, -10, 10}, MeshFunctions -> (#1 &), 
  Mesh -> 20], ParametricPlot3D[q, {a, -10, 10}, PlotStyle -> Red], 
 AxesLabel -> {"x", "y", "z"}]

Answer 3

If I understand your question correctly, you want to plot z against x where z[x,y] has a minimum for given x. This can be done by noting that the partial derivative of f[x,y] relative to y by keeping x fix is zero. This will determine y: ymin. And with ymin we can define zmin[x] = z[x,ymin[x]]:

z[x_, y_] = x^2 + y^2 + 3*x*y;
ymin = y /. Solve[D[z[x, y], y] == 0, y][[1]];
zmin[x_] = z[x, ymin];
Plot[zmin[x], {x, -10, 10}]

Addendum

To create a 3D plot, you would create a 3D plot of z[x,y] and a parametric plot of {x,ymin,zmin[x]} and combine both using Show:

gr1 = Plot3D[z[x, y], {x, -10, 10}, {y, -10, 10}];
gr2 = ParametricPlot3D[{x, ymin, zmin[x]}, {x, -10, 10}];
Show[gr1, gr2]