Group Abstract Group Abstract

Message Boards Message Boards

Mathematica creating an ellipse

GROUPS:
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]
POSTED BY: Radek Drozd
Answer
7 months ago
 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}
POSTED BY: Bill Simpson
Answer
7 months ago
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
POSTED BY: Radek Drozd
Answer
7 months ago
 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...
POSTED BY: Bill Simpson
Answer
7 months ago
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
POSTED BY: Radek Drozd
Answer
7 months ago
 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.
POSTED BY: Bill Simpson
Answer
7 months ago
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
POSTED BY: Radek Drozd
Answer
7 months ago
 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.
POSTED BY: Bill Simpson
Answer
7 months ago
wow nice thanks very much, but i have one more request for now: can you add some button or Manipulation[] to generate ellipses
POSTED BY: Radek Drozd
Answer
7 months ago
No.
POSTED BY: Bill Simpson
Answer
7 months ago
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]}]
]
POSTED BY: Christopher French
Answer
7 months ago
how to show coordinates of generated points under graph, I tried with Lebeled 
POSTED BY: Radek Drozd
Answer
7 months ago
What you are looking for is Tooltip
Tooltip /@ points
POSTED BY: Christopher French
Answer
7 months ago
where to put it becouse i don't know how and where
POSTED BY: Radek Drozd
Answer
7 months ago
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]]
POSTED BY: Christopher French
Answer
7 months ago
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'}...
POSTED BY: Radek Drozd
Answer
7 months ago
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]
POSTED BY: Christopher French
Answer
7 months ago
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?
POSTED BY: Radek Drozd
Answer
7 months ago
and how to add this KKT conditions to my work?
POSTED BY: Radek Drozd
Answer
7 months ago
The Mathematica code in the link generates the KKT conditions, given the variables, objective function, and constraints,and solves the resulting equations with Reduce.
POSTED BY: Frank Kampas
Answer
7 months ago
ok today I was on consultation with my professor and I must calculate something like this: all 5 "nearby points" coordinates raise the power of dwo and i should get E(a, b, c, d, f, g)
POSTED BY: Radek Drozd
Answer
7 months ago
 Panel[Column[{Button["Generuj Elipse",
 
     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))}]}];

    final =

     Show[ContourPlot[ellipse == 0, Evaluate[xplotrange],

       Evaluate[yplotrange]], Graphics[points],

      Graphics[{Red, nearpoints}], ImageSize -> {500, Automatic}]],

   Dynamic[final],

   Dynamic@Grid[

     Join[{{"points", "nearby points"}},

      Transpose[{points, nearpoints}][[All, All, 1]]], Frame -> All,

     Alignment -> Left]}]]
http://community.wolfram.com/groups/-/m/t/193644

