Plot envelope of a given curve

I am using the derivation of the parametric derivative according to which, if your function is $(x(t),y(t))$, then the derivative $dy/dx$ that we need to express the tangent line is $\frac{dy}{dt}/\frac{dx}{dt}$. Here is an example for the circle:

ClearAll[parametricExpr, deriv]
parametricExpr[t_] := {Cos[t], Sin[t]}
deriv[t_] := (Divide @@ Reverse@ D[parametricExpr[t0], t0]) /. t0 -> t

Graphics@
 Table[
   InfiniteLine[parametricExpr[t], {1, deriv[t]}],
   {t, 0.0001, 2 Pi, Pi/20}
 ]

envelope lines

Above I have also used the example in the documentation of InfiniteLine to convert the "point slope" form of a line to an InfiniteLine.

Here is a different parametric function:

Clear[parametricExpr]
parametricExpr[t_] := {Cos[t], Sin[t] + Cos[t]}

And the function and envelope plotted together:

Show[
  Graphics[{
    Table[
      InfiniteLine[parametricExpr[t], {1, deriv[t]}],
      {t, 0.0001, 2 Pi, Pi/50}
    ]},
    PlotRange -> All, Frame -> True, AspectRatio -> Automatic
  ],
  ParametricPlot[
    parametricExpr[t], {t, 0, 2 Pi},
    PlotStyle -> Directive[Thickness[Scaled[0.015]], Red]
  ]
]

function and envelope together


Marco's solution is correct, but does a little more work than necessary. For InfiniteLine[], all that matters for its second argument is the direction, so

InfiniteLine[{f[t], g[t]}, {1, g'[t]/f'[t]}]

is entirely equivalent to

InfiniteLine[{f[t], g[t]}, {f'[t], g'[t]}]

(As another way to put it: InfiniteLine[{h, k}, {1, Tan[φ]}] and InfiniteLine[{h, k}, {Cos[φ], Sin[φ]}] refer to the same line.)

RegionEqual[InfiniteLine[{f[t], g[t]}, {1, g'[t]/f'[t]}], 
            InfiniteLine[{f[t], g[t]}, {f'[t], g'[t]}]]
   True

Using Marco's second example:

ellipse[t_] := {Cos[t], Sin[t] + Cos[t]}

With[{n = 30}, (* number of lines *)
     Graphics[{Directive[AbsoluteThickness[0.5], Opacity[0.6, Black]], 
               Table[InfiniteLine[ellipse[t], ellipse'[t]], {t, 0, 2 π, 2 π/(n - 1)}]}]]

ellipse tangents

As a bonus, it is easy to modify the code above to generate normals instead of tangents:

With[{n = 55}, 
     p1 = Graphics[{Directive[AbsoluteThickness[0.5], Opacity[0.6, Black]], 
                    Table[InfiniteLine[ellipse[t], Cross[ellipse'[t]]],
                     {t, 0, 2 π, 2 π/(n - 1)}]}, PlotRange -> 3]]

ellipse normals

The envelope of these normals is the evolute of the curve, which can be plotted like so:

p2 = ParametricPlot[ellipse[t] + ((#2[[2]]/#1[[1]]) & @@ 
                    FrenetSerretSystem[ellipse[t], t]), {t, 0, 2 π},
                    Evaluated -> True, PlotStyle -> AbsoluteThickness[4]]

evolute

Show[p2, p1]

evolute and normals

Tags:

Plotting

Recent Posts