Out[]=
Geometria2D`Conicas`
In[]:=
SteinerCircumellipse::usage="This notebook obtains the midpoints of the triangle, the medians and the center (barycenter).Steiner's circumeliipse passes through each of the vertices of the triangle, hence the name, and has the barycenter as its center.References: Wolfram MathWorld: Steiner Circumellipse; Personal. ";SteinerCircumellipse[tri={{x1_,y1_},{x2_,y2_},{x3_,y3_}},{X0_,X1_},{Y0_,Y1_}]:=Module{},DEP=Det[{{x1,y1,1},{x2,y2,1},{x3,y3,1}}];IfDEP==0||X0≥X1||Y0≥Y1,Print[PasteButton["Incorrect data or the points do not form a triangle"]],bax=;bay=;m1x=;m1y=;m2x=;m2y=;m3x=;m3y=;Print[""];xp1=2bax-x1;yp1=2bay-y1;xp2=2bax-x2;yp2=2bay-y2;xp3=2bax-x3;yp3=2bay-y3;s6=NSolve[a11x1^2+x1y1+c11y1^2+d11x1+e11y1+f11==0, a11x2^2+x2y2+c11y2^2+d11x2+e11y2+f11==0, a11x3^2+x3y3+c11y3^2+d11x3+e11y3+f11==0, a11xp1^2+xp1yp1+c11yp1^2+d11xp1+e11yp1+f11==0, a11xp2^2+xp2yp2+c11yp2^2+d11xp2+e11yp2+f11==0,{a11,c11,d11,e11,f11}]; a22=a11/.s6;c22=c11/.s6;d22=d11/.s6;e22=e11/.s6;f22=f11/.s6; at=a22.{1}; bt=1; ct=c22.{1}; dt=d22.{1}; et=e22.{1}; ft2=f22.{1};Print[PasteButton["The equation of Steiner's circumellipse is:"]];Print[" "];Print[{at,bt,ct,dt,et,ft2}.{,xy,,x,y,1},"= 0"];Print[""];g1=Line[{{x1,y1},{x2,y2},{x3,y3},{x1,y1}}];g2=Point[{bax,bay}];g3=Point[{m1x,m1y}];g4=Point[{m2x,m2y}];g5=Point[{m3x,m3y}];g6=Line[{{m1x,m1y},{bax,bay},{x3,y3}}];g7=Line[{{m2x,m2y},{bax,bay},{x1,y1}}];g8=Line[{{m3x,m3y},{bax,bay},{x2,y2}}];g9=Point[{x1,y1}];g10=Point[{x2,y2}];g11=Point[{x3,y3}];g12=Point[{xp1,yp1}];g13=Point[{xp2,yp2}];g14=Point[{xp3,yp3}];g15=ContourPlot[atx^2+btxy+cty^2+dtx+ety+ft2==0,{x,X0,X1},{y,Y0,Y1}];Conicas[at,bt,ct,dt,et,ft2,{X0,X1},{Y0,Y1}];Show[{Graphics[{Red,PointSize[0.02],g2}],Graphics[{Blue,g1}],Graphics[{Black,PointSize[0.02],g3}],Graphics[{Black,PointSize[0.02],g4}],Graphics[{Black,PointSize[0.02],g5}],Graphics[{Purple,g6}],Graphics[{Purple,g7}],Graphics[{Purple,g8}],Graphics[{Red,PointSize[0.02],g9}],Graphics[{Red,PointSize[0.02],g10}],Graphics[{Red,PointSize[0.02],g11}],Graphics[{Red,PointSize[0.02],g12}],Graphics[{Red,PointSize[0.02],g13}],Graphics[{Red,PointSize[0.02],g14}],g15},AxesTrue,AxesOrigin{0,0},AspectRatioAutomatic,ImageSize500,PlotLabelStyle[Framed["Steiner's circumellipse and triangle detail."],16,Blue,BackgroundYellow]]
x1+x2+x3
3
y1+y2+y3
3
x1+x2
2
y1+y2
2
x3+x2
2
y3+y2
2
x1+x3
2
y1+y3
2
2
x
2
y
In the command below, type the new coordinates of the points. You can also change the extension to X and Y. Evaluate the notebook.
In[]:=
SteinerCircumellipse[tri={{-2,5},{7,12},{9,-4}},{-3,12},{-5,15}]
-11.8971-30.8235x+2.83824-17.7941y+xy+1.51471= 0
2
x
2
y
The values of a, b, c, and e are:
LL´
9.53124 | 6.38051 | 7.08051 | 8.54263 | 0.742874 |
Major axis in y''
After rotation the equation is:
-11.8971-34.8814+3.00589-7.07189+1.34705= 0
´
x
´2
x
´
y
´2
y
The rotation angle is:
θ = 18.5365°
After translation the equation is:
-122.373+3.00589+1.34705= 0
´´2
x
´´2
y
The coordinates of new origin are:
´´
O
Out[]=
Comparison with Mathematica (adjust extension in X and Y):
In[]:=
ρ[x_,y_]=ResourceFunction["SteinerCircumellipse"][tri,"Implicit"][x,y];Show[{ContourPlot[ρ[x,y]==0,{x,-3,12},{y,-5,15}],Graphics[{FaceForm[],EdgeForm[Blue],Triangle[tri]}]},AxesTrue,AxesOrigin{0,0},AspectRatio->Automatic]
Out[]=
They are exactly the same.