Is anyone able to explain how they operate KKT conditions for my application?
I generally generated elipse of 5 random points on it and added noise generating points lying close to those on the ellipse. I have a show if I can carried out elipse through these points with noise or not. I need also calculate the cost function.
POSTED BY: Radek Drozd
Answer
7 months ago
You'll probably want to do something like minimizing the sum of the squares of the distances from your points to the fitted ellipse. 
I say "something like" because the expression for the distance between a point and an ellipse may be fairly complex.
POSTED BY: Frank Kampas
Answer
7 months ago
"do something like minimizing the sum of the squares of the distances from your points to the fitted ellipse. "
fitted ellipse - second ellipse "created"  with "near points" yes?
yes i think  it's this, and can somebody try to help me with this?
POSTED BY: Radek Drozd
Answer
7 months ago
I haven't followed all the details of the discussion.  As I understand, you're starting with some points, fitting an ellipse to them, and then generating new points from
the ellipse and trying to find the best ellipse for those new points?
POSTED BY: Frank Kampas
Answer
7 months ago
generating new points from starting points and trying to find the best ellipse for those new points
POSTED BY: Radek Drozd
Answer
7 months ago
how many points do you start with and how many do you generate from them?
POSTED BY: Frank Kampas
Answer
7 months ago
5 of the starting points and then to each add a small noise and generate the second elipse with as much as possible matching points
POSTED BY: Radek Drozd
Answer
7 months ago
best ellipse for the 5 new points or for all 10 points?
POSTED BY: Frank Kampas
Answer
7 months ago
best ellipse for the 5 new points
POSTED BY: Radek Drozd
Answer
7 months ago
guess I'm still missing something.  why don't you use the same method for the 5 new points that you used for the 5 original points?
POSTED BY: Frank Kampas
Answer
7 months ago
i think in the first method I had a function that determines elipse here after adding noise will not always be possible to create elipse containing the 5 points
POSTED BY: Radek Drozd
Answer
7 months ago
Is that because the first 5 points all fell exactly on an ellipse?
POSTED BY: Frank Kampas
Answer
7 months ago
yes they are
POSTED BY: Radek Drozd
Answer
7 months ago
For the second 5 points, you'll need an expression for the distance from a point to an ellipse, given the coefficients that determine the ellipse.
Since the second 5 points are close to the ellipse, an approximate expression may be good enough.
POSTED BY: Frank Kampas
Answer
7 months ago
ok yes but how to add this to my aplication?
POSTED BY: Radek Drozd
Answer
7 months ago
One approach might be to use FindMinimum to minimize the sum of the squares of the distances of the 5 points to the ellipse,
as a function of the parameters determining the ellipse, using the original parameters as starting values for the minimization.
POSTED BY: Frank Kampas
Answer
7 months ago
ok and somebody can update code in aplication with this?
POSTED BY: Radek Drozd
Answer
7 months ago
minimize the distance from near points to a new general ellipse, based on the approach by Tomas Graza found on MathGroup


 Panel[Column[{
    Button["Generuj Elipse", 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.},
        AccuracyGoal -> 4, PrecisionGoal -> 4];
      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))}]}];
   
(*minimize distance of near points to a new general ellipse*)
    nearCoords = nearpoints[[All, 1]];
    {xs, ys} = Transpose[nearCoords];
    newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
    distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
    {res, coes} =
     FindMinimum[
      distance, {{aa, a}, {bb, b}, {cc, c}, {dd, d}, {ff, f}, {gg, g}}];
    esolve = newellipse /. coes;

(* build graphics *)
    final = Show[
      ContourPlot[{ellipse == 0, esolve == 0}, Evaluate[xplotrange],
       Evaluate[yplotrange]],
      Graphics[points],
      Graphics[{Red, nearpoints}],
      ImageSize -> {250, Automatic}(*,
      PlotRange\[Rule]{{-20,20},{-20,20}}*)]
    ],

(* display graphics *)
   Dynamic[final],
   Dynamic@Grid[
      Join[{{"points", "nearby points"}},
      Transpose[{points, nearpoints}][[All, All, 1]]],
    Frame -> All,
    Alignment -> Left]
   }]]


Example image:


![enter image description here][1]


[1]: /c/portal/getImageAttachment?filename=generate_ellipse_red-points.png&userId=27262
POSTED BY: Christopher French
Answer
7 months ago

However, it was not about what has been added recently. I need calculate the cost of failure:

  • I draw for example, 100 points on the ellipse, and add the noise
  • Place a points of noise to the function E(a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g)=0 like (x0,y0)^2, (x1,y1)^2... and summed them
  • Further reduce the cost of failure with restrictions

    Δ!=0 J>0 Δ/I<0

  • Normalization a^2+b^2+c^2+d^2+f^2+g^2=1

  • Apply any multiplier Lagrange’a
  • Find an elipse from the cloud of points or curves

And my professor send my this, i add a pdf file

Attachments:
POSTED BY: Radek Drozd
Answer
6 months ago

someone will help me with last post?

POSTED BY: Radek Drozd
Answer
6 months ago

i have this

Panel[Column[{Button["Generuj Elipse", 
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, {100}];
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[{Red, nearpoints}], ImageSize -> {500, Automatic}]], Dynamic[final], Dynamic@Grid[Join[{{"points", "nearby points"}},
Transpose[{points, nearpoints}][[All, All, 1]]], Frame -> All,
Alignment -> Left]}]]

