1
$\begingroup$

My goal is to draw a family (for different distances) of 3-ellipse for equilateral set of foci.

3-ellipse definition is:

"the locus of points so that sum of the distances to the three foci is constant"

Eventually I want to generalize this to k-ellipse.

Thanks for your help I am bloked.

Improve this question
$\endgroup$
3
  • $\begingroup$ You know that a regular 2D ellipse is the locus of points so that sum of the distances to the foci is constant. Can you solve this problem in 2D? If so, you would be in a better position to solve it in 3D (or higher). $\endgroup$
    – bill s
    Commented Mar 4, 2014 at 4:19
  • $\begingroup$ Sorry for my english and thanks for the help! $\endgroup$
    – rapasite
    Commented Mar 4, 2014 at 10:58
  • $\begingroup$ Please consider registering your account $\endgroup$
    – Dr. belisarius
    Commented Mar 5, 2014 at 7:03

3 Answers 3

Reset to default
5
$\begingroup$ 
a = 10;
r = RandomInteger[{0, a}, {3, 2}];
ContourPlot[Tr[EuclideanDistance[#, {x, y}] & /@ r],
 Evaluate[{x, # - a, # + a} &@Mean[r[[All, 1]]]],
 Evaluate[{y, # - a, # + a} &@Mean[r[[All, 2]]]],
 Epilog -> {Red, PointSize[Large], Point@r}
 ]

Mathematica graphics

Dynamically add foci:

a = 10;
r = RandomInteger[{0, a}, {3, 2}];
Manipulate[
 ContourPlot[Tr[EuclideanDistance[#, {x, y}] & /@ u],
  Evaluate[{x, # - a, # + a} &@Mean[r[[All, 1]]]],
  Evaluate[{y, # - a, # + a} &@Mean[r[[All, 2]]]],
  Epilog -> {Red, PointSize[Large], Point@u}],
 {{u, r}, Locator, LocatorAutoCreate -> True}]

Mathematica graphics

Edit

Answering your comment about drawing the intersection of a k-ellipse cone and a Sphere:

pol[n_] := Array[{Cos[#], Sin[#]} &, n + 1, {0., 2 Pi}] // Chop
r = Join[#, {z}] & /@ (z Most@pol[3]);
p = ContourPlot3D[Tr[EuclideanDistance[#, {x, y, z}] & /@ r], 
                 {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
                 Contours -> {4}, 
                 MeshFunctions -> (EuclideanDistance[{#1, #2, #3}, {0, 0, 1}] &), 
                 Mesh -> {{1}}]

Mathematica graphics

Show[p, Graphics3D[{Opacity[.5], Yellow, Specularity[White, 10], 
                   Sphere[{0, 0, 1}, 1]}]]

Mathematica graphics

p1 = ContourPlot3D[Tr[EuclideanDistance[#, {x, y, z}] & /@ r], 
                   {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, 
                   Contours -> {4}, 
                   MeshFunctions -> (EuclideanDistance[{#1, #2, #3}, {0, 0, 1}] &), 
                   Mesh -> {{1}}, ContourStyle -> None];
Graphics3D@Cases[p1, GraphicsComplex[__]]

Mathematica graphics

Improve this answer
$\endgroup$
3
  • $\begingroup$ Have you any refference to k-ellipse cone? What you've shown is what was my understanding of this but is this really it? $\endgroup$
    – Kuba
    Commented Mar 4, 2014 at 22:55
  • $\begingroup$ @Kuba I thought it was you who found it. But no, and I'm not very inclined to search for it :) $\endgroup$
    – Dr. belisarius
    Commented Mar 4, 2014 at 22:57
  • $\begingroup$ ok, so we have to wait for OP's confirmation :) $\endgroup$
    – Kuba
    Commented Mar 4, 2014 at 23:07
4
$\begingroup$

Basing on belisarius code:

pol[n_] := Array[{Cos[#], Sin[#]} &, n + 1, {0., 2 Pi}] // Chop

Manipulate[
 ContourPlot[Tr[EuclideanDistance[#, {x, y}] & /@ Most@pol[n]]
             , {x, -1.3, 1.3}, {y, -1.3, 1.3}, 
               Epilog -> {[email protected], White, Point@pol[n]}, Contours -> 15]
 , {n, 2, 10, 1}]

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ This is exacly what I need! This is art! I need now to create a 3-ellipse cone and look the interserction with the sphere, idealy i need the equation of the curve ;) $\endgroup$
    – rapasite
    Commented Mar 4, 2014 at 10:52
  • $\begingroup$ +1 I had no idea that the k-ellipse was a real name $\endgroup$
    – Dr. belisarius
    Commented Mar 4, 2014 at 11:30
  • $\begingroup$ @belisarius is it? :p I didn't know till now but at the time of posting I was not aware of it :) $\endgroup$
    – Kuba
    Commented Mar 4, 2014 at 11:46
  • $\begingroup$ @rapasite I think you should ask a separate question about this. Also, focus on explaining what do you mean by 3-ellipse cone. $\endgroup$
    – Kuba
    Commented Mar 4, 2014 at 11:48
3
$\begingroup$ 
F[a_, b_] := Sqrt[(a - b).(a - b)]
Manipulate[
 Show[
  ContourPlot[ Total[F[{x, y}, #] & /@ {a, b, c}] == d, {x, -5, 5}, {y, -5, 5}], 
  Graphics[{Red, Disk[a, 0.1], Green, Disk[b, 0.1], Blue, Disk[c, 0.1]}]
     ],
  {{a, {-3, -3}}, {-5, -5}, {5, 5}}, 
  {{b, {2, 0}}, {-5, -5}, {5, 5}},
  {{c, {0, 3}}, {-5, -5}, {5, 5}}, 
  {{d, 10}, 0, 50}, ControlPlacement -> Right]

enter image description here

Improve this answer
$\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.