11
$\begingroup$

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}]

an ellipse

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

envelope

In addition, I noticed that

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

enter image description here


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.

enter image description here

$\endgroup$
4
  • 3
    $\begingroup$ 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. $\endgroup$ May 16, 2015 at 6:41
  • $\begingroup$ @Guesswhoitis. Thanks for your reference:-) $\endgroup$
    – xyz
    May 16, 2015 at 13:59
  • $\begingroup$ @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. $\endgroup$
    – bbgodfrey
    May 16, 2015 at 14:37
  • $\begingroup$ @bbgodfrey, true; that makes computing an explicit representation of the envelope harder. $\endgroup$ May 16, 2015 at 14:43

3 Answers 3

13
$\begingroup$

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

enter image description here

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

enter image description here

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}}]

enter image description here

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]

enter image description here

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.

$\endgroup$
1
  • $\begingroup$ 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) $\endgroup$
    – MarcoB
    May 16, 2015 at 22:11
6
$\begingroup$

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[Θ]}
     ][[1]] // Simplify

enter image description here

(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

enter image description here

$\endgroup$
5
  • $\begingroup$ Kuba, elegant solution. Well done. Do you understand why using DiscretizeRegion[#]] & // RegionBoundary decreases running time by orders of magnitude, compared to RegionBoundary // RegionPlot? $\endgroup$
    – bbgodfrey
    May 17, 2015 at 0:42
  • $\begingroup$ Shutao Tang, although I cannot speak for Kuba, I would note that DiscretizeRegion is new to Mathematica 10. $\endgroup$
    – bbgodfrey
    May 17, 2015 at 0:44
  • $\begingroup$ @bbgodfrey I don't know, I'm not so much experienced in Regions. :/ $\endgroup$
    – Kuba
    May 17, 2015 at 6:45
  • $\begingroup$ @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 :/ $\endgroup$
    – Kuba
    May 17, 2015 at 6:47
  • $\begingroup$ @Kuba, Thanks very much sincerely:-) $\endgroup$
    – xyz
    May 17, 2015 at 6:51
4
$\begingroup$

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}]]

enter image description here

t = TransformedRegion[s, TranslationTransform[{2.5, 3}]];
RegionBoundary@
  RegionUnion[
   Table[TransformedRegion[t, RotationTransform[beta]], {beta, 0, Pi, 1}]]

enter image description here

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.