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 + gHow 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 gJ=-b^2 + a cI=a+cconditions:\[CapitalDelta]!=0J>0\[CapitalDelta]/I<0And 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 gJ[a_, b_, c_] := -b^2 + a ci[a_, c_] := a + c?[-2, 4, -6, 2, 1, 2]
4 years ago
62 Replies
 Bill Simpson 2 Votes 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 /. solutionOut[6]= {1}In[7]:= \[CapitalDelta]/i /. solutionOut[7]= {-(1/3)}In[8]:= a*x^2 + 2*b*x*y + c*y^2 + 2*d*x + 2*f*y + g /. solutionOut[8]= {-1 + 2 x^2 - 2 x y + y^2}
4 years ago
 Radek Drozd 1 Vote 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 years ago
 Bill Simpson 1 Vote 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^2Out[6]= ...PlotImageRemoved...
4 years 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
4 years ago
 Bill Simpson 1 Vote 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.
4 years 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
4 years ago
 Bill Simpson 1 Vote 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.
4 years ago
 wow nice thanks very much, but i have one more request for now: can you add some button or Manipulation[] to generate ellipses
4 years ago
 No.
4 years ago
 Christopher French 1 Vote 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]}] ]
4 years ago
 how to show coordinates of generated points under graph, I tried with Lebeled
4 years ago
 Christopher French 1 Vote What you are looking for is TooltipTooltip /@ points
4 years ago
 where to put it becouse i don't know how and where
4 years ago
 Christopher French 1 Vote 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]]
4 years 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'}...
4 years ago
 Christopher French 1 Vote Include this Grid at the end of the Column right after DynamicDynamic@Grid[  Join[{{"points", "nearby points"}},    Transpose[{points, nearpoints}][[All, All, 1]]],  Frame -> All, Alignment -> Left]
4 years 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 possibleMy 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?
4 years ago
 Frank Kampas 1 Vote
4 years ago
 and how to add this KKT conditions to my work?
4 years 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.
4 years 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)
4 years 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/193644Is 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.
4 years ago
 Frank Kampas 1 Vote 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.
4 years 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?
4 years ago
 Frank Kampas 1 Vote 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 fromthe ellipse and trying to find the best ellipse for those new points?
4 years ago
 generating new points from starting points and trying to find the best ellipse for those new points
4 years ago
 Frank Kampas 1 Vote how many points do you start with and how many do you generate from them?
4 years 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
4 years ago
 Frank Kampas 1 Vote best ellipse for the 5 new points or for all 10 points?
4 years ago
 best ellipse for the 5 new points
4 years ago
 Frank Kampas 1 Vote 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?
4 years 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
4 years ago
 Frank Kampas 1 Vote Is that because the first 5 points all fell exactly on an ellipse?
4 years ago
 yes they are
4 years ago
 Frank Kampas 1 Vote 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.
4 years ago
 ok yes but how to add this to my aplication?
4 years ago
 Frank Kampas 2 Votes 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.
4 years ago
 ok and somebody can update code in aplication with this?
4 years ago
 Christopher French 2 Votes 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
4 years ago
 Radek Drozd 1 Vote 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:
4 years ago
 someone will help me with last post?
4 years 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 equationmy 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
4 years ago
 Christopher French 2 Votes 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?
4 years ago
 yes its i think end of it but i have to show a minimum of a function of several variables using some way
4 years 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; 
4 years ago
 and how to add this to app?
4 years ago
 Christopher French 2 Votes 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]*)}]] 
4 years 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.
4 years 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.}, 
4 years ago
 These are the added conditions, J>0 and Δ/I<0
4 years 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
4 years 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
4 years ago
 Christopher French 2 Votes 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 :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]*)}]] ] 
4 years ago
 Radek Drozd 1 Vote 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 elseand I have a show for which coefficients come ellipse parabola or hyperbola, etc.
4 years ago
 how to show for which coefficients come ellipse parabola or hyperbola, etc. how to do that?
4 years 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]*)}]]] 
4 years 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?
4 years 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?
4 years 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]}}] 
 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]}}]