# How to draw the trajectory of the circumscribed rectangle of an ellipse and determine the area range of the rectangle?

The equation for a known ellipse is:

x^2/4 + y^2/3 == 1


The circumscribed rectangle of an ellipse, where the lines on all four sides of the rectangle are tangent to the ellipse. Draw a trajectory diagram of the four vertices of the rectangle and determine the range of the area of the rectangle.

The images of rectangles and ellipses are as follows:

The circle where the four vertices of the circumscribed rectangle of an ellipse are located is the Monge Circle of the ellipse, as shown in the following figure：

That is to say, the drawn image of the ellipse is fixed to the image of the Monge Circle, but the four vertices of the outer tangent rectangle of the ellipse move on top of the Monge Circle and the rectangle also changes accordingly, and the area range of the rectangle is calculated.

Clear["Global*"];
f[x_,y_]=x^2/4+y^2/3-1;
g[x_,y_]=x^2+y^2-7;
con=ContourPlot[{f[x,y]==0,g[x,y]==0},{x,-5,5},{y,-5,5}];
pt={0,Sqrt[7]};


I tried to write it myself, manually calculating the Mongolian yen equation and drawing images of ellipses and circles, but I couldn't draw the moving point. I took a special point and didn't know how to draw the dynamic effect of the rectangle

The final effect is shown in the dynamic diagram below, where the rectangles in the diagram are dynamically changing. It's just that the image below lacks the Monge Circle image where the four vertices of the rectangle are located.

ClearAll[curve, circumRectangle]

curve[{r1_, r2_}][u_] := {r1, r2} {Cos@u, Sin@u};