Whith this i need to take care of red dots: take first red point substituted for the equation of an ellipse with no additional terms and raise to the square of the first point, the second etc and compared to 0, the result should be a function of the coefficients, can you help me with this? How to add this equation

my main task is to find out the "cloud" of red points of the ellipse and it shows a comparison of the original but it later

POSTED BY: Radek Drozd
Answer
5 months ago

Show both the first ellipse in blue for the black dots and the second ellipse in yellow for the red nearby points. Does this look like the result you are expecting to get?

enter image description here

POSTED BY: Christopher French
Answer
5 months ago

yes its i think end of it but i have to show a minimum of a function of several variables using some way

POSTED BY: Radek Drozd
Answer
5 months ago

FindMinimum of the distance function. Here distance is the sum of the square of the nearby points to a general ellipse. Part All 1 is needed to get the coordinate data out of the nearpoints, because they are already in a Point wrapper. The coefficients from the first ellipse are used as initial values. Once the nearpoints coordinates are extracted, you can minimize over any criteria you choose.

(*minimize distance of near points to a new general ellipse*)
nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} =
FindMinimum[
distance, {{aa, a}, {bb, b}, {cc, c}, {dd, d}, {ff, f}, {gg, g}}];
esolve = newellipse /. coes;
POSTED BY: Christopher French
Answer
5 months ago

and how to add this to app?

POSTED BY: Radek Drozd
Answer
5 months ago

It fits between (ellipse x and y min and max values) and the final graphics, with esolve added to the contour plot like this, ContourPlot[{ellipse == 0, esolve == 0}. Exactly how it was done in a previous post.

Off[FindMinimum::eit]; Off[FindMinimum::lstol];
Panel[
Column[{
Button["Generuj Elipse", 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, {100}];
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))}]}];

(*minimize distance of near points to a new general ellipse*)
nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} = FindMinimum[{distance,
-bb^2 + aa*cc > 0.,
(-cc*dd^2 + 2 bb*dd*ff - aa*ff^2 - bb^2*gg + aa*cc *gg)/(aa + cc) < 0.},
{{aa, a}, {bb, b}, {cc, c}, {dd, d}, {ff, f}, {gg, g}}];
esolve = newellipse /. coes;

final =
Show[ContourPlot[{ellipse == 0, esolve == 0},
Evaluate[xplotrange], Evaluate[yplotrange]], Graphics[points],
Graphics[{Red, nearpoints}], ImageSize -> {500, Automatic}]],
Dynamic[final](*,Dynamic@Grid[Join[{{"points","nearby points"}},
Transpose[{points,nearpoints}][[All,All,1]]],Frame\[Rule]All,
Alignment\[Rule]Left]*)}]]
POSTED BY: Christopher French
Answer
5 months ago

how to do parameterizations points to cloud points were more focused himself and wants to show that sometimes can get out of hyperbole parabola, etc.

POSTED BY: Radek Drozd
Answer
5 months ago

Whether it is a condition you'll have to go out ellipse?

  -bb^2 + aa*cc > 0.,(-cc*dd^2 + 2 bb*dd*ff - aa*ff^2 - bb^2*gg + aa*cc *gg)/(aa + cc) < 0.},
POSTED BY: Radek Drozd
Answer
5 months ago

These are the added conditions, J>0 and Δ/I<0

POSTED BY: Christopher French
Answer
5 months ago

i need to do parameterizations to show does not always come with an ellipse, if you could to add some button or something to switching between ellipse and something else that can go out

POSTED BY: Radek Drozd
Answer
5 months ago

i changed this

