please discard.

Hi Gerald,

It's not entirely straightforward to me. I was rather surprised that Mathematica found Shenghui's example so easy to solve. In general, you have to worry about unbounded curves, curves with multiple loops, self-intersecting curves (like Lissajous) and other singularities, and so on. Parametric has to be treated differently than implicit, and converting from one form to the other is not always easy.

In general, each example needs to be worked on and tweaked. One might try to simplify some step, like fixing the bounding rectangle. Then one has to find examples that can be shown in the chosen rectangle. It's more work than I can put into it right now.

Plus, for me, figuring out how to do the mathematics and how to express the mathematics in WL is the interesting bit. If that's how you feel, I suggest you take one of your examples and try to work it up. If you get stuck, post a question on the main community site so others will see it. Then I or someone else might be able to give you help. That way, you build your own knowledge.

Demonstrations used Today:

• https://demonstrations.wolfram.com/PolynomialAndDerivative/
• https://demonstrations.wolfram.com/DerivativesALookAtGraphs/
• https://demonstrations.wolfram.com/CauchyMeanValueTheorem/
• https://demonstrations.wolfram.com/MeanValueTheorem/

Handy WFR function:

• https://resources.wolframcloud.com/FunctionRepository/resources/CurveAnalysis/

Here's an applet that builds on @Shenghui Yang's example. It finds all the tangents with a given slope. I also used an exact solver instead of a numerical one, for variety's sake. I'm quite familiar with Wolfram Language, and I apologize if some of the functions I used are a little further along your personal learning curve for WL.

f[x_, y_] := x^2 + x*Sin[4*y] + 3 y^2 - 7 + Cos[3*x];
(* there are powerful algorithms for solving transcendental equations
   over bounded domains, so we'll help Solve[] out with the following *)
boundsArray = RegionBounds[ImplicitRegion[f[x, y] == 0, {x, y}]];
boundsArray = boundsArray /. x_Real :> Sign[x] Ceiling[Abs[x] + 0.01, 1/128]; (* pad bounds a bit *)
boundsIneqs = Replace[boundsArray,
  {{x1_, x2_}, {y1_, y2_}} :> x1 < x < x2 && y1 < y < y2];
(* pre-compute plot to speed up Manipulate[] *)
curvePlot = Replace[boundsArray,
   {{x1_, x2_}, {y1_, y2_}} :> ContourPlot[f[x, y] == 0, {x, x1, x2}, {y, y1, y2}]];
(* Find all tangents of a given slope *)
Manipulate[
 With[{sols = Solve[(* Solve or NSolve *)
     {f[x, y] == 0, slope == ImplicitD[f[x, y] == 0, y, x], 
      boundsIneqs},
     {x, y}]},
  Show[curvePlot,
   Graphics[{
     Replace[sols, sol_ :> InfiniteLine[{x, y} /. sol, {1, slope}], 1]
     }],
   PlotRange -> Max@Abs@boundsArray
   ]
  ],
 {{slope, 0}, -5, 5, 1/128}]

Here is an more involved example demonstrating that the parallel tangents can be found using numeric equation solving function:

f[x_, y_] := x^2 + x*Sin[4*y] + 3 y^2 - 7 + Cos[3*x];
pt = With[{x = RandomReal[{-2, 2}]}, {x, y /. FindRoot[f[x, y] == 0, {y, 1}]}];
slope = ImplicitD[f[x, y] == 0, y, x];
m = slope /. Thread[{x, y} -> pt];
pt2 = {x, y} /. FindRoot[{f[x, y] == 0, slope == m}, {x, -2}, {y, -1}];
m2 = slope /. Thread[{x, y} -> pt2];
ContourPlot[f[x,y]==0,{x,-4,4},{y,-4,4},Epilog->{InfiniteLine[pt,{1,m}],
    InfiniteLine[pt2,{1,m2}],
    {PointSize[0.02],Point[pt]},
    {PointSize[0.02],Point[pt2]}
}]

Thank you for the nice question! Here is the code for generating the plot shown on the book cover:

RemoveBackground[
 Rasterize[
  Plot3D[{Re[Sqrt[1/(Cos[5 x] Sin[5 y] - 1/2)]], 
    Im[Sqrt[1/(Cos[5 x] Sin[5 y] - 1/2)]], 
    Style[.01, White, Lighting -> {{"Ambient", White}}]}, {x, -1/3, 
    1.33}, {y, -1/3, 1.6}, Axes -> False, Boxed -> False, 
   BoundaryStyle -> None, Exclusions -> All, Mesh -> None, 
   PlotPoints -> 35, PlotRange -> {Automatic, Automatic, {0, 4}}, 
   ViewPoint -> {1.75, 2.25, 1.85}]]]

Looking forward to this Daily Study Group with great instructors and an energetic group of learners! See everyone online on Monday, 11am CT. Preview the daily schedule of topics and sign up here.