Mathematica creating an ellipse

Questions
,
1

Main function to create an ellipse:

a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g

How to add a condition in one function to the three equations:

\[CapitalDelta]=-c d^2 + 2 b d f - a f^2 - b^2 g + a c g
J=-b^2 + a c
I=a+c

conditions:

\[CapitalDelta]!=0
J>0
\[CapitalDelta]/I<0

And if we can do so that once the substitute number three equations? And maybe some random generator to the given numbers satisfy the above conditions.

\[CapitalDelta][a_, b_, c_, d_, f_, g_] := -c d^2 + 2 b d f - a f^2 - b^2 g + a c g
J[a_, b_, c_] := -b^2 + a c
i[a_, c_] := a + c
?[-2, 4, -6, 2, 1, 2]
2 
In[1]:= \[CapitalDelta] = -c d^2 + 2 b d f - a f^2 - b^2 g + a c g;
j = -b^2 + a c;
i = a + c;
solution = FindInstance[\[CapitalDelta] != 0 && j > 0 && \[CapitalDelta]/i < 0, {a, b, c, d, f, g}]

Out[4]= {{a -> 2, b -> -1, c -> 1, d -> 0, f -> 0, g -> -1}}

In[5]:= \[CapitalDelta] /. solution

Out[5]= {-1}

In[6]:= j /. solution

Out[6]= {1}

In[7]:= \[CapitalDelta]/i /. solution

Out[7]= {-(1/3)}

In[8]:= a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g /. solution

Out[8]= {-1 + 2 x^2 - 2 x y + y^2}
3

and how would I substitute numbers for a, b, c, d, f, g to the main function so that the plot came out of the ellipse

4 
In[1]:= \[CapitalDelta] = -c d^2 + 2 b d f - a f^2 - b^2 g + a c g;
j = -b^2 + a c;
i = a + c;
solution = FindInstance[\[CapitalDelta] != 0 && j > 0 && \[CapitalDelta]/i < 0, {a, b, c, d, f, g}][[1]];
ellipse = a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g /. solution;
Print["Ellipse is ",ellipse];
ContourPlot[ellipse == 0, {x, -2, 2}, {y, -2, 2}]

During evaluation of In[1]:= Ellipse is -1+2 x^2-2 x y+y^2

Out[6]= ...PlotImageRemoved...
5

and now how to add 5 random points lying on the ellipse then add more 5 points near points lying on the ellipse and use optimization with inequality constraints: the Kuhn-Tucker conditions

6 
In[1]:= \[CapitalDelta] = -c d^2 + 2 b d f - a f^2 - b^2 g + a c g;j = -b^2 + a c;i = a + c;
solution = FindInstance[\[CapitalDelta] != 0 && j > 0 && \[CapitalDelta]/i < 0, {a, b, c, d, f, g}][[1]];
ellipse = a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g /. solution;
points = Table[theta = RandomReal[{0, 2 Pi}];
   ksol = FindRoot[(ellipse /. {x -> k*Cos[theta], y -> k*Sin[theta]}) == 0, {k, 1.}];
   Point[{x, y}] /. {x -> k*Cos[theta], y -> k*Sin[theta]} /. ksol, {5}];
nearpoints = Table[theta = RandomReal[{0, 2 Pi}];dr = RandomReal[{.8, 1.2}];
   ksol = FindRoot[(ellipse /. {x -> k*Cos[theta], y -> k*Sin[theta]}) == 0, {k, 1.}];
   Point[{x, y}] /. {x -> dr*k*Cos[theta], y -> dr*k*Sin[theta]} /. ksol, {5}];
Show[ContourPlot[ellipse == 0, {x, -2, 2}, {y, -2, 2}], Graphics[points], Graphics[nearpoints]]

Out[8]= ...PlotRemoved...

Now you can begin studying how to use Mathematica to do your optimization problem.
You may also want to use a different model for determining the location of your "near points."
You may also want to write something other than FindInstance to select your "random" ellipse.
7

how to change location of “near points” that displacement was close to the basic points, and yes how to create random ellipse not only “-1+2 x^2-2 x y+y^2”, and how to calculate the offset

8 
In[1]:= While[True,
  (*Randomly choose coefficients until acceptable*)
  {a, b, c, d, f, g} = RandomReal[{-10, 10}, 6];
  \[CapitalDelta] = -c d^2 + 2 b d f - a f^2 - b^2 g + a c g; j = -b^2 + a c; i = a + c; 
  If[\[CapitalDelta] != 0 && j > 0 && \[CapitalDelta]/i < 0, Break[]]
];
ellipse = a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g;
(*Center of an ellipse in general form is{(c d-b f)/(b^2-a c),(a f-b d)/(b^2-a c)}*)
points = Table[theta = RandomReal[{0, 2 Pi}];
  ksol = FindRoot[(ellipse /. {x -> k*Cos[theta] + (c d - b f)/(b^2 - a c), 
    y -> k*Sin[theta] + (a f - b d)/(b^2 - a c)}) == 0, {k, 1.}];
  Point[{x, y}] /. {x -> k*Cos[theta] + (c d - b f)/(b^2 - a c), 
    y -> k*Sin[theta] + (a f - b d)/(b^2 - a c)} /. ksol, {5}];