points = Table[theta = RandomReal[{0, Pi/2}];

(how to add button or menu changing 2 Pi to Pi/2?) and now how to change this

FindMinimum[{distance, -bb^2 + aa*cc >0., (-cc*dd^2 + 2 bb*dd*ff - aa*ff^2 - bb^2*gg + aa*cc*gg)/(aa + cc) < 0.}, {{aa, a}, {bb, b}, {cc, c}, {dd,d}, {ff, f}, {gg, g}}];

that not only was outlined ellipse for example parabolas

POSTED BY: Radek Drozd
Answer
5 months ago

Sure. FindMinimum using the starting ellipse coefficients as a search starting point with no other constraints :

{res, coes} = FindMinimum[distance, {{aa, a}, {bb, b}, {cc, c}, {dd, d}, {ff, f}, {gg, g}}];

FindMinimum using the starting ellipse coefficients and the initial constraints :

{res, coes} = FindMinimum[{distance,
-bb^2 + aa*cc > 0.,
(-cc*dd^2 + 2 bb*dd*ff - aa*ff^2 - bb^2*gg + aa*cc *gg)/(aa + cc) < 0.},
{{aa, a}, {bb, b}, {cc, c}, {dd, d}, {ff, f}, {gg, g}}];

FindMinimum only finds a local minimum, where NMinimize can find unconstrained global minima :

{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];

There are lots of ways to add a selection, this uses RadioButtonBar :

RadioButtonBar[Dynamic[rng], {Pi/2 -> "\[Pi]/2", 2 Pi -> "2\[Pi]"}]

The results should look like this :

enter image description here

The code now looks like this :

Off[NMinimize::eit]; Off[NMinimize::lstol];
DynamicModule[{rng, final},
Panel[Column[{
RadioButtonBar[
Dynamic[rng], {Pi/2 -> "\[Pi]/2", 2 Pi -> "2\[Pi]"}],
Button["Generuj Elipse",
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, rng}];
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, {100}];
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))}]}];
(*minimize distance of near points to a new general ellipse*)

nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];
scaleup = FromDigits[{{1}, Last@RealDigits[1/(gg /. coes)] + 1}];
esolve = Expand[scaleup*(newellipse /. coes)];

final = Show[
ContourPlot[{ellipse == 0, esolve == 0}, Evaluate[xplotrange],
Evaluate[yplotrange]],
Graphics[points], Graphics[{Red, nearpoints}],
ImageSize -> {500, Automatic}];],

Dynamic@final
(*,Dynamic@Grid[Join[{{"points","nearby points"}},
Transpose[{points,nearpoints}][[All,All,1]]],
Frame\[Rule]All,Alignment\[Rule]Left]*)}]]
]
POSTED BY: Christopher French
Answer
5 months ago

wow that nice thank you very much, and whether it is possible to plot was shown more in the middle to those lines which goes out outside of the frame were more visible? or allow scaling with some slider or something else

and I have a show for which coefficients come ellipse parabola or hyperbola, etc.

POSTED BY: Radek Drozd
Answer
5 months ago

how to show for which coefficients come ellipse parabola or hyperbola, etc. how to do that?

POSTED BY: Radek Drozd
Answer
5 months ago

how to implement optimizations but always came to the ellipse (ie, must be met inequality and optimize the assumption of the Kuhn Tucker). in some menu to choose with or without optimizations

Off[NMinimize::eit]; Off[NMinimize::lstol];
DynamicModule[{rng, ptk, final},
Panel[Column[{"Theta z przedziału od 0 do:",
RadioButtonBar[
Dynamic[rng], {2 -> "2", Pi/8 -> "\[Pi]/8", Pi/2 -> "\[Pi]/2",
Pi -> "\[Pi]", 2 Pi -> "2\[Pi]"}],
"Ilość generowanych punktów:",
RadioButtonBar[
Dynamic[ptk], {5 -> "5", 20 -> "20", 50 -> "50", 100 -> "100"}],
Button["Generuj Elipse",
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, rng}];
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, {ptk}];
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))}]}];
(*minimize distance of near points to a new general ellipse*)
nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];
scaleup = FromDigits[{{1}, Last@RealDigits[1/(gg /. coes)] + 1}];
esolve = Expand[scaleup*(newellipse /. coes)];
final =
Show[ContourPlot[{ellipse == 0, esolve == 0},
Evaluate[xplotrange], Evaluate[yplotrange]], Graphics[points],
Graphics[{Red, nearpoints}], ImageSize -> {500, Automatic}];],
Dynamic@final
(*,Dynamic@Grid[Join[{{"points","nearby points"}},
Transpose[{points,nearpoints}][[All,All,1]]],Frame->All,
Alignment->Left]*)}]]]
POSTED BY: Radek Drozd
Answer
4 months ago

