10
$\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$
  • 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$ – J. M. will be back soon May 16 '15 at 6:41
  • $\begingroup$ @Guesswhoitis. Thanks for your reference:-) $\endgroup$ – xyz May 16 '15 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 '15 at 14:37
  • $\begingroup$ @bbgodfrey, true; that makes computing an explicit representation of the envelope harder. $\endgroup$ – J. M. will be back soon May 16 '15 at 14:43
12
$\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$
  • $\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 '15 at 22:11
5
$\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$
  • $\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 '15 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 '15 at 0:44
  • $\begingroup$ @bbgodfrey I don't know, I'm not so much experienced in Regions. :/ $\endgroup$ – Kuba May 17 '15 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 '15 at 6:47
  • $\begingroup$ @Kuba, Thanks very much sincerely:-) $\endgroup$ – xyz May 17 '15 at 6:51
3
$\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.