nearpoints = points /. Point[{x_, y_}] :> Point[{x + RandomReal[{-.1, .1}], y + RandomReal[{-.1, .1}]}];
(* ellipse x and y min and max values *)
yplotrange = Flatten[{y, Sort[{
  ( 2*b*d - 2*a*f + Sqrt[(2*b*d - 2*a*f)^2 - 4*(b^2 - a*c)*(d^2 - a*g)])/(2*(-b^2 + a*c)),
  (-2*b*d + 2*a*f + Sqrt[(2*b*d - 2*a*f)^2 - 4*(b^2 - a*c)*(d^2 - a*g)])/(2*( b^2 - a*c))}]}];
xplotrange = Flatten[{x, Sort[{
  ( 2*c*d - 2*b*f + Sqrt[(-2*c*d + 2*b*f)^2 - 4*(b^2 - a*c)*(f^2 - c*g)])/(2*( b^2 - a*c)),
  (-2*c*d + 2*b*f + Sqrt[(-2*c*d + 2*b*f)^2 - 4*(b^2 - a*c)*(f^2 - c*g)])/(2*(-b^2 + a*c))}]}];
Show[ContourPlot[ellipse == 0, Evaluate[xplotrange], Evaluate[yplotrange]],
  Graphics[points],
  Graphics[nearpoints]]

Out[7]= ...PlotRemoved...

Study every detail of this so that you can learn how each part of it works. Look up the functions in the help system. Click on Details and Options for each function to find important information.

9

wow nice thanks very much, but i have one more request for now: can you add some button or Manipulation[] to generate ellipses

10

No.

11

Just plop it in a Button

Panel[Column[{Button["Click Me", While[True,
   (*Randomly choose coefficients until acceptable*)
   {a, b, c, d, f, g} = RandomReal[{-10, 10}, 6];
   ? = -c d^2 + 2 b d f - a f^2 - b^2 g + a c g; j = -b^2 + a c; i = a + c;
   If[? != 0 && j > 0 && ?/i < 0, Break[]]
 ];
 ellipse = a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g;
 (*Center of an ellipse in general form is{(c d-b f)/(b^2-a c),(a f-b d)/(b^2-a c)}*)
 points = Table[theta = RandomReal[{0, 2 Pi}];
  ksol = FindRoot[(ellipse /. {x -> k*Cos[theta] + (c d - b f)/(b^2 - a c),
    y -> k*Sin[theta] + (a f - b d)/(b^2 - a c)}) == 0, {k, 1.}];
  Point[{x, y}] /. {x -> k*Cos[theta] + (c d - b f)/(b^2 - a c),
    y -> k*Sin[theta] + (a f - b d)/(b^2 - a c)} /. ksol, {5}];
nearpoints = points /. Point[{x_, y_}] :> Point[{x + RandomReal[{-.1, .1}], y + RandomReal[{-.1, .1}]}];
(* ellipse x and y min and max values *)
yplotrange = Flatten[{y, Sort[{
  ( 2*b*d - 2*a*f + Sqrt[(2*b*d - 2*a*f)^2 - 4*(b^2 - a*c)*(d^2 - a*g)])/(2*(-b^2 + a*c)),
  (-2*b*d + 2*a*f + Sqrt[(2*b*d - 2*a*f)^2 - 4*(b^2 - a*c)*(d^2 - a*g)])/(2*( b^2 - a*c))}]}];
xplotrange = Flatten[{x, Sort[{
  ( 2*c*d - 2*b*f + Sqrt[(-2*c*d + 2*b*f)^2 - 4*(b^2 - a*c)*(f^2 - c*g)])/(2*( b^2 - a*c)),
  (-2*c*d + 2*b*f + Sqrt[(-2*c*d + 2*b*f)^2 - 4*(b^2 - a*c)*(f^2 - c*g)])/(2*(-b^2 + a*c))}]}];
    final = 
     Show[ContourPlot[ellipse == 0, Evaluate[xplotrange], 
       Evaluate[yplotrange]], Graphics[points], Graphics[nearpoints]]
    ], Dynamic[final]}]
 ]
12

how to show coordinates of generated points under graph, I tried with Lebeled

13

What you are looking for is Tooltip

Tooltip /@ points
14

where to put it becouse i don’t know how and where

15

Map the Tooltip down your Point primitives right inside the Graphics wrapper, like this.

Show[ContourPlot[ellipse == 0, Evaluate[xplotrange], Evaluate[yplotrange]], 
Graphics[Tooltip /@ points], Graphics[Tooltip /@ nearpoints]]
16

ok its fine but i want to put coordinates like this below the graph:
(example)
{1,2}{2,1}{3,1}{,1,3}
and define/lebel points like this A{x,y}, A’{x’,y’}…

17

Include this Grid at the end of the Column right after Dynamic

Dynamic@Grid[
  Join[{{"points", "nearby points"}}, 
   Transpose[{points, nearpoints}][[All, All, 1]]],
  Frame -> All, Alignment -> Left]
18

ok now i need to calculate the displacement with optimization with inequality constraints: the Kuhn-Tucker conditions and try to plot next (green) ellipse with all 5 “nearby points” if of course it’s possible
My professor write to me about cost function and Newton metod, it’s the same thing like Kuhn-Tucker conditions? But of course a different way of counting but in the end the result will be the same?

19

Symbolic Minimization Using the Karush-Kuhn-Tucker Conditions

20

and how to add this KKT conditions to my work?