I would like to show two visualization applications and mark it as

 q = {application code}; Show [q, q] 

but i have some errors, how to delete that errors?

Image

POSTED BY: Radek Drozd
Answer
4 months ago

i have this

q = {Off[NMinimize::eit]; Off[NMinimize::lstol];
DynamicModule[{rng, ptk, final},
Panel[Column[{"Theta z przedziału od 0 do:",
RadioButtonBar[
Dynamic[rng], {2 -> "2", Pi/8 -> "\[Pi]/8", Pi/2 -> "\[Pi]/2",
Pi -> "\[Pi]", 2 Pi -> "2\[Pi]"}],
"Ilość generowanych punktów:",
RadioButtonBar[
Dynamic[ptk], {5 -> "5", 20 -> "20", 50 -> "50",
100 -> "100"}],
Button["Generuj Elipse",
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, rng}];

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, {ptk}];
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))}]}];
(*minimize distance of near points to a new general ellipse*)
nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];
scaleup =
FromDigits[{{1}, Last@RealDigits[1/(gg /. coes)] + 1}];
esolve = Expand[scaleup*(newellipse /. coes)];
final =
Show[ContourPlot[{ellipse == 0, esolve == 0},
Evaluate[xplotrange], Evaluate[yplotrange],
ImageSize -> {200, Automatic}], Graphics[points],
Graphics[{Red, nearpoints}]];], Dynamic@final}]]]};
Grid[{{Labeled["(A)", q], Labeled["(B)", q]}, {Labeled["(C)", q],
Labeled["(D)", q]}}]

and i want add this to chose between n and m

m = {{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];
scaleup = FromDigits[{{1}, Last@RealDigits[1/(gg /. coes)] + 1}];
esolve = Expand[scaleup*(newellipse /. coes)];};

n = {{res, coes} =
FindMinimum[{distance, -bb^2 + aa*cc >
0., (-cc*dd^2 + 2 bb*dd*ff - aa*ff^2 - bb^2*gg +
aa*cc*gg)/(aa + cc) < 0.}, {{aa, a}, {bb, b}, {cc, c}, {dd,
d}, {ff, f}, {gg, g}}];
esolve = newellipse /. coes;};

it's possible to add some menu to make it all work?

POSTED BY: Radek Drozd
Answer
4 months ago

what I need to add to show the equation of the ellipse and the original created in order to compare their

q = {Off[NMinimize::eit]; Off[NMinimize::lstol];
DynamicModule[{rng, ptk, szumx, szumy, final},
Panel[Column[{"Theta z przedziału od 0 do:",
RadioButtonBar[
Dynamic[rng], {2 Pi -> "2[Pi]", Pi -> "[Pi]",
Pi/2 -> "[Pi]/2", Pi/8 -> "[Pi]/8"}], ,
"Ilość generowanych punktów:",
RadioButtonBar[
Dynamic[ptk], {5 -> "5", 20 -> "20", 50 -> "50",
100 -> "100"}], , "Wartości wektora przesunięcia",
"Wartość xi:" RadioButtonBar[
Dynamic[szumx], {-0.1 -> "-0.1", -.5 -> "-0.5", -.9 ->
"-0.9", -3 -> "-3"}],
"Wartość yj:" RadioButtonBar[
Dynamic[szumy], {0.1 -> "0.1", .5 -> "0.5", .9 -> "0.9",
3 -> "3"}],
Button["Generuj Elipse",
While[True,(*losowo wybrać akceptowalne współczynniki*){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;
(*Środek elipsy w ogólnej formie {(c d-b f)/(b^2-a c),(a f-
b d)/(b^2-a c)}*)points = Table[theta = RandomReal[{0, rng}];

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, {ptk}];
nearpoints =
points /.
Point[{x_, y_}] :>
Point[{x + RandomReal[{szumx, szumy}],
y + RandomReal[{szumx, szumy}]}];
(*minimalne i maksymalne wartości x i y dla elipsy*)
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))}]}];
(*zminimalizować dystans pobliskich punktów dla nowej ogólnej \n elpisy*)nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];
scaleup =
FromDigits[{{1}, Last@RealDigits[1/(gg /. coes)] + 1}];
esolve = Expand[scaleup*(newellipse /. coes)];
final =
Show[ContourPlot[{ellipse == 0, esolve == 0},
Evaluate[xplotrange], Evaluate[yplotrange]],
Graphics[points], Graphics[{Red, nearpoints}],
ImageSize -> {500, Automatic}];], Dynamic@final
(*,Dynamic@Grid[Join[{{"points","nearby points"}},
Transpose[{points,nearpoints}][[All,All,1]]],Frame->All,
Alignment->Left]*)}]]]};
Grid[{{Labeled["(A)", q], Labeled["(B)", q]}, {Labeled["(C)", q],
Labeled["(D)", q]}}]
POSTED BY: Radek Drozd
Answer
4 months ago

