Level curves

Notice that  "contours", "contour lines", "level curves" and "level sets" are synonyms.

Below this cell there is a barely noticable cell which contains the Mathematica code that is used in this notebook.  This code is taken from the package Curves Graphics written by Gianluca Gorni, Department of Mathematics and Computer Science, University of Udine, Italy.  This code will be evaluated automatically when you evaluate the first cell in the first example.

Mathematica code (ignore)

This code is taken from the package Curves Graphics written by Gianluca Gorni, Department of Mathematics and Computer Science, University of Udine, Italy.

This part contains the Mathematica code for plotting level curves on 3d graphs.

Preliminaries and usage documentation

This code is taken from the package Curves Graphics written by Gianluca Gorni, Department of Mathematics and Computer Science, University of Udine, Italy.

If[$VersionNumber ≥ 6, 
        Print["Sorry, this version of CurvesGraphics does not work for \
Mathematica version 6 or later. Check for an update on the web \
site"]];

Off[General::"spell"]

Off[General::"spell1"]

\(\(BeginPackage["CurvesGraphics`", "Utilities`FilterOptions`", "Graphics`Arrow`", "Graphics`Colors`", "Graphics`FilledPlot`", "Graphics`PlotField`", "Algebra`InequalitySolve`", 
        If[Length@
              FileNames["*DrawingMaster.m", {$AddOnsDirectory, $UserAddOnsDirectory, $UserBaseDirectory}, Infinity] > 
            0, "DrawGraphics`DrawingMaster`", 
          Sequence @@ {}]];\)\)

Unprotect["`*"];
ClearAll["`*"];

CurvesGraphics::"Version problem" = "The CurvesGraphics package \
is written for Mathematica version up to 5.2. It does not work on later \
versions. Check the web site for updates";

If[$VersionNumber ≥ 6, 
        Message[CurvesGraphics::"Version problem"]];

TrigInterpolation

TrigInterpolation::usage = "TrigInterpolation[data,var] attempts to \
find a trigonometric function that interpolates exactly between the data. The \
data format is the same as for InterpolatingPolynomial. Options are \
EvaluateOnCoefficients and Period";

EvaluateOnCoefficients::usage = "EvaluateOnCoefficients is an \
option for TrigInterpolation, TrigInterpolationPlot and similar. It specifies \
what transformation to make on the coefficients of the trigonometric \
expression. A typical value may be \
EvaluateOnCoefficients->Simplify.";

Period::usage = "Period is an option for TrigInterpolation, \
TrigInterpolationPlot and similar. It specifies the (joint) period of the \
trigonometric functions that will make up the interpolation. The default is \
Period->Automatic";

\(\(ParametricTrigInterpolation::usage = "ParametricTrigInterpolation[data,t] attempts to find a trigonometric function that interpolates exactly between the data. The data structure is a list, of which each element is either a pair (or triplet) of numbers or a list of pairs (or triplets)";\)\)

\(\(TrigInterpolationPlot::usage = "TrigInterpolationPlot[data,xMin,xMax,opts] attempts to find a trigonometric function that interpolates exactly between the data and then plots its graph between xMin and xMax. The data have the same syntax as for InterpolatingPolynomial. It takes the options from Plot and from TrigInterpolation, plus ShowFormula, ShowListPlot, ListPlotStyle.";\)\)

\(\(TrigInterpolationDraw::usage = "TrigInterpolationDraw[data,xMin,xMax,opts] is the DrawGraphics companion to TrigInterpolationPlot";\)\)

\(\(TrigInterpolationParametricPlot::usage = "TrigInterpolationParametricPlot[data] is attempts to find a trigonometric function that interpolates exactly between the data and then plot its parametric graph. The data structure is a list, of which each element is either a pair (or triplet) of numbers or a list of pairs (or triplets). In case of pairs the plot will be 2-dimensional, otherwise it will be 3-dimensional. With the option ClosedCurve->True the plot will be a closed curve (a loop). It takes also the options from Plot and from TrigInterpolation, plus ShowFormula, ShowListPlot, ListPlotStyle.";\)\)

\(\(TrigInterpolationParametricDraw::usage = "TrigInterpolationParametricDraw[data] is the DrawGraphics companion to TrigInterpolationParametricPlot";\)\)

\(\(TrigInterpolationParametricPlot3D::usage = "TrigInterpolationParametricPlot3D[3Ddata,opts] is just TrigInterpolationParametricPlot but for 3D curves only. It is provided only for naming symmetry.";\)\)

\(\(TrigInterpolationParametricDraw3D::usage = "TrigInterpolationParametricDraw[data] is the DrawGraphics companion to TrigInterpolationParametricPlot3D";\)\)

\(\(PolynomialLevelSetTrigInterpolation::usage = "PolynomialLevelSetTrigInterpolation[2Ddata,t,x,y,opts] attempts to find a two-variable polynomial whose 0-level set interpolates the given data. The output will be a couple: the first element is the output of ParametricTrigInterpolation[2Ddata,t,opts], while the second element will be a polynomial in x and y.";\)\)

ShowListPlot::usage = "ShowListPlot is an option for \
TrigInterpolationPlot and TrigInterpolationParametricPlot. When \
ShowListPlot->True, the data points will be displayed along the \
curve.";

ListPlotStyle::usage = "ListPlotStyle is an option for \
TrigInterpolationPlot and TrigInterpolationParametricPlot. It specifies the \
style of the data points that are drawn when ShowListPlot is set to \
True";

ClosedCurve::usage = "ClosedCurve is an option for \
TrigInterpolationParametricPlot. The default is \
TrigInterpolationParametricPlot->False. When \
TrigInterpolationParametricPlot->True the curve will be closed (a \
loop).";

FilledClosedCurve::usage = "FilledClosedCurve is an option for \
TrigInterpolationParametricPlot, in the 2D case. The default is \
FilledClosedCurve->False. When FilledClosedCurve->True the curve will be \
closed (a loop) and it will be shown filled. The color is specified with the \
option Fills from Graphics`FilledPlot`";

ShowFormula::usage = "ShowFormula is an option for \
TrigInterpolationPlot and TrigInterpolationParametricPlot. The default is \
ShowFormula->False. If ShowFormula->True, the output will be a couple with \
first the graphics output and then the output of TrigInterpolation or \
ParametricTrigInterpolation.";

