# Mathematica creating an ellipse

Posted 9 years ago
24191 Views
|
62 Replies
|
30 Total Likes
|
 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]
62 Replies
Sort By:
Posted 9 years 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 9 years ago
 really need help with this because trying a couple of days and does not go to me
Posted 9 years 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 9 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]}}] 
Posted 9 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?
Posted 9 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?
Posted 9 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]*)}]]] 
Posted 9 years ago
 how to show for which coefficients come ellipse parabola or hyperbola, etc. how to do that?
Posted 9 years 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 elseand I have a show for which coefficients come ellipse parabola or hyperbola, etc.
Posted 9 years 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 :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 9 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
Posted 9 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
Posted 9 years ago
 These are the added conditions, J>0 and ?/I<0
Posted 9 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.}, 
Posted 9 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.
Posted 9 years 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 9 years ago
 and how to add this to app?
Posted 9 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; 
Posted 9 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
Posted 9 years 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?
Posted 9 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
Posted 9 years ago
 someone will help me with last post?
Posted 9 years 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 9 years 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 9 years ago
 ok and somebody can update code in aplication with this?
Posted 9 years 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 9 years ago
 ok yes but how to add this to my aplication?
Posted 9 years 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 9 years ago
 yes they are
Posted 9 years ago
 Is that because the first 5 points all fell exactly on an ellipse?
Posted 9 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
Posted 9 years 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 9 years ago
 best ellipse for the 5 new points
Posted 9 years ago
 best ellipse for the 5 new points or for all 10 points?
Posted 9 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
Posted 9 years ago
 how many points do you start with and how many do you generate from them?
Posted 9 years ago
 generating new points from starting points and trying to find the best ellipse for those new points
Posted 9 years 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 fromthe ellipse and trying to find the best ellipse for those new points?
Posted 9 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?
Posted 9 years 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 9 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.
Posted 9 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)
Posted 9 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.
Posted 9 years ago
 and how to add this KKT conditions to my work?
Posted 9 years ago
Posted 9 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?
Posted 9 years ago
 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]
Posted 9 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'}...
Posted 9 years 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 9 years ago
 where to put it becouse i don't know how and where
Posted 9 years ago
 What you are looking for is TooltipTooltip /@ points
Posted 9 years ago
 how to show coordinates of generated points under graph, I tried with Lebeled
Posted 9 years 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 9 years ago
 No.
Posted 9 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
Posted 9 years 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 9 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
Posted 9 years 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 9 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
Posted 9 years 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^2Out[6]= ...PlotImageRemoved...
Posted 9 years 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 9 years 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 /. 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}