7
$\begingroup$

The smaller ellipse is contained within the larger one. ellipses

By 'minimum distance', I mean the distance that minimises;

Sqrt[(y1 - y2)^2 + (x1 - x2)^2]

By maximum, I mean the distance that maximises this, with the constraint that it must be colinear with the center of the smaller ellipse. I've given a rough drawing of these in green and purple, respectively;

estimated min/max

For finding the minimum, I attempted using NMinimize

NMinimize[{Sqrt[(y1 - y2)^2 + (x1 - x2)^2], G[x1, y1, X1, Y1, major1, minor1] == 1 && G[x2, y2, X1, Y1, major1, minor1] == 1}, {x1, x2, y1, y2}]

but it did not like my constraints. G is the equation of an ellipse;

G[x_, y, X_, Y_, major_, minor_] = ((x - X)/major)^2 + ((y - Y)/minor)^2

where the parameters for these ellipses are;

X1 = 200; Y1 = 110; major1 = 10; minor1 = 8;
X2 = 210; Y2 = 100; major2 = 25; minor2 = 30;

I also attempted using NSolve with a system of equations, but couldn't get that to work either.

Here's the full code I have;

X1 = 200; Y1 = 110; major1 = 10; minor1 = 8;    
X2 = 210; Y2 = 100; major2 = 25; minor2 = 30;
G[x_, y, X_, Y_, major_, 
   minor_] = ((x - X)/major)^2 + ((y - Y)/minor)^2;
G1 = G[x, y, X1, Y1, major1, minor1];
G2 = G[x, y, X2, Y2, major2, minor2];

e1 = Plot[y /. Solve[G1 == 1], {x, 170, 250}, PlotStyle -> Blue];
e2 = Plot[y /. Solve[G2 == 1], {x, 170, 250}, PlotStyle -> Red];
Show[e1, e2, PlotRange -> Automatic, AspectRatio -> 1]
NMinimize[{Sqrt[(y1 - y2)^2 + (x1 - x2)^2], 
  G[x1, y1, X1, Y1, major1, minor1] == 1 && 
   G[x2, y2, X1, Y1, major1, minor1] == 1}, {x1, x2, y1, y2}]

EDIT

As Syed pointed out, there was a typo in the original code (y->y_), as well as the major/minor axes being incorrectly specified in the final line. Now it works fine with NMinimize. In case anyone is looking at this in the future, here is the updated code;

X1 = 200; Y1 = 110; major1 = 10; minor1 = 8;
X2 = 210; Y2 = 100; major2 = 25; minor2 = 30;
G[x_, y_, X_, Y_, major_, 
   minor_] := ((x - X)/major)^2 + ((y - Y)/minor)^2;
G1 = G[x, y, X1, Y1, major1, minor1];
G2 = G[x, y, X2, Y2, major2, minor2];
NMinimize[{Sqrt[(y1 - y2)^2 + (x1 - x2)^2], G[x1, y1, X1, Y1, major1, minor1] == 1 && G[x2, y2, X2, Y2, major2, minor2] == 1}, {x1, x2, y1, y2}]
NMaximize[{Sqrt[(y1 - y2)^2 + (x1 - x2)^2], G[x1, y1, X1, Y1, major1, minor1] == 1 && G[x2, y2, X2, Y2, major2, minor2] == 1 && (y2 - y1)/(x2 - x1) == (y2 - Y1)/(x2 - X1) && (y1 - Y1)*(y2 - Y1) >= 0 && Abs[y1 - y2] > 0.1}, {x1, x2, y1, y2}]

The Abs[y1 - y2] > 0.1 is a hacky workaround to ensure the maximum length is not passing through the inner ellipse.

The final results;
minimum

maximum

$\endgroup$
4
  • 2
    $\begingroup$ How about using this definition: G[x_, y_, X_, Y_, major_, minor_] := ((x - X)/major)^2 + ((y - Y)/minor)^2; ? $\endgroup$
    – Syed
    Dec 14, 2022 at 16:51
  • $\begingroup$ I would use one of the two answers in 228499 $\endgroup$
    – rhermans
    Dec 14, 2022 at 17:06
  • 1
    $\begingroup$ @Syed This fixed my issues with using NMinimize, and I've now got it working, thanks a million. My last line also used the wrong major/minor axes. $\endgroup$
    – Joe.S
    Dec 17, 2022 at 1:30
  • $\begingroup$ @rhermans I wouldn't know how to apply those to the maximum constraint. $\endgroup$
    – Joe.S
    Dec 17, 2022 at 1:30

4 Answers 4

10
$\begingroup$

modified

Try RegionDistance

elli1 = ImplicitRegion[((x - 200)/10)^2 + ((y - 110)/8)^2 == 1, {x, y}]
elli2 = ImplicitRegion[((x - 210)/25)^2 + ((y - 100)/30)^2 == 1, {x,y}]

mini1 = NMinimize[{RegionDistance[elli1, {x, y}],Element[{x, y}, elli2]}, {x,y}]
mini2 = NMinimize[{RegionDistance[elli2, {x, y}],Element[{x, y}, elli1 ]},{x,y}]

