How to find a tangent line with 2 points of tangency for a curve? – mathematica.stackexchange.com #JHedzWorlD

Say I have a function like this:

f[x_] := 4 x^4 - 9 x^3 - x^2 + 10; Plot[f[x], x, -1, 2] 

It’s obvious that there’s a tangent line with 2 points of tangency here:

The problem is, how can I find this line programmatically for any such curve given?

We are looking for two distinct values of $x$ for which a generic line and your function have 1) the same $y$ value (i.e. the line touches the curve) and 2) the same derivative (i.e. the line is tangent to the curve).

We can set up the following system of equations spelling out these conditions:

y[x_] := a x + b (* a generic line *) f[x_] := 4 x^4 - 9 x^3 - x^2 + 10; (* your function *) sol = List@ToRules@Reduce[ y[x1] == f[x1], y'[x1] == f'[x1], y[x2] == f[x2], y'[x2] == f'[x2], x2 != x1, x1, x2 ] 

Notice that Solve wouldn’t work here, because there are no general solutions valid for all values of the parameters (indeed, Solve will return the empty set). Reduce will generate conditions valid for some values of the parameters $a$ and $b$, which is what we are looking for. Reduce returns equations as results, but I converted those to substitution rules for plotting.

Plot[ f[x], y[x] /. sol, x, -1, 2, Epilog -> PointSize[0.015], Point[x1, f[x1], x2, f[x2]] //. sol ] 

---

We can package this in a function:

Clear[doubleTangent] doubleTangent[f_, range_ /; VectorQ[range, NumericQ] && Dimensions[range] == 2] := Module[ x1, x2, a, b, y, sol, y[x_] := a x + b; sol = Solve[ f[x1] == y[x1], f[x2] == y[x2], f'[x1] == y'[x1], f'[x2] == y'[x2], x1 != x2, x1, x2, a, b, Reals ]; Plot[ f[x], y[x] /. sol, Evaluate@Flatten@x, range, PlotLegends -> "function", "tangent", Epilog -> ReplaceRepeated[ PointSize[0.02], Tooltip[Point[#, f[#]], Round[#, f[#], 0.01]] & /@ x1, x2 , N@sol ], Inset[ "a = " <> ToString[N[a /. First@sol]] <> "nb = " <> ToString[N[b /. First@sol]], Scaled[0.9, 0.9], Alignment -> Left ] ] ] 

This function will return the same result found above, with annotations, when used as follows:

doubleTangent[4 #^4 - 9 #^3 - #^2 + 10 &, -1, 2] 

Yet another case:

doubleTangent[3 #^4 - 12 #^2 + 5 # + 9 &, -3, 3] 

The tangent line at $x = a$ is given by $f(a)+f'(a)(x-a)$. So we can define:

tangent[a_, x_] := f[a] + f'[a] (x - a) slope[a_] = Coefficient[tangent[a, x], x] intercept[a_] = Coefficient[tangent[a, x], x, 0] 

Then we want to find two distinct points $a$ and $b$ which have the same tangent line:

sln = Simplify@Solve[slope[a] == slope[b], intercept[a] == intercept[b], b > a, a, b] 

a -> 1/16 (9 - 5 Sqrt[11]), b -> 1/16 (9 + 5 Sqrt[11])

There is one solution.

Plot[f[x], tangent[a, x] /. sln, x, -1, 2] 

f2 = D[f[x], x] x1 /. NSolve[(f2 /. x -> x1) == (f2 /. x -> x2), (f[x2] - f[x1])/(x2 - x1) == (f2 /. x -> x1), x1, x2][[1]] x2 /. NSolve[(f2 /. x -> x1) == (f2 /. x -> x2), (f[x2] - f[x1])/(x2 - x1) == (f2 /. x -> x1), x1, x2][[1]] 

which for your definition of f[x] results in x1=-0.473945 and x2=1.59895 PS: Note that

NSolve[(f2 /. x -> x1) == (f2 /. x -> x2), (f[x2] - f[x1])/(x2 - x1) == (f2 /. x -> x1), x1, x2] 

gives alternative coordinates:

x1 -> -0.473945, x2 -> 1.59895, x1 -> 1.59895, x2 -> -0.473945 

An interesting alternative—and nice in that it is the shortest and almost the most automated so far—but one that I’m not entirely sure I understand, for reasons to be given along the way:

f[x_] := 4 x^4 - 9 x^3 - x^2 + 10; expr = Series[f[x], x, a, 1] // Normal; sols = DeleteDuplicates@SolveAlways[expr == (expr /. a -> b), x]; Plot[f[x], expr /. #, x, -1, 2] & /@ Thread[a -> (a /. sols)] 

You can see that a couple of the solutions match the one we’re looking for, most of the rest seem to match inflection points (not verified), and the last is the trivial solution a -> b.

Here is another example, taken from MarcoB‘s solution:

f[x_] = 3 x^4 - 12 x^2 + 5 x + 9; expr = Series[f[x], x, a, 1] // Normal; sols = DeleteDuplicates@SolveAlways[expr == (expr /. a -> b), x]; Plot[f[x], expr /. #, x, -3, 3] & /@ Thread[a -> (a /. sols)] 

Again, it seems to work in that it finds the solution, but it finds others, too. I will think on this when I have the time.

JHedzWorlD

Related

How to find a tangent line with 2 points of tangency for a curve? – mathematica.stackexchange.com #JHedzWorlD