3
$\begingroup$

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:

enter image description here

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:

enter image description here

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]};
sols=SolveValues[{Grad[f[x,y],{x,y}] . ({X,Y}-{x,y})==0/. Thread[{X,Y}->pt],f[x,y]==0},{x,y},Reals]
Graphics[{InfiniteLine[{#,pt}]&/@sols,Red,AbsolutePointSize[5],Point[sols],Point[pt],con//First},Axes->True,AxesStyle->Arrowheads[{0.0,0.04}],AxesLabel->{x,y}]

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

enter image description here

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.

enter image description here

$\endgroup$
0

2 Answers 2

4
$\begingroup$

enter image description here


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

enter image description here

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]
$\endgroup$
8
$\begingroup$
  • 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. enter image description here
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 π}]

enter image description here

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

enter image description here

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

enter image description here

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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