For the maximum constraint we have to define a line through the centroid of elli1:

rc1 = RegionCentroid[elli1]
p2 = rc1 + ({x1, y1} - rc1) t1 

maxi = NMaximize[{(p2 - {x1, y1}) . (p2 - {x1, y1}), p2 == {x2, y2}, 
t1 > 1, Element[{x1, y1}, elli1], Element[p2, elli2]}, {t1, x1, y1,x2, y2}]

Show[Map[Region, {elli1, elli2}], 
Graphics[{Blue, Point[rc1], Point[{{x1, y1}, {x2, y2}} /. maxi[[2]]],Red, Point[{{x, y} /. mini1[[2]], {x, y} /. mini2[[2]]}]}   ]] 

enter image description here

$\endgroup$
7
  • 2
    $\begingroup$ Note "maximum ... with the constraint that it must be colinear with the center of the smaller ellipse" $\endgroup$
    – Bob Hanlon
    Dec 14, 2022 at 18:06
  • 2
    $\begingroup$ @BobHanlon Thanks for your hint, I'll modify my answer $\endgroup$ Dec 15, 2022 at 8:40
  • $\begingroup$ You might not need the ImplicitRegion's . You could use Circle[{x,y},{r1,r2}] and be even more concise. $\endgroup$
    – flinty
    Dec 16, 2022 at 12:45
  • $\begingroup$ ^ though I couldn't get this to work directly myself, I needed to create a function first e.g rdf1=RegionDistanceFunction[elli1] instead. $\endgroup$
    – flinty
    Dec 16, 2022 at 13:02
  • $\begingroup$ This looks promising, although I think the definition for t1 is missing from your answer? As a result I wasn't able to run your code for finding the maximum distance. $\endgroup$
    – Joe.S
    Dec 17, 2022 at 1:31
6
$\begingroup$

There is an analytic solution for the minimum of your particular ellipses though it's complicated and you're better off with the numerical methods given already, but here's my working:

Start with the parametric form of an axis oriented ellipse where $\mathbf{s}$ gives the sizes and $\mathbf{c}$ is the center: $$ f(t,\mathbf{s},\mathbf{c})=\left( \begin{array}{ccc} \cos (t) & 0 & c_x \\ 0 & \sin (t) & c_y \\ \end{array} \right)\left( \begin{array}{c} s_x \\ s_y \\ 1 \\ \end{array} \right),\ 0\le t < 2\pi $$ Let the points on the two ellipses be $\mathbf{p}_1=f(t,\mathbf{s}_1,\mathbf{c}_1)$ and $\mathbf{p}_2=f(u,\mathbf{s}_2,\mathbf{c}_2)$ where $t,u \in [0,2\pi)$

The points $\mathbf{c}_1, \mathbf{p}_1, \mathbf{p}_2$ are collinear when

$$ \begin{vmatrix}c_{1x}&p_{1x}&p_{2x}\\c_{1y}&p_{1y}&p_{2y}\\1&1&1\end{vmatrix}=0 $$ ... and we use this to solve for $u$ in terms of $t$ to get $u(t)$. Then we can ask Mathematica to find: $$ t_{\mathrm{min}}=\underset{t}{\mathrm{argmin}}(\Vert\mathbf{p}_2(u(t)) - \mathbf{p}_1(t)\Vert^2) $$ ... which we can use to recover the closest point and min distance. Amazingly it's able to get a symbolic answer, with numerical value about 2.78369.

tmin = 2*ArcTan[Root[640625 + 25000*#1 + 3606250*#1^2 + 9813000*#1^3 + 1938525*#1^4 + 40985280*#1^5 + 34798616*#1^6 + 52344160*#1^7 + 64502386*#1^8 + 30092880*#1^9 + 120859356*#1^10 - 30248400*#1^11 + 80481202*#1^12 - 44183680*#1^13 + 58650200*#1^14 - 38201760*#1^15 + 15191709*#1^16 - 16551480*#1^17 + 5615050*#1^18 - 4075000*#1^19 + 640625*#1^20 & , 4, 0]];

Here's the full program - I convert Abs->Identity and use the SquaredEuclideanDistance as this helps to simplify the expressions a little and doesn't seem to break anything:

Remove["Global`*"]

ellipse[t_, sizes_, center_] := sizes*{Cos[t], Sin[t]} + center
c1 = {200, 110};
c2 = {210, 100};
s1 = {10, 8};
s2 = {25, 30};
e1 = ellipse[t, s1, c1];
e2 = ellipse[u, s2, c2];

(* N.B this has multiple solutions, I choose the first one and remove the generated constant. *)
u1 = FullSimplify[
  First[SolveValues[
     Det[Append[Transpose[{c1, e1, e2}], {1, 1, 1}]] == 0, u] /. 
    C[_] :> 0]]

obj = SquaredEuclideanDistance[e1, ellipse[u1, s2, c2]];
obj = FullSimplify[obj /. Abs -> Identity]

(** (((41+9 Cos[2 t]) (31-36 Cos[t]+5 Cos[3 t] Sec[t]+20 Sin[t]+6 Sqrt[2] Sec[t] Sqrt[Cos[t]^2 (71+29 Cos[2 t]-10 Sin[2 t])])^2)/(2 (13+5 Cos[2 t])^2)) **)

min = Minimize[{obj, 0 <= t < 2 π}, t];
tmin = t /. Last[min]
(** {t->2 ArcTan[5.53…]} **)

N@min
(* {9.09213214869205`,{t->2.7836860115704467`}} *)

(* Check it agrees with NMinimize *)
NMinimize[{obj, 0 <= t < 2 π}, t]
(* {9.09213214869206`,{t->2.783686011570447`}} *)