how to add a KKT http://community.wolfram.com/groups/-/m/t/193644 to my app with conditions to an ellipse and as a second choice hyperbolas

POSTED BY: Radek Drozd
Answer
3 months ago

really need help with this because trying a couple of days and does not go to me

POSTED BY: Radek Drozd
Answer
3 months ago

how to add KKT conditions to make ellipse and hyperbolas to this:

q = {Off[NMinimize::eit]; Off[NMinimize::lstol];
DynamicModule[{rng, ptk, szumx, szumy, final},
Panel[Column[{"Theta z przedziału od 0 do:",
RadioButtonBar[
Dynamic[rng], {2 Pi -> "2[Pi]", Pi -> "[Pi]",
Pi/2 -> "[Pi]/2", Pi/8 -> "[Pi]/8"}], ,
"Ilość generowanych punktów:",
RadioButtonBar[
Dynamic[ptk], {5 -> "5", 20 -> "20", 50 -> "50",
100 -> "100"}], , "Wartości wektora przesunięcia",
"Wartość xi:" RadioButtonBar[
Dynamic[szumx], {-0.1 -> "-0.1", -.5 -> "-0.5", -.9 ->
"-0.9", -3 -> "-3"}],
"Wartość yj:" RadioButtonBar[
Dynamic[szumy], {0.1 -> "0.1", .5 -> "0.5", .9 -> "0.9",
3 -> "3"}],
Button["Generuj Elipse",
While[True,(*losowo wybrać akceptowalne współczynniki*){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;
(*Środek elipsy w ogólnej formie {(c d-b f)/(b^2-a c),(a f-
b d)/(b^2-a c)}*)points = Table[theta = RandomReal[{0, rng}];

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, {ptk}];
nearpoints =
points /.
Point[{x_, y_}] :>
Point[{x + RandomReal[{szumx, szumy}],
y + RandomReal[{szumx, szumy}]}];
(*minimalne i maksymalne wartości x i y dla elipsy*)
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))}]}];
(*zminimalizować dystans pobliskich punktów dla nowej ogólnej \n elpisy*)nearCoords = nearpoints[[All, 1]];
{xs, ys} = Transpose[nearCoords];
newellipse = aa*x^2 + 2*bb*x*y + cc*y^2 + 2*dd*x + 2*ff*y + gg;
distance = Plus @@ (newellipse^2 /. {x -> xs, y -> ys});
{res, coes} = NMinimize[distance, {aa, bb, cc, dd, ff, gg}];
scaleup =
FromDigits[{{1}, Last@RealDigits[1/(gg /. coes)] + 1}];
esolve = Expand[scaleup*(newellipse /. coes)];
final =
Show[ContourPlot[{ellipse == 0, esolve == 0},
Evaluate[xplotrange], Evaluate[yplotrange]],
Graphics[points], Graphics[{Red, nearpoints}],
ImageSize -> {500, Automatic}];], Dynamic@final
(*,Dynamic@Grid[Join[{{"points","nearby points"}},
Transpose[{points,nearpoints}][[All,All,1]]],Frame->All,
Alignment->Left]*)}]]]};
Grid[{{Labeled["(A)", q], Labeled["(B)", q]}, {Labeled["(C)", q],
Labeled["(D)", q]}}]
POSTED BY: Radek Drozd
Answer
3 months ago