circumRectangle[{r1_, r2_}, t_] :=
Module[{f = {r1, r2} {Cos @ #, Sin @ #} &},
Polygon @
Join[#, -#] & @
RegionIntersection[
Circle[{0, 0}, Sqrt[r1^2 + r2^2]],
InfiniteLine[{f[t], f[t] + f'[t]}]][[1]]];


Examples:

Manipulate[
Graphics[{Thick, PointSize[Large], Gray, Circle[{0, 0}, Sqrt[a^2 + b^2]],
Point @@ circumRectangle[{a, b}, t],
FaceForm[Opacity[.3, LightBlue]], EdgeForm[Blue], circumRectangle[{a, b}, t],
Red, Circle[{0, 0}, {a, b}] },
PlotRange -> 1.2 Sqrt[a^2 + b^2],
ImageSize -> 400,
PlotLabel -> Style[Row[{"area = ",
Pane[Round[Area@circumRectangle[{a, b}, t], .01],
Alignment -> Left, ImageSize -> {50, 20}]}], 16]],
{{a, 1}, 1/10, 5, Appearance -> "Labeled"},
{{b, 1}, 1/10, 5, Appearance -> "Labeled"},
{t, 0., 2 Pi, Pi/64, Appearance -> {"Labeled", "Open"}}]


The animation above produced using:

a = 2;
b = Sqrt[3];

frames = Table[Graphics[{Thick, PointSize[Large], Gray,
Circle[{0, 0}, Sqrt[a^2 + b^2]],
Point @@ circumRectangle[{a, b}, t],
FaceForm[Opacity[.3, LightBlue]], EdgeForm[Blue],
circumRectangle[{a, b}, t],
Red, Circle[{0, 0}, {a, b}] }, PlotRange -> 1.2 Sqrt[a^2 + b^2],
ImageSize -> 400,
PlotLabel -> Style[Row[{"area = ",
Pane[Round[Area@circumRectangle[{a, b}, t], .01],
Alignment -> Left, ImageSize -> {50, 20}]}], 16]],
{t, 0., 2 Pi, Pi/60}];

Export["mongeRectangle.gif", frames, DisplayAllSteps -> True]

• The radius of the Monge circle is Sqrt[a^2 + b^2].
• By the symmetric,one of the diogonal of the rectangle is pt and -pt. If we set the tangent points are p1 and p2, then all the line of the rectangle as below.
Clear["Global*"];
a = 2;
b = Sqrt[3];
r = Sqrt[a^2 + b^2];
f[x_, y_] = x^2/a^2 + y^2/b^2 - 1;
ani = Manipulate[Module[{pt, p1, p2, qt}, pt = r {Cos[t], Sin[t]};
{p1, p2} =
NSolveValues[{Grad[f[x, y], {x, y}] . ({X, Y} - {x, y}) == 0 /.
Thread[{X, Y} -> pt], f[x, y] == 0}, {x, y}, Reals];
qt = RegionIntersection[HalfLine[{pt, p1}],
HalfLine[{-pt, -p2}]][[1]];
Graphics[{{FaceForm[], EdgeForm[Orange],
Ellipsoid[{0, 0}, {a, b}]}, {FaceForm[], EdgeForm[Blue],
Polygon[{pt, qt, -pt, -qt}]}, {Dashed, Circle[{0, 0}, r]}},
PlotRange -> r]], {t, 0, 2 π}]


## Edit

• Another approach does not assume that we know the radius of the Monge circle.
• We use the idea of support line to draw the belt which contain the general region,that is ,we construct the functional {x, y} . normal where normal is the normal of the line and find its minimum and maximum.
Clear["Global*"];
a = 2;
b = Sqrt[3];
f[x_, y_] = x^2/a^2 + y^2/b^2 - 1;
belt[dir_] := Module[{normal, min, max},
normal = RotationTransform[π/2]@dir;
min = NMinimize[{x, y} . normal, f[x, y] == 0, {x, y}];
max = NMaximize[{x, y} . normal, f[x, y] == 0, {x, y}];
{InfiniteLine[{x, y} /. min[[2]], dir],
InfiniteLine[{x, y} /. max[[2]], dir]}]
fig[θ_] :=
Graphics[{FaceForm[], EdgeForm[Orange], Ellipsoid[{0, 0}, {a, b}],
belt@AngleVector@θ,
belt[RotationTransform[π/2]@AngleVector@θ]},
PlotRange -> 4]
ani=ListAnimate[Table[fig[θ], {θ, 0, 2 π, .1}]]


• For general region. And we can get parellgram if we change the π/2 to another angle.
Clear["Global*"];
reg = BoundaryDiscretizeRegion@
ParametricRegion[{{s^2 t^2,
s t^3}, -1 <= s <= 1 && -1 <= t <= 1}, {s, t}];
belt[dir_?VectorQ] :=
Module[{normal, min, max}, normal = RotationTransform[π/2]@dir;
min = NMinimize[{x, y} . normal, {x, y} ∈ reg, {x, y}];
max = NMaximize[{x, y} . normal, {x, y} ∈ reg, {x, y}];
{InfiniteLine[{x, y} /. min[[2]], dir],
InfiniteLine[{x, y} /. max[[2]], dir]}];
ani = Manipulate[
Module[{L1, L2, L3, L4, parallelogram}, {L1, L2} =
belt[AngleVector[θ]];
{L3, L4} = belt[RotationTransform[π/2]@AngleVector[θ]];
parallelogram =
Polygon@{RegionIntersection[L1, L3], RegionIntersection[L3, L2],
RegionIntersection[L2, L4], RegionIntersection[L4, L1]}[[;; ,
1]];
Labeled[
Graphics[{{Orange, reg}, {EdgeForm[Blue], FaceForm[],
parallelogram}}, PlotRange -> {{-1.5, 2.}, {-1.5, 2.}}],
Framed@Area@parallelogram]], {θ, 0, 2 π}]


• How can I get gif file? Oct 8, 2023 at 13:56
• @minhthien_2016 Export["test.gif", ani, "ControlAppearance" -> None] // SystemOpen Oct 8, 2023 at 13:59
• Thank you very much. I get it. Oct 8, 2023 at 14:02
• Can we calculate the area of each position of the rectangle? Oct 9, 2023 at 3:28