p1 = ellipse[tmin, s1, c1];
p2 = ellipse[u1 /. t -> tmin, s2, c2];
ParametricPlot[{
  ellipse[t, s1, c1],
  ellipse[t, s2, c2]}, {t, 0, 2 π}, Epilog -> Line[{c1, p1, p2}]]

ellipses

$\endgroup$
1
  • $\begingroup$ Cool! Didn't realise there would be an analytical solution It's interesting that it's a good bit smaller than the minimum I was able to find with NMinimize $\endgroup$
    – Joe.S
    Dec 17, 2022 at 1:33
3
$\begingroup$

Here is a solution that minimizes the distance using "Minimize" with conditions.

E.g. for the 2 ellipse:

G[x_, y_, X_, Y_, major_, minor_] = ((x - X)/major)^2 + ((y - Y)/minor)^2;
e1 = G[x1, y1, -1, 1, 2, 1];
e2 = G[x2, y2, 2, 2, 1, 2];

The expression to minimize and the conditions to apply are:

eq = {Norm[{x1, y1} - {x2, y2}], e1 == 1, e2 == 1}

We can minimize this by:

res = Minimize[eq // N, {x1, y1, x2, y2}]
(*{0.11322, {x1 -> 0.986118, y1 -> 1.11762, x2 -> 1.09629, y2 -> 1.14372}} *)

A graphical representation is:

ContourPlot[{G[x, y, -1, 1, 2, 1] == 1, 
  G[x, y, 2, 2, 1, 2] == 1}, {x, -4, 4}, {y, -1, 4}, 
 Epilog -> {Red, Point[{{x1, y1}, {x2, y2}} /. res[[2]]]}]

enter image description here

$\endgroup$
2
  • $\begingroup$ This works great, I think it's pretty similar to what I was doing, but using Minimize followed by //N rather than NMinimize. I've added more details to the original question, including for using NMaximise to solve for the maximum distance $\endgroup$
    – Joe.S
    Dec 17, 2022 at 1:34
  • $\begingroup$ This works also with NMinimize and without "//N" $\endgroup$ Dec 17, 2022 at 10:55
3
$\begingroup$
  • We write the parametric equation of the outside ellipsoid by parametric s, that is pt2[s], and calculate the intersection points pt1[s] of the line {X1,Y1},pt2[s] and the inside ellipsoid.

  • Here we use Maximize and Minimize.

Clear["Global`*"];
X1 = 200; Y1 = 110; major1 = 10; minor1 = 8;
X2 = 210; Y2 = 100; major2 = 25; minor2 = 30;
pt2[s_] = ({X2, Y2} + {major2, minor2}*{Cos[s], Sin[s]});
sol = Solve[{{x, y} == (1 - t) {X1, Y1} + 
       t pt2@s, ((x - X1)/major1)^2 + ((y - Y1)/minor1)^2 == 1, 
     t > 0}, {t}, {x, y}, Reals][[1, 1]];
pt1[s_] = (1 - t) {X1, Y1} + t pt2@s /. sol;
maximum = 
  Maximize[{EuclideanDistance[pt1@s, pt2@s] // ComplexExpand, 
    0 <= s <= 2 π}, {s}];
minimum = 
  Minimize[{EuclideanDistance[pt1@s, pt2@s] // ComplexExpand, 
    0 <= s <= 2 π}, {s}];
max = maximum // N
min = minimum // N

enter image description here

Manipulate[
 Graphics[{EdgeForm[Blue], FaceForm[], 
   Ellipsoid[{X1, Y1}, {major1, minor1}], 
   Ellipsoid[{X2, Y2}, {major2, minor2}], 
   AbsolutePointSize[8], {Green, 
    Point[{pt1@min[[-1, 1, -1]], pt2@min[[-1, 1, -1]]}]}, {Red, 
    Point[{pt1@max[[-1, 1, -1]], pt2@max[[-1, 1, -1]]}]}, Brown, 
   Point[pt1@s], Point[pt2@s], Line[{pt1@s, pt2@s}], 
   Text[N@RegionMeasure[Line[{pt1@s, pt2@s}]], 
    Mean[{pt1@s, pt2@s}], {-1, -1}, pt2@s - pt1@s], Dashed, 
   Line[{{X1, Y1}, pt1@s}]}, PlotRangeClipping -> True], {s, 0, 
  2 π}]

enter image description here

$\endgroup$

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.