ShowTimesListQ::usage = "ShowTimesListQ is an option for \
OpenCurveInterpolation, ClosedCurveInterpolation and \
TrigInterpolationParametricPlot. The default is ShowTimesListQ->False. If \
ShowTimesListQ->True, the output will comprise a list of the times at which \
the parametric curve passes through the given points.";

LevelPlot3D and its companions:

\(\(LevelPlot3D::usage = 
"LevelPlot3D[f,{x,x0,x1},{y,y0,y1}] draws a 3D plot of the function f with the level sets emphasized. You can control the number (or precise position) of level sets to be drawn with the option Contours. Example: LevelPlot3D[x^2+y^2,{x,-1,1},{y,-1,1},PlotPoints->11,Contours->5}].";\)\)

\(\(LevelDraw3D::usage = 
"LevelDraw3D[f,{x,x0,x1},{y,y0,y1}] extract the Graphics primitives from LevelPlot3D, suppressing the display.";\)\)

SliceSurfacePlot3D::usage = "SliceSurfacePlot3D[3DSurface, \
LinearForm,variables] draws on the surface the level sets of the LinearForm. \
You can control how many level sets (or their precise values) with the option \
Contours. Example: \
SliceSurfacePlot3D[Plot3D[Sin[x*y],{x,0,Pi},{y,0,Pi}],x+y,x,y,z].";

SliceSurface::usage = "SliceSurface[3DSurface, \
LinearForm,variables] is an obsolete name for SliceSurfacePlot3D, retained \
for backward compatibility.";

SliceSurface = SliceSurfacePlot3D;

SliceSurfaceDraw3D::usage = "SliceSurfaceDraw3D[3DSurface, \
LinearForm,variables] is the DrawGraphics companion to \
SliceSurfacePlot3D.";

LinearClipPlot3D::usage = "LinearClipPlot3D[3DSurface, \
LinearInequality,variables] shows the part of the surface that lies in the \
half-plane defined by the linear inequality. Example: \
LinearClipPlot3D[Plot3D[Sin[x*y],{x,0,Pi},{y,0,Pi}],x+y>=8z,x,y,z].";

LinearClip::usage = "LinearClip[3DSurface, \
LinearInequality,variables] is an obsolete name for LinearClipPlot3D, \
retained for backward compatibility.";

LinearClip = LinearClipPlot3D;

LinearClipDraw3D::usage = "LinearClipDraw3D[3DSurface, \
LinearInequality,variables] is the DrawGraphics companion to \
LinearPlot3D].";

PrepareForSlices::usage = "PrepareForSlices is an option for \
LinearClipPlot3D, specifying whether to keep both the two parts of the \
surface when cutting with a plane. It can take the values True or \
False.";

SurfaceStyle::usage = "SurfaceStyle is an option for \
SliceSurfacePlot3D and LevelPlot3D, containing the Graphis3D directives to \
affect the appearance of the surface.";

ShowProjectedLevelSets::usage = "ShowProjectedLevelSets is an \
option for LevelPlot3D and SliceSurfacePlot3D. When set to True, the level \
sets will be shown both on the 3D surface and as orthogonally projected onto \
a horizontal plane (or onto a level plane of the linear form in the \
SliceSurfacePlot3D case). The z-level of the plane is controlled with \
ProjectAt. The default is ShowProjectedLevelSets->False";

ProjectAt::usage = "ProjectAt is an option for LevelPlot3D and \
SliceSurfacePlot3D. Together with ShowProjectedLevelSets->True, \
ProjectAt->realNumber tells at what z-level (or linear form level) to draw \
the projected level sets. The default is ProjectAt->0";

LinearClipPlot3D

SetAttributes[LinearClipPlot3D,  HoldRest];

Options[LinearClipPlot3D] = {PrepareForSlices -> False, 
          ReverseOrientation -> False, 
          ContourStyle -> Automatic};

LinearClipPlot3D[obj_SurfaceGraphics, other___] := 
        LinearClipPlot3D[Graphics3D[obj], other];

LinearClipPlot3D[obj_Graphics3D, 
          rel_ /; Or[
              MemberQ[{Less, LessEqual, Greater, GreaterEqual}, Head[rel]] && 
                Length[rel] > 2, Head[rel] === Inequality], var__Symbol, 
          opts___Rule] := 
        LinearClipPlot3D[obj, Evaluate@LogicalExpand[rel], var, 
            opts] //. {a___Rule, b_ -> c_, d___Rule, b_ -> f_, 
              g___Rule} :> {a, b -> c, d, g};

LinearClipPlot3D[obj_Graphics3D, rel_And, var__Symbol, opts___Rule] := 
        Show[Fold[
              LinearClipPlot3D[#1, #2, var, DisplayFunction -> Identity, 
                  opts] &, obj, 
              List @@ rel], 
FilterOptions[Graphics3D, 
              opts], 
Sequence @@ Rest[obj]] //. {a___Rule, 
              b_ -> c_, d___Rule, b_ -> f_, 
              g___Rule} :> {a, b -> c, d, g};

