<< Graphics`ImplicitPlot`; << Graphics`MultipleListPlot`; hcont = ImplicitPlot[h == en, {x, xmin, xmax}, {y, ymin, ymax}, PlotStyle -> {{Thickness[0.007], GrayLevel[0]}}, PlotPoints -> 99, DisplayFunction -> Identity]; wcont = Table[ wn = xy0[[n,3]]; intens = If[n == 1, 1, 0.7]; ImplicitPlot[w == wn, {x, xmin, xmax}, {y, ymin, ymax}, PlotStyle -> {{Thickness[0.003*intens], RGBColor[0, 1, 1]}}, PlotPoints -> 99, DisplayFunction -> Identity] , {n, mxy0}]; paral = ImplicitPlot[Det[{dh, dw}] == 0, {x, xmin, xmax}, {y, ymin, ymax}, PlotStyle -> {{Thickness[0.007], GrayLevel[0], Dashing[{0.01, 0.02}]}}, PlotPoints -> 99, DisplayFunction -> Identity]; lst0 = xy0[[{1},{1, 2}]]; lst1 = xy0[[Range[2, mxy0],{1, 2}]]; pts = MultipleListPlot[lst0, lst1, SymbolStyle -> {{RGBColor[1, 0, 0], Thickness[0.002]}, {RGBColor[0, 1, 0], Thickness[0.0015]}}, SymbolShape -> {MakeSymbol[RegularPolygon[22, 6, {0, 0}, 0, 7]], MakeSymbol[RegularPolygon[16, 4, {0, 0}, 0, 5]]}, DisplayFunction -> Identity]; {unit, leng, thic, xmin, xmax}; ticks[unit_, leng_, thic_][xmin_, xmax_] := Block[{x, x0}, x0 = unit*Ceiling[xmin/unit]; Table[{x, x, {leng, 0}, {GrayLevel[0.], Thickness[thic]}}, {x, x0, xmax, unit}] ]; (* Low resolution *) wcont0 = DensityPlot[0, {x, xmin, xmax}, {y, ymin, ymax}, PlotRange -> {-2, -1}, Mesh -> False, DefaultColor -> RGBColor[0, 0, 1], Background -> RGBColor[1, 1, 0.8], DisplayFunction -> Identity]; plt = Show[{wcont0, hcont, wcont, paral, pts}, PlotRange -> 1.04*{{xmin, xmax}, {ymin, ymax}}, AspectRatio -> 1/1, TextStyle -> {FontFamily -> "Times", FontSize -> 16}, FrameStyle -> {Thickness[0.003]}, FrameLabel -> {x, y}, FrameTicks -> {ticks[1, 0.01, 0.003], ticks[1, 0.01, 0.003], None, None}, ImageSize -> 72*{6, 6}, DisplayFunction -> Identity]; Off[Display::"pserr"]; If[Head[plt] === Graphics, If[$MachineType === "PC", pictfile = "D:\\temp\\contours.gif"; Display[pictfile, plt, "GIF"], pictfile = StringJoin[$HomeDirectory, "/.web/system/temp/contours.gif"]; Display[pictfile, plt, "GIF"]; Run[StringJoin["chmod 755 ", pictfile]] ]; (* Reference to the picture *) rnd=ToString[Floor[10^8 Random[]]]; Print["

"]; Print[""]; Print["
rnd<>"\" WIDTH=432 HEIGHT=432 ALT=\"Optimization of W under the constraint H = E\" NAME=\"plot\">Finding the minimum of the function W under the constraint H = E."]; Print["Dashed lines represent stationary points of the Lagrange function W - g H with an undetermined parameter g."]; Print["The points satisfying the constraint H = E lie on the border of the darkened area, H < E (the darker is the color, the greater is the function W)."]; Print["Ellipses represent curves of constant W."]; Print["Stationary points of the function W under the constraint H = E are marked by circles."]; Print["A point with the smallest W marked by a large circle is the solution of the problem (xmin, ymin)."]; Print["

A half-tone figure will be loaded after approximately one minute...

"]; Print["

"]; Print["

"], Print["

For some reasons, graphics was not created, see rnd<>"\">Transcript of computations.

"]; ]; (* High resolution *) wcont0 = DensityPlot[If[h > en, 0, -w], {x, xmin, xmax}, {y, ymin, ymax}, PlotRange -> {-2.5, 0}, Mesh -> False, PlotPoints -> 222, DefaultColor -> RGBColor[0, 0, 1], ColorFunction -> (RGBColor[#1, #1^1.5, #1] & ), Background -> RGBColor[1, 1, 0.8], DisplayFunction -> Identity]; plt = Show[{wcont0, hcont, wcont, paral, pts}, PlotRange -> 1.04*{{xmin, xmax}, {ymin, ymax}}, AspectRatio -> 1/1, TextStyle -> {FontFamily -> "Times", FontSize -> 16}, FrameStyle -> {Thickness[0.003]}, FrameLabel -> {x, y}, FrameTicks -> {ticks[1, 0.01, 0.003], ticks[1, 0.01, 0.003], None, None}, ImageSize -> 72*{6, 6}, DisplayFunction -> Identity]; If[Head[plt] === Graphics, If[$MachineType === "PC", pictfile = "D:\\temp\\contours.jpg"; Display[pictfile, plt, "JPEG"], pictfile = StringJoin[$HomeDirectory, "/.web/system/temp/contours.jpg"]; Display[pictfile, plt, "JPEG"]; Run[StringJoin["chmod 755 ", pictfile]] ]; ]; Print[""];