# The envelope of a set of translated and rotated ellipses

I achieve a dynamic graphics by using Manipulate as follows:

Manipulate[
ParametricPlot[
RotationMatrix[β].{a + c Cos[Θ], b + d Sin[Θ]}, {Θ, 0, 2 π},
PlotRange -> {{-15, 15}, {-15, 15}}],
{{a, 1}, 0, 5, 1, Appearance -> "Labeled"},
{b, 0, 6, 1}, {c, 1, 5, 1},
{d, 2, 6, 1}, {β, 0, π, 1}] To see the dynamic region, I do the following operation:

Table[
ParametricPlot[
RotationMatrix[β].{a + c Cos[Θ], b + d Sin[Θ]}, {Θ, 0, 2 π},
PlotRange -> {{-15, 15}, {-15, 15}}],
{a, 0, 5, 1},
{b, 0, 6, 1}, {c, 1, 5, 1},
{d, 2, 6, 1}, {β, 0, π, 1}]// Flatten // Show ParametricPlot[
r^2 { Sqrt[t] Cos[t], Sin[t]}, {t, 0, 3 π/2}, {r, 1, 2}]


can give a region of a dynamic graphic. However, it cannot work when the parameters exceed 2 ### Question

Is it possible to achieve the envelope line of a set of dynamic graphs ? It is my first time to think out this question and I have no idea. • You have an envelope of parametrically-defined curves; as noted here or here (en Français, sorry), you can derive the envelope's parametric equations by eliminating the free parameter from the parametric equations and the determinant of its partial derivatives. May 16, 2015 at 6:41
• @Guesswhoitis. Thanks for your reference:-)
– xyz
May 16, 2015 at 13:59
• @Guesswhoitis. The problem, as I see it, is that the free parameters are discrete. If they were continuous, the bounding curve would be simply a circle. May 16, 2015 at 14:37
• @bbgodfrey, true; that makes computing an explicit representation of the envelope harder. May 16, 2015 at 14:43

This problem can be simplified substantially by noting that only the largest ellipses contribute to the boundary of the second figure in the question. So, for instance,

Table[ParametricPlot[RotationMatrix[β].{a + 5 Cos[Θ], b + 6 Sin[Θ]}, {Θ, 0, 2 Pi},
PlotRange -> {{-15, 15}, {-15, 15}}], {a, 0, 5, 1}, {b, 1, 6, 1}, {β, 0, Pi, 1}]
// Flatten // Show Furthermore, this plot is seen to be the composite of four objects,

Table[ParametricPlot[{a + 5 Cos[Θ], b + 6 Sin[Θ]}, {Θ, 0, 2 Pi},
PlotRange -> {{-15, 15}, {-15, 15}}], {a, -2.5, 2.5, 1}, {b, -2.5, 2.5, 1}]
// Flatten // Show each one displaced by the average values of a and b, {2.5, 3.0} in this case, and rotated by the four values of β.

Continuation

The region corresponding to the previous plot is approximately (exactly in the limit of continuous a and b) is

r = RegionUnion[Flatten[{
Table[Ellipsoid[{a, b}, {5, 6}], {a, -2.5, 2.5, 5}, {b, -2.5, 2.5, 5}],
Rectangle[{-2.5, -8.5}, {2.5, 8.5}], Rectangle[{-7.5, -2.5}, {7.5, 2.5}]}]];
RegionPlot[r, PlotRange -> {{-15, 15}, {-15, 15}}] This region then is translated by {2.5, 3.0} and rotated by β.

t = TransformedRegion[r, TranslationTransform[{2.5, 3}]];
s = RegionUnion[Table[TransformedRegion[t, RotationTransform[β]], {β, 0, Pi, 1}]];


The boundary of s is the desired surface.

u = RegionBoundary[s];
RegionPlot[u, PlotRange -> {{-15, 15}, {-15, 15}}]
DeleteCases[%, Line[{_, _}] | Point[__], Infinity] The last line of code eliminates most spurious points and point-like lines that mysteriously (to me) otherwise appear.

Warning: Trying to plot s itself promptly devoured all the memory on my PC.

• This is very elegant. I had been thinking about this problem since the question came out, but I had gotten nowhere. Thanks for putting me out of my misery! (+1) May 16, 2015 at 22:11

The general idea is the same as bbgodfrey's so most credits for him, the approach is slightly different, perhaps more automatic.

We start by converting OP's parametric expression to cartesian:

eq = #.# &@{Cos[Θ], Sin[Θ]} /. Solve[
Thread[{x, y} == RotationMatrix[β].{a + c Cos[Θ], b + d Sin[Θ]}],
{Cos[Θ], Sin[Θ]}
][] // Simplify (regions = Table[
ImplicitRegion[eq <= 1, {x, y}],
{a, 0, 5, 1}, {b, 0, 6, 1}, {c, 5, 5, 1}, {d, 6, 6, 1}, {β, 0, π, 1}
] // Flatten // N);
(*only the biggest c and d as noticed by bbdogfrey*)

RegionUnion[regions] // DiscretizeRegion[#, AccuracyGoal -> 3] & //
RegionBoundary // AbsoluteTiming • Kuba, elegant solution. Well done. Do you understand why using DiscretizeRegion[#]] & // RegionBoundary  decreases running time by orders of magnitude, compared to RegionBoundary // RegionPlot? May 17, 2015 at 0:42
• Shutao Tang, although I cannot speak for Kuba, I would note that DiscretizeRegion is new to Mathematica 10. May 17, 2015 at 0:44
• @bbgodfrey I don't know, I'm not so much experienced in Regions. :/
– Kuba
May 17, 2015 at 6:45
• @ShutaoTang Yes, this is V10 solution. You could try to mimic this. Plot filled ellipses, extract polygons, find here a function to merge polygons (it is somewhere, I don't know where). Fold this operation on a list of ellipses and you have a solution. Probably, haven;t tested it and don't have time :/
– Kuba
May 17, 2015 at 6:47
• @Kuba, Thanks very much sincerely:-)
– xyz
May 17, 2015 at 6:51

Here is an approach came from this answer and bbgodfrey's answer. In addition, it is very fast.

s =
DiscretizeGraphics@
Graphics[Polygon /@
Table[Table[{a + 5 Cos[theta], b + 6 Sin[theta]},
{theta, 0, 2 Pi, 0.02 Pi}], {a, -2.5, 2.5, 1}, {b, -2.5, 2.5, 1}]] t = TransformedRegion[s, TranslationTransform[{2.5, 3}]];
RegionBoundary@
RegionUnion[
Table[TransformedRegion[t, RotationTransform[beta]], {beta, 0, Pi, 1}]]  