LinearClipPlot3D[obj_Graphics3D, 
            rel_ /; MemberQ[{Less, LessEqual, Greater, GreaterEqual}, 
                  Head[rel]] && Length[rel] == 2, var__Symbol, 
            opts___Rule] /; (PolynomialQ[Subtract @@ rel, {var}] && 
              Max[(Exponent[Expand[Subtract @@ rel], #1] &) /@ {var}] === 
                1) := Module[{ratObj, strictRel, weakRel, strictNegRel, 
            weakNegRel, eqRel, interiorQ, weakInteriorQ, exteriorQ, 
            weakExteriorQ, onBoundaryQ, interiorQList, weakInteriorQList, 
            exteriorQList, weakExteriorQList, borderTouchingQ, flatOnPlaneQ, 
            toThrowQ, winnowed, inters, clipLine, removeDuplicatePts, 
            clipContour, beyondClipLine, beyondClipContour, prepareQ, 
            boundaryLine, crossPr, parallelPolygons, normalVectorToPolygon, 
            normalVectorToClipPlane, positivelyOrientedQ, 
            rulesForConnectingSegments, dontReverseQ, 
            removeDuplicateEndPoints, boundaryStyle, boundary, 
            withoutBoundary, 
            withClippedPolygons}, 
ratObj = 
            Rationalize[obj, 1/10^6]; 
If[
            Not[MatchQ[ratObj, Graphics3D[_List, ___]]], 
            MapAt[List, ratObj, 1]]; 
strictRel = 
            Rationalize[
              rel /. {LessEqual -> Less, 
                  GreaterEqual -> Greater}, 
              1/10^6]; 
weakRel = 
            strictRel /. {Less -> LessEqual, 
                Greater -> 
                  GreaterEqual}; 
strictNegRel = 
            strictRel /. {Less -> Greater, 
                Greater -> Less}; 
weakNegRel = 
            strictNegRel /. {Less -> LessEqual, 
                Greater -> GreaterEqual}; 
eqRel = 
            strictRel /. {Less -> Equal, 
                Greater -> Equal}; 
interiorQ[
              pt_List] := 
            strictRel /. Thread[{var} -> 
                  pt]; 
weakInteriorQ[pt_List] := 
            weakRel /. Thread[{var} -> 
                  pt]; 
exteriorQ[pt_List] := 
            strictNegRel /. 
              Thread[{var} -> pt]; 
weakExteriorQ[
              pt_List] := 
            weakNegRel /. Thread[{var} -> pt]; 
          onBoundaryQ[pt_List] := 
            eqRel /. Thread[{var} -> 
                  pt]; 
interiorQList[pts_List] := 
            interiorQ /@ pts; 
weakInteriorQList[pts_List] := 
            weakInteriorQ /@ pts; 
exteriorQList[pts_List] := 
            exteriorQ /@ pts; 
weakExteriorQList[pts_List] := 
            weakExteriorQ /@ pts; 
          flatOnPlaneQ[pts_List] := 
            And[And @@ weakInteriorQList[pts], 
              And @@ weakExteriorQList[
                  pts]]; 
borderTouchingQ[pts_List] := 
            And[Or @@ weakInteriorQList[pts], Or @@ weakExteriorQList[pts], 
              Not[flatOnPlaneQ[pts]]]; 
toThrowQ[
              Polygon[pts_List]] := 
            Or[And @@ exteriorQList[pts]]; 
winnowed = 
            ratObj /. pol_Polygon?toThrowQ :> 
                Sequence @@ {}; 
inters[pt1_List, 
              pt2_List] := 
            t pt1 + (1 - t) pt2 /. Solve[
                  eqRel /. Thread[{var} -> 
                        t*pt1 + (1 - t) pt2], t][[1]]; 
          clipLine[pt1_List?exteriorQ, pt2_List?exteriorQ] := Sequence @@ {}; 
          clipLine[pt1_List?interiorQ, pt2_List?weakExteriorQ] := {pt1, 
              inters[pt1, pt2]}; 
          clipLine[pt1_List?weakInteriorQ, pt2_List?exteriorQ] := {pt1, 
              inters[pt1, pt2]}; 
          clipLine[pt1_List?weakExteriorQ, 
              pt2_List?interiorQ] := {inters[pt1, pt2], pt2}; 
          clipLine[pt1_List?exteriorQ, 
              pt2_List?weakInteriorQ] := {inters[pt1, pt2], 
              pt2}; 
clipLine[pt1_List?weakInteriorQ, 
              pt2_List?weakInteriorQ] := {pt1, 
              pt2}; 
removeDuplicatePts = ({a___, b_List, 
                  b_, c___} :> {a, b, 
                  c}); 
clipContour[pts_List] := 
            Flatten[Apply[clipLine, Partition[Append[pts, First[pts]], 2, 1], 
                  1], 1] //. 
              removeDuplicatePts; 
beyondClipLine[
              pt1_List?interiorQ, pt2_List?interiorQ] := Sequence @@ {}; 
          beyondClipLine[pt1_List?weakInteriorQ, 
              pt2_List?exteriorQ] := {inters[pt1, pt2], 
              pt2}; 
beyondClipLine[pt1_List?interiorQ, 
              pt2_List?weakExteriorQ] := {inters[pt1, pt2], pt2}; 
          beyondClipLine[pt1_List?exteriorQ, pt2_List?weakInteriorQ] := {pt1, 
              inters[pt1, pt2]}; 
          beyondClipLine[pt1_List?weakExteriorQ, pt2_List?interiorQ] := {pt1, 
              inters[pt1, pt2]}; 
          beyondClipLine[pt1_List?weakExteriorQ, 
              pt2_List?weakExteriorQ] := {pt1, 
              pt2}; 
beyondClipContour[pts_List] := 
            Flatten[Apply[beyondClipLine, 
                  Partition[Append[pts, First[pts]], 2, 1], 1], 1] //. 
              removeDuplicatePts; 
prepareQ = PrepareForSlices /. {opts} /. Options[
                LinearClipPlot3D]; 
          boundaryLine[clipCtr_List] := 
            Cases[Partition[clipCtr, 2, 
                1], {p__List?onBoundaryQ} :> 
                Line[{p}]]; 
normalVectorToPolygon[
              polyPts_List] := 
            Cross @@ Map[
                Last[#] - First[#] &, {polyPts, 
                  RotateLeft[
                    polyPts]}]; 
normalVectorToClipPlane = 
            Outer[D, {Subtract @@ rel}, {var}] // 
              First; 
positivelyOrientedQ[polyPts_List, 
              boundaryPts_List] := 
            Positive[
              Det[{normalVectorToPolygon[polyPts], 
                  Last[boundaryPts] - First[boundaryPts], 
                  normalVectorToClipPlane}]]; 
positivelyOrientedQ[polyPts_List, {}] := 
            False; 
rulesForConnectingSegments = {({a___, 
                      Line[{b_List, c1_, c___}], d___, Line[{e___, e1_, b_}], 
                      f___} /; c1 =!= 
                      e1) :> 
{Line[{e, e1, 
                      b, c1, c}], a, d, 
                  f}, ({a___, Line[{c___, c1_, b_List}], d___, 
                      Line[{b_, e1_, e___}], f___} /; 
                    c1 =!= e1) :> {Line[{c, c1, b, e1, e}], a, 
                  d, f}}; 
dontReverseQ = 
            Not@TrueQ[ReverseOrientation /. {opts} /. 
                  Options[
                    LinearClipPlot3D]]; 
removeDuplicateEndPoints = 
            Polygon[{a_, b___, a_}] :> 
              Polygon[{a, 
                  b}]; 
boundaryStyle = ContourStyle /. {opts} /. Options[LinearClipPlot3D]; 
If[
            boundaryStyle === Automatic, 
            boundaryStyle = {}]; 
crossPr[{a_, b_, 
                c_}, {e_, f_, g_}] = {-c f + b g, 
              c e - a g, -b e + 
                a f}; 
parallelPolygons[{pt1_, pt2_, pt3_, 
                pts___}] := 
            With[{normal = crossPr[pt1 - pt2, pt2 - pt3]/10^10}, {Polygon[
                  Map[# + normal &, {pt1, pt2, pt3, pts}]], 
                Polygon[
                  Map[# - normal &, {pt1, pt2, pt3, 
                      pts}]]}]; 
boundary = {}; 
withoutBoundary := withoutBoundary = winnowed /. {Polygon[
                        pts_List /; 
                          Length[pts] > 2 && 
                            flatOnPlaneQ[pts]] :> (AppendTo[
                          boundary, parallelPolygons[pts]]; 
                        Polygon[pts]), 
Polygon[
                        pts_List?borderTouchingQ] :> 
                      Module[{clCon = clipContour[pts], 
                          bClCon = beyondClipContour[pts], 
                          bndLine}, 
bndLine = 
                          Union[boundaryLine[
                                Join[clCon, bClCon] //. removeDuplicatePts] /. 
                              Line[segment_ /; 
                                    Not@positivelyOrientedQ[pts, 
                                        segment]] :> 
                                Line[Reverse[
                                    segment]]]; 
AppendTo[
                          boundary, 
                          bndLine]; 
Sequence @@ {Polygon[
                              clCon], Polygon[bClCon]}]} /. 
                removeDuplicateEndPoints; 
withClippedPolygons := 
            Show[{withoutBoundary; winnowed, 
                Graphics3D[
                  Join[{Sequence @@ 
                        Flatten[{If[FreeQ[boundary, Polygon], boundaryStyle, 
                              If[FreeQ[boundaryStyle, 
                                  colorSpecPattern], {boundaryStyle, 
                                  EdgeForm[], 
                                  SurfaceColor[
                                    GrayLevel[0]]}, {boundaryStyle, 
                                  EdgeForm[], 
                                  SurfaceColor[
                                    Last@Cases[boundaryStyle, 
                                        colorSpecPattern, {0, 
                                        Infinity}]]}]]}]}, 
                    Union[Flatten[boundary]] //. 
                      rulesForConnectingSegments]]}, 
              DisplayFunction -> Identity]; 
Show[
            If[prepareQ, 
              withClippedPolygons, winnowed /. Polygon[
                      pts_List?borderTouchingQ] :> 
                    Polygon[clipContour[pts]] /. removeDuplicateEndPoints], 
            FilterOptions[Graphics3D, opts, 
              Sequence @@ Rest[obj]]]];

SetAttributes[LinearClipDraw3D, HoldRest];

LinearClipDraw3D[obj_Graphics3D, 
            rel_ /; MemberQ[{Less, LessEqual, Greater, GreaterEqual}, 
                  Head[rel]] && Length[rel] == 2, var__Symbol, 
            opts___Rule] /; (PolynomialQ[Subtract @@ rel, {var}] && 
              Max[(Exponent[Expand[Subtract @@ rel], #1] &) /@ {var}] === 
                1) := Block[{$DisplayFunction = 
              Identity}, 
LinearClipPlot3D[obj, rel, var, 
              opts][[1]]];

LinearClipDraw3D[obj_SurfaceGraphics, other___] := 
        LinearClipDraw3D[Graphics3D[obj], other];

LinearClipDraw3D[obj_Graphics3D, 
          rel_ /; Or[
              MemberQ[{Less, LessEqual, Greater, GreaterEqual}, Head[rel]] && 
                Length[rel] > 2, Head[rel] === Inequality], var__Symbol, 
          opts___Rule] := 
        Block[{$DisplayFunction = Identity}, LinearClipPlot3D[obj, 
              Evaluate@LogicalExpand[rel], var, 
              opts][[1]]];

LinearClipDraw3D[obj_Graphics3D, rel_And, var__Symbol, opts___Rule] := 
        Block[{$DisplayFunction = Identity}, Fold[
              LinearClipPlot3D[#1, #2, var, DisplayFunction -> Identity, 
                  opts] &, obj, List @@ rel][[1]]];

SliceSurfacePlot3D

SetAttributes[SliceSurfacePlot3D,  HoldRest];

Options[SliceSurfacePlot3D] = 
        Join[{Contours -> 11, SurfaceStyle -> {EdgeForm[]}, 
            ContourStyle -> Automatic, 
            ColorFunctionScaling -> True, OrientedCurve -> False, 
            ShowProjectedLevelSets -> False, ProjectAt -> 0, 
            ArrowDensity -> 1, ArrowPositions -> Automatic, 
            ReverseOrientation -> 
              False, 
ShowSurface -> True, 
            ShowCurves -> True, Arrow3DColor -> Automatic, 
            DrawGraphics`DrawingArrows`HeadScaling3D -> Automatic, 
            DrawGraphics`DrawingArrows`HeadLength3D -> 1/10}, 
          Options[ParametricPlot3D]];

SliceSurfacePlot3D[obj_SurfaceGraphics, other___] := 
        SliceSurfacePlot3D[Graphics3D[obj], other];

\(\(SliceSurfacePlot3D[obj_Graphics3D, linForm_, x_Symbol, y_Symbol, 
            z_Symbol, 
            opts___?OptionQ] /; \((PolynomialQ[linForm, {x, y, z}] && 
              Max[Map[Exponent[Expand[linForm], #] &, {x, y, z}]] === 1)\) := 
        Module[{projQ, zlev, sl, mshsty, ratObj, vertList, extremaOfLinForm, 
            linearFormExcursion, lnsty, colorScalingQ, sliceList, 
            sliceLineList, centralVal, srf, cntr, sliceLines, grad, 
            gradNormalized, squishedLinesAdded, plotWithoutArrows, arwDnsty, 
            pos, orientedQ, arw3Dcolor, maxLevelLineLength, howManyArrows, 
            arrowPos, normalizedArrowPos, hdscl3D, addArrows, 
            plotWithArrows}, 
{projQ, 
              zlev} = \({ShowProjectedLevelSets, ProjectAt} /. {opts}\) /. 
              Options[SliceSurfacePlot3D]; 
sl = \(Contours /. {opts}\) /. Options[SliceSurfacePlot3D]; 
mshsty = 
            Flatten[\({SurfaceStyle} /. {opts}\) /. 
                Options[SliceSurfacePlot3D]]; 
ratObj = 
            Rationalize[obj[\([1]\)], 
              1/10^6]; 
triangulized = 
            ratObj /. Polygon[{pt1_List, pts___}] :> 
                Sequence @@ 
                  Map[Polygon[Join[{pt1}, #]] &, 
                    Partition[{pts}, 2, 1]]; 
vertList = 
            Cases[ratObj, 
              Polygon[pts_List] :> Sequence @@ pts, {1, 
                Infinity}]; 
extremaOfLinForm = \({Min[#], 
                  Max[#]} &\)[
              linForm /. 
                Map[Thread[{x, y, z} -> #] &, 
                  vertList]]; 
linearFormExcursion = 
            Abs[Subtract @@ extremaOfLinForm]; 
If[
            Chop@linearFormExcursion === 0, 
            Print["The object is flat in the direction of the slices"]; 
            Abort[]]; 
{lnsty, 
              colorScalingQ} = \({ContourStyle, 
                  ColorFunctionScaling} /. {opts}\) /. 
              Options[SliceSurfacePlot3D]; 
If[
            MatchQ[lnsty, Hue | GrayLevel | _Function], 
            If[TrueQ@colorScalingQ, 
              lnsty = Evaluate[
                    lnsty[\((# - First@extremaOfLinForm)\)/
                        linearFormExcursion]] &], 
            lnsty = \((Evaluate[lnsty] &)\)]; 
sliceList = 
            Which[IntegerQ[sl] && sl > 0, 
              Drop[Rest[
                  Range @@ \((extremaOfLinForm~
                        Join~{Abs[
                              Subtract @@ extremaOfLinForm]/\((sl + 
                                1)\)})\)], \(-1\)], 
              MatchQ[sl, {val__?\((\((NumericQ[#] && 
                            FreeQ[N[#], Complex])\) &)\)}], 
              sl, 
True, 
              Print["can't handle these contours"]; 
              Abort[]]; 
sliceList = 
            Sort[sliceList, 
              Less]; 
sliceLineList = {}; 
{Graphics3D[triangulized], 
              sliceList} //. {{gr_Graphics3D, 
                  valueList_List /; 
                    Length[valueList] ≥ 
                      2} :> \((centralVal = 
                    Floor[Length[valueList]/2]; {{srf, cntr} = 
                      LinearClipPlot3D[gr, 
                          linForm ≤ valueList[\([centralVal]\)], 
                          x, y, z, DisplayFunction -> Identity, 
                          PrepareForSlices -> True, 
                          ContourStyle -> 
                            lnsty[valueList[\([centralVal]\)]]] // 
                        First; 
AppendTo[
                      sliceLineList, {valueList[\([centralVal]\)], 
                        cntr}]; 
If[
                      centralVal > 1, {Graphics3D[srf], 
                        Take[valueList, centralVal - 1]}, 
                      Sequence @@ {}], 
{srf, cntr} = 
                      LinearClipPlot3D[gr, 
                          linForm ≥ 
                            valueList[\([centralVal + 1]\)], x, y, z, 
                          DisplayFunction -> Identity, 
                          PrepareForSlices -> True, 
                          ContourStyle -> 
                            lnsty[valueList[\([centralVal + 1]\)]]] // 
                        First; 
AppendTo[
                      sliceLineList, {valueList[\([centralVal + 1]\)], 
                        cntr}]; 
If[
                      centralVal + 1 < Length[valueList], {Graphics3D[srf], 
                        Drop[valueList, centralVal + 1]}, 
                      Sequence @@ {}]})\), 
{gr_Graphics3D, {value_}} :> \(({srf, cntr} = 
                    LinearClipPlot3D[gr, linForm ≤ value, x, y, z, 
                        DisplayFunction -> Identity, 
                        PrepareForSlices -> True, 
                        ContourStyle -> lnsty[value]] // First; 
                  AppendTo[sliceLineList, {value, cntr}]; 
                  Sequence @@ {})\)}; 
sliceLines = \(Sort[
                sliceLineList, 
                First[#1] < 
                    First[#2] &]\)[\([All, \(-1\)]\)]; 
grad = \(Outer[
                D, {linForm}, {x, y, 
                  z}]\)[\([1]\)]; 
gradNormalized = 
            grad/Sqrt[grad . grad]; 
squishedLinesAdded := 
            sliceLines /. \((hd : \((Line | Polygon)\))\)[
                  pts_] :> {hd[pts], 
                  hd[Map[# - \((gradNormalized . #)\) gradNormalized + 
                          zlev*grad/\((linForm /. 
                                  Thread[{x, y, z} -> grad])\) &, 
                      pts]]}; 
{shwSrf, 
              shwCrv} = \({ShowSurface, ShowCurves} /. {opts}\) /. 
              Options[SliceSurfacePlot3D]; 
plotWithoutArrows = 
            Graphics3D[{If[TrueQ@shwSrf, Join[mshsty, ratObj], {}], 
                If[TrueQ@shwCrv, 
                  If[TrueQ@projQ, squishedLinesAdded, 
                    sliceLines], {}]}]; 
{arwDnsty, pos, 
              orientedQ, 
              arw3Dcolor} = \({ArrowDensity, ArrowPositions, OrientedCurve, 
                  Arrow3DColor} /. {opts}\) /. 
              Options[LevelPlot3D]; 
returnWithoutArrows := 
            Show[plotWithoutArrows, FilterOptions[Graphics3D, opts], 
              DisplayFunction -> $DisplayFunction, 
              BoxRatios -> Automatic, 
              Rest[List @@ obj]]; 
If[
            Not[TrueQ[orientedQ]], 
            Return[returnWithoutArrows]]; 
If[
            Not@DrawGraphicsInstalledQ, 
            Message[Oriented::"DrawGraphics not installed"]; 
            Return[returnWithoutArrows]]; 
If[
            MatchQ[arw3Dcolor, Hue | GrayLevel | _Function], 
            If[TrueQ@colorScalingQ, 
              arw3Dcolor = 
                Evaluate[
                    arw3Dcolor[\((# - First@extremaOfLinForm)\)/
                        linearFormExcursion]] &], 
            arw3Dcolor = \((Evaluate[
                    arw3Dcolor] &)\)]; 
maxLevelLineLength := 
            Max @@ N[
                Cases[plotWithoutArrows, 
                  l_Line :> lineLength @@ l, Infinity]]; 
          howManyArrows[pts_] := 
            Round[arwDnsty*3 
                 lineLength[pts]/
                  maxLevelLineLength]; 
arrowPos[
              pts_ /; pos === 
                  Automatic] := 
\((Range[1, 2  # - 1, 2]/
                    Max[2  #, 1] &)\)[
              howManyArrows[pts]]; 
arrowPos[
              pts_ /; pos =!= Automatic] := 
            Flatten[{pos}]; 
normalizedArrowPos[
              pts_] := \((\((# - Min[#, 0])\)/\((Max[#, 1] - 
                        Min[#, 0])\) &)\)[
              arrowPos[pts]]; 
hdscl3D = 
            automaticHeadScaling3D[plotWithoutArrows, opts, 
              Sequence @@ 
                Options[SliceSurfacePlot3D]]; 
addArrows[
              pts_, linFormValue_] := {Line[pts], 
              insertArrows[pts, normalizedArrowPos[pts], hdscl3D, 
                Arrow3DColor -> arw3Dcolor[linFormValue], 
                PlotStyle -> lnsty[linFormValue], opts, 
                FilterOptions[DrawGraphics`DrawingArrows`Arrow3D, 
                  Options[
                    SliceSurfacePlot3D]]]}; 
plotWithArrows = Graphics3D[{First@plotWithoutArrows, 
                Last@plotWithoutArrows /. 
If[
                    TrueQ@projQ, 
{Line[pts1_], 
                        Line[pts2_]} :> \((linFormValue = 
                          linForm /. 
                            Thread[{x, y, z} -> First[pts1]]; {addArrows[
                            pts1, linFormValue], 
                          addArrows[pts2, 
                            linFormValue]})\), 
Line[
                        pts_] :> 
                      Sequence @@ 
                        addArrows[pts, 
                          linForm /. 
                            Thread[{x, y, z} -> 
                                First[pts]]]]}]; 
Show[
            plotWithArrows, 
            FilterOptions[Graphics3D, opts, BoxRatios -> Automatic, 
              DisplayFunction -> $DisplayFunction, 
              Rest[List @@ obj]]]
];\)\)

SliceSurfaceDraw3D[obj_Graphics3D, linForm_, x_Symbol, y_Symbol, 
            z_Symbol, 
            opts___?OptionQ] /; (PolynomialQ[linForm, {x, y, z}] && 
              Max[Map[Exponent[Expand[linForm], #] &, {x, y, z}]] === 1) := 
        Block[{$DisplayFunction = 
              Identity}, 
SliceSurfacePlot3D[obj, 
              linForm, x, y, z, opts][[1]]];

LevelPlot3D

SetAttributes[LevelPlot3D, HoldAll];

Options[LevelPlot3D] = 
        Join[{Contours -> 11, SurfaceStyle -> {EdgeForm[]}, 
            ContourStyle -> Automatic, 
            ShowProjectedLevelSets -> False, ProjectAt -> 0, 
            OrientedCurve -> False, ArrowDensity -> 1, 
            ArrowPositions -> Automatic, 
            ReverseOrientation -> False, ShowSurface -> True, 
            ShowCurves -> True, Arrow3DColor -> Automatic, 
            DrawGraphics`DrawingArrows`HeadScaling3D -> Automatic, 
            DrawGraphics`DrawingArrows`HeadLength3D -> 1/30}, 
          Options[ParametricPlot3D]];

LevelPlot3D[f_, {x_Symbol, xMin_, xMax_}, {y_Symbol, yMin_, yMax_}, 
          opts___] := 
        Module[{z}, 
SliceSurfacePlot3D[
            Plot3D[f, {x, xMin, xMax}, {y, yMin, yMax}, 
              DisplayFunction -> Identity, 
              Evaluate[FilterOptions[Plot3D, opts]]], z, x, y, z, 
            opts]];

LevelDraw3D[x__] := 
        Block[{$DisplayFunction = Identity}, 
LevelPlot3D[
              x][[1]]];

Examples of level curves

It might take a minute for the first cell to be evalulated for the first time.

Example 1

Plot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 35, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

Three level curves at specified levels -1, 0 , 1.

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> {-1, 0, 1}, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

15 level curves at specified levels  -(7/2), -(5/2),  ... , (5/2), (7/2).

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> Range[-(7/2), (7/2), (1/2)], 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

We can color the contours at different levels by different colors:

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 35, ContourStyle -> Hue, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 35, ContourStyle -> Hue, 
        ShowProjectedLevelSets -> True, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

We can show projected level curves at the top of the graph.

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 35, ContourStyle -> Hue, 
        ShowProjectedLevelSets -> True, ProjectAt -> 4, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

We can omit the surface and show only the level curves

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 35, ContourStyle -> Hue, 
        ShowSurface -> False,  BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

Now we can add projected level curves.

LevelPlot3D[(x^2) - (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 35, ContourStyle -> Hue, 
        ShowSurface -> False, ShowProjectedLevelSets -> True, 
        ProjectAt -> 4, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

A contour diagram

Now we show only level curves:

ContourPlot[(x^2) - (y^2),{x, -2, 2},{y, -2, 2},PlotPoints -> {55, 55},Contours -> 25,ContourShading -> False,ColorFunction -> Hue, AspectRatio -> Automatic];

Sometimes shading is used to indicate the level of the level curves:

ContourPlot[(x^2) - (y^2),{x, -2, 2},{y, -2, 2},PlotPoints -> {55, 55},Contours -> 25,ContourShading -> True,ColorFunction -> GrayLevel, AspectRatio -> Automatic];

The darker shade indicates smaller numbers, almost white indicate larger numbers. This is indicated by the following picture.

st = (1/100); ymin = - .1; ymax =  .1;
\(\(Show[
        Graphics[{
\({GrayLevel[#], 
                  Polygon[{{#, ymin}, {# + st, ymin}, {# + st, ymax}, {#, 
                        ymax}, {#, ymin}}]} &\) /@ 
              Range[0, 1 - st, 
                st], 
{Text["small", { .075, \(- .05\)}, TextStyle -> \ {FontWeight -> Bold, 
                    FontColor -> White, FontSize -> 15}], 
              Text["large", { .875, \(- .05\)}, 
                TextStyle -> \ {FontWeight -> Bold, 
                    FontSize -> 
                      15}]}
}], 
PlotRange -> {{0, 1}, {ymin, 
              ymax}}, 
AspectRatio -> Automatic, 
        ImageSize -> 400
];\)\)

Since we prefer more colorful graphs the following color scheme is also used

st = (1/100); ymin = - .1; ymax =  .1;
\(\(Show[
        Graphics[{
\({Hue[#], 
                  Polygon[{{#, ymin}, {# + st, ymin}, {# + st, ymax}, {#, 
                        ymax}, {#, ymin}}]} &\) /@ 
              Range[0, 1 - st, 
                st], 
{Text["small", { .075, \(- .05\)}, TextStyle -> \ {FontWeight -> Bold, FontSize -> 15}], 
              Text["large", { .875, \(- .05\)}, 
                TextStyle -> \ {FontWeight -> Bold, 
                    FontSize -> 
                      15}]}
}], 
PlotRange -> {{0, 1}, {ymin, 
              ymax}}, 
AspectRatio -> Automatic, 
        ImageSize -> 400
];\)\)

ContourPlot[(x^2) - (y^2),{x, -2, 2},{y, -2, 2},PlotPoints -> {55, 55},Contours -> 25,ContourShading -> True,ColorFunction -> Hue, AspectRatio -> Automatic];

Example 2

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 30, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> {1, 2, 3, 4}, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

We can color the contours at different levels by different colors:

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 30, ContourStyle -> Hue, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 30, ContourStyle -> Hue, 
        ShowProjectedLevelSets -> True, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

We can show projected level curves at the top of the graph.

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 30, ContourStyle -> Hue, 
        ShowProjectedLevelSets -> True, ProjectAt -> 8, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

We can omit the surface and show only the level curves

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 30, ContourStyle -> Hue, 
        ShowSurface -> False,  BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

Now we can add projected level curves.

LevelPlot3D[(x^2) + (y^2), {x, -2, 2}, {y, -2, 2}, 
        Contours -> 30, ContourStyle -> Hue, 
        ShowSurface -> False, ShowProjectedLevelSets -> True, 
        ProjectAt -> 8, BoxRatios -> {1, 1, 1.5}, 
        ImageSize -> 300];

A contour diagram

Now we show only level curves:

ContourPlot[(x^2) + (y^2),{x, -2, 2},{y, -2, 2},PlotPoints -> {75, 75},Contours -> 30,ContourShading -> False,ColorFunction -> Hue, AspectRatio -> Automatic];

Sometimes shading is used to indicate the level of the level curves:

ContourPlot[(x^2) + (y^2),{x, -2, 2},{y, -2, 2},PlotPoints -> {75, 75},Contours -> 30,ContourShading -> True,ColorFunction -> GrayLevel, AspectRatio -> Automatic];

The darker shade indicates smaller numbers, almost white indicate larger numbers. This is indicated by the following picture.

st = (1/100); ymin = - .1; ymax =  .1;
\(\(Show[
        Graphics[{
\({GrayLevel[#], 
                  Polygon[{{#, ymin}, {# + st, ymin}, {# + st, ymax}, {#, 
                        ymax}, {#, ymin}}]} &\) /@ 
              Range[0, 1 - st, 
                st], 
{Text["small", { .075, \(- .05\)}, TextStyle -> \ {FontWeight -> Bold, 
                    FontColor -> White, FontSize -> 15}], 
              Text["large", { .875, \(- .05\)}, 
                TextStyle -> \ {FontWeight -> Bold, 
                    FontSize -> 
                      15}]}
}], 
PlotRange -> {{0, 1}, {ymin, 
              ymax}}, 
AspectRatio -> Automatic, 
        ImageSize -> 400
];\)\)

Since we prefer more colorful graphs the following color scheme is also used

st = (1/100); ymin = - .1; ymax =  .1;
\(\(Show[
        Graphics[{
\({Hue[#], 
                  Polygon[{{#, ymin}, {# + st, ymin}, {# + st, ymax}, {#, 
                        ymax}, {#, ymin}}]} &\) /@ 
              Range[0, 1 - st, 
                st], 
{Text["small", { .075, \(- .05\)}, TextStyle -> \ {FontWeight -> Bold, FontSize -> 15}], 
              Text["large", { .875, \(- .05\)}, 
                TextStyle -> \ {FontWeight -> Bold, 
                    FontSize -> 
                      15}]}
}], 
PlotRange -> {{0, 1}, {ymin, 
              ymax}}, 
AspectRatio -> Automatic, 
        ImageSize -> 400
];\)\)

ContourPlot[(x^2) + (y^2),{x, -2, 2},{y, -2, 2},PlotPoints -> {75, 75},Contours -> 30,ContourShading -> True,ColorFunction -> Hue, AspectRatio -> Automatic];

Example 3

ff[x_, y_] := (y^3) + x y;

    
xmin = -6; xmax = 2; ymin = -2; ymax = 2;

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {75, 50}, Contours -> 45, 
        ContourStyle -> Hue, BoxRatios ->  {1, 1, 1.5}, 
        ImageSize -> 300];

LevelPlot3D[ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {75, 50}, Contours -> {-2, 0, 2}, 
        ContourStyle -> Hue, BoxRatios ->  {1, 1, 1.5}, 
        ImageSize -> 300];

LevelPlot3D[ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {75, 50}, Contours -> 65, 
        ShowSurface -> False, ContourStyle -> Hue, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

LevelPlot3D[ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {75, 50}, Contours -> 65, 
        ShowSurface -> False, ContourStyle -> Hue, 
        ShowProjectedLevelSets -> True, ProjectAt -> 12, 
        BoxRatios -> {1, 1, 1.5}, ImageSize -> 300];

A contour diagram

Now we show only level curves:

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {75, 75},Contours -> 45,ContourShading -> False,ColorFunction -> Hue, AspectRatio -> Automatic,ImageSize -> 400];

Sometimes shading is used to indicate the level of the level curves:

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {75, 75},Contours -> 45,ContourShading -> True,ColorFunction -> GrayLevel, AspectRatio -> Automatic,ImageSize -> 400];

The darker shade indicates smaller numbers, almost white indicate larger numbers. This is indicated by the following picture.

st = (1/100); ymins = - .1; ymaxs =  .1;
\(\(Show[
        Graphics[{
\({GrayLevel[#], 
                  Polygon[{{#, ymins}, {# + st, ymins}, {# + st, ymaxs}, {#, 
                        ymaxs}, {#, ymins}}]} &\) /@ 
              Range[0, 1 - st, 
                st], 
{Text["small", { .075, \(- .05\)}, TextStyle -> \ {FontWeight -> Bold, 
                    FontColor -> White, FontSize -> 15}], 
              Text["large", { .875, \(- .05\)}, 
                TextStyle -> \ {FontWeight -> Bold, 
                    FontSize -> 
                      15}]}
}], 
PlotRange -> {{0, 1}, {ymins, 
              ymaxs}}, 
AspectRatio -> Automatic, 
        ImageSize -> 400
];\)\)

Since we prefer more colorful graphs the following color scheme is also used

st = (1/100); ymins = - .1; ymaxs =  .1;
\(\(Show[
        Graphics[{
\({Hue[#], 
                  Polygon[{{#, ymins}, {# + st, ymins}, {# + st, ymaxs}, {#, 
                        ymaxs}, {#, ymins}}]} &\) /@ 
              Range[0, 1 - st, 
                st], 
{Text["small", { .075, \(- .05\)}, TextStyle -> \ {FontWeight -> Bold, FontSize -> 15}], 
              Text["large", { .875, \(- .05\)}, 
                TextStyle -> \ {FontWeight -> Bold, 
                    FontSize -> 
                      15}]}
}], 
PlotRange -> {{0, 1}, {ymins, 
              ymaxs}}, 
AspectRatio -> Automatic, 
        ImageSize -> 400
];\)\)

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {75, 75},Contours -> 45,ContourShading -> True,ColorFunction -> Hue, AspectRatio -> Automatic,ImageSize -> 400];

Example 4

ff[x_, y_] := x Sin[y];

    
xmin = -3; xmax = 3; ymin = -Pi; ymax = 2  Pi;

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {40, 60}, Contours -> 45, 
        ContourStyle -> Hue, 
        Ticks -> {Automatic, Range[ymin, ymax, (Pi/2)], Automatic}, 
        BoxRatios ->  {1, 1.5, 1}, ImageSize -> 300];

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {40, 60}, Contours -> 45, 
        ContourStyle -> Hue, 
        Ticks -> {Automatic, Range[ymin, ymax, (Pi/2)], Automatic}, 
        BoxRatios ->  {1, 1.5, 1}, ImageSize -> 300];

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {40, 60}, Contours -> 45, 
        ContourStyle -> Hue, ShowProjectedLevelSets -> True, 
        ProjectAt -> 3, 
        Ticks -> {Automatic, Range[ymin, ymax, (Pi/2)], Automatic}, 
        BoxRatios ->  {1, 1.5, 1}, ImageSize -> 300];

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {40, 60}, Contours -> 65, 
        ShowSurface -> False, ContourStyle -> Hue, 
        Ticks -> {Automatic, Range[ymin, ymax, (Pi/2)], Automatic}, 
        BoxRatios ->  {1, 1.5, 1}, ImageSize -> 300];

A contour diagram

Now we show only level curves:

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {75, 75},Contours -> 45,ContourShading -> False,ColorFunction -> Hue, AspectRatio -> Automatic,ImageSize -> 300];

Sometimes shading is used to indicate the level of the level curves:

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {75, 75},Contours -> 45,ContourShading -> True,ColorFunction -> GrayLevel, AspectRatio -> Automatic,ImageSize -> 300];

The darker shade indicates smaller numbers, almost white indicate larger numbers.

Or using more colors

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {75, 75},Contours -> 45,ContourShading -> True,ColorFunction -> Hue, AspectRatio -> Automatic,ImageSize -> 400];

Example 5

ff[x_, y_] := -Cos[x] + ((y^2)/2);

    
xmin = -Pi; xmax = 3 Pi; ymin = -2; ymax = 2;

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {50, 20}, Contours -> 25, 
        ContourStyle -> Hue, 
        Ticks -> {Range[xmin, xmax, (Pi/2)], Automatic, Automatic}, 
        BoxRatios ->  {2, 1, 1}, ImageSize -> 300];

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {50, 20}, Contours -> 25, 
        ContourStyle -> 
          Hue, 
ShowProjectedLevelSets -> True, 
        ProjectAt -> 3, 
        Ticks -> {Range[xmin, xmax, (Pi/2)], Automatic, Automatic}, 
        BoxRatios ->  {2, 1, 1}, ImageSize -> 300];

LevelPlot3D[ ff[x, y], {x, xmin, xmax}, {y, ymin, ymax}, 
        PlotPoints -> {50, 20}, Contours -> 55, 
        ContourStyle -> Hue, ShowSurface -> False, 
        Ticks -> {Range[xmin, xmax, (Pi/2)], Automatic, Automatic}, 
        BoxRatios ->  {2, 1, 1}, ImageSize -> 300];

A contour diagram

Now we show only level curves:

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {175, 75},Contours -> 25,ContourShading -> False,ColorFunction -> Hue, AspectRatio -> Automatic,ImageSize -> 425];

Sometimes shading is used to indicate the level of the level curves:

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {175, 75},Contours -> 25,ContourShading -> True,ColorFunction -> GrayLevel, AspectRatio -> Automatic,ImageSize -> 425];

The darker shade indicates smaller numbers, almost white indicate larger numbers.

Or using more colors

ContourPlot[ff[x, y],{x, xmin, xmax},{y, ymin, ymax},PlotPoints -> {175, 75},Contours -> 25,ContourShading -> True,ColorFunction -> Hue, AspectRatio -> Automatic,ImageSize -> 425];