In[]:=
JohnsonCircunconic::usage="Johnson's circunconic is a conical as its name suggests, which passes through the vertices of the base triangle and through the vertices of the Johnson triangle. Its center is the center of the circumference of the 9 points (​
X
5
​). If all the angles are acute it is an ellipse, if there is an obtuse angle it is a hyperbola. References: Wolfram MathWorld: Johnson Circumconic, Johnson Triangle, Conway Triangle Notation; Personal. ";​​​​JohnsonCircunconic[tri={{x1_,y1_},{x2_,y2_},{x3_,y3_}},{X0_,X1_},{Y0_,Y1_}]:=​​Module{},DEP=Det[{{x1,y1,1},{x2,y2,1},{x3,y3,1}}];​​IfDEP==0||X0≥X1||Y0≥Y1,Print[PasteButton["Incorrect data or the points do not form a triangle"]],​​xm1=
x1+x2
2
;ym1=
y1+y2
2
;xm2=
x2+x3
2
;ym2=
y2+y3
2
;xm3=
x3+x1
2
;ym3=
y3+y1
2
;​​tri1={{xm1,ym1},{xm2,ym2},{xm3,ym3}};​​ρ=TriangleCenter[tri1,"Circumcenter"];​​xce=ρ[[1]];​​yce=ρ[[2]];​​​​aa=
2
(x3-x2)
+
2
(y3-y2)
;bb=
2
(x3-x1)
+
2
(y3-y1)
;cc1=
2
(x2-x1)
+
2
(y2-y1)
;​​α=ArcCos
2
bb
+
2
cc1
-
2
aa
2bbcc1
;β=ArcCos
2
aa
+
2
cc1
-
2
bb
2aacc1
;γ=ArcCos
2
aa
+
2
bb
-
2
cc1
2aabb
;​​SA=bbcc1Cos[α];SB=aacc1Cos[β];SC=aabbCos[γ];s=
aa+bb+cc1
2
;​​Δ=
s(s-aa)(s-bb)(s-cc1)
;S1=2Δ;​​xx=-
2
aa
bbcc1SA;yy=bbcc1(
2
S1
+SASC);zz=bbcc1(
2
S1
+SASB);​​
λ
1
=
xx
xx+yy+zz
;
λ
2
=
yy
xx+yy+zz
;
λ
3
=
zz
xx+yy+zz
;​​XJA=
λ
1
{x1,y1}+
λ
2
{x2,y2}+
λ
3
{x3,y3};​​xXJA=N[Take[XJA,{1}].{1}];yXJA=N[Take[XJA,{2}].{1}];​​xx1=aacc1(
2
S1
+SBSC);yy1=-aa
2
bb
cc1SB;zz1=aacc1(
2
S1
+SASB);​​
λ
4
=
xx1
xx1+yy1+zz1
;
λ
5
=
yy1
xx1+yy1+zz1
;
λ
6
=
zz1
xx1+yy1+zz1
;​​XJB=
λ
4
{x1,y1}+
λ
5
{x2,y2}+
λ
6
{x3,y3};​​xXJB=N[Take[XJB,{1}].{1}];yXJB=N[Take[XJB,{2}].{1}];​​xx2=aabb(
2
S1
+SBSC);yy2=aabb(
2
S1
+SASC);zz2=-aabb
2
cc1
SC;​​
λ
7
=
xx2
xx2+yy2+zz2
;
λ
8
=
yy2
xx2+yy2+zz2
;
λ
9
=
zz2
xx2+yy2+zz2
;​​XJC=
λ
7
{x1,y1}+
λ
8
{x2,y2}+
λ
9
{x3,y3};​​xXJC=N[Take[XJC,{1}].{1}];yXJC=N[Take[XJC,{2}].{1}];​​p5={{x1,y1},{x2,y2},{x3,y3},{xXJA,yXJA},{xXJB,yXJB}};​​ξ=ResourceFunction["FivePointConic"][p5,{x,y}];​​g1=Line[{{x1,y1},{x2,y2},{x3,y3},{x1,y1}}];​​g2=ContourPlotξ==0,{x,X0,X1},{y,Y0,Y1},Epilog
directives
,Point[p5];​​g5=Point[{x1,y1}];g6=Point[{x2,y2}];​​g7=Point[{x3,y3}];​​g8=Point[{xce,yce}];​​g9=Line[{{xXJA,yXJA},{xXJB,yXJB},{xXJC,yXJC},{xXJA,yXJA}}];​​g10=Point[{xXJA,yXJA}];g11=Point[{xXJB,yXJB}];​​g12=Point[{xXJC,yXJC}];​​label[sym_,Point[pos_]]:={PointSize[Scaled[0.028]],Hue[0.58,1,1],Point[pos],Text[Style[sym,White,FontSizeScaled[0.015]],pos]};​​Print[PasteButton["Information about Johnson's circunconic:"]];Print[" "];​​δ=ResourceFunction["ConicProperties"][ξ==0,{x,y}];​​Print[δ];​​Show[{Graphics[{Blue,g1}],g2,Graphics[{Black,Thick,PointSize[0.01],g5}],Graphics[{Black,Thick,PointSize[0.01],g6}],Graphics[{Black,Thick,PointSize[0.01],g7}],Graphics[{MapThread[label,{{"
J
A
","
J
B
",
J
C
},{g10,g11,g12}}]}],Graphics[{MapThread[label,{{"
X
5
"},{g8}}]}],Graphics[{Brown,g9}]},AxesTrue,AxesOrigin{0,0},AspectRatioAutomatic,ImageSize700,PlotLabelStyle[Framed["Johnson's Circunconic"],16,Blue,BackgroundYellow]]​​​​​​​​
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[]:=
JohnsonCircunconic[tri={{-2,5},{7,12},{9,-4}},{-20,20},{-20,20}]
Information about Johnson's circunconic:
TypeEllipse,Equation-6.20737-9.37858x+1.
2
x
-4.1927y+0.337195xy+0.311426
2
y
0,Foci{{1.73795,13.9941},{6.08484,-4.76629}},Vertices{{1.38118,15.5339},{6.4416,-6.30602}},Covertices{{-1.67938,3.31851},{9.50216,5.90934}},Eccentricity0.858999,Center{3.91139,4.61392},SemimajorAxisLength11.2092,SemiminorAxisLength5.73889,AreaEnclosed202.094,SemiLatusRectum2.93818,Directrices{y16.4378+0.231705x,y-7.58149+0.231705x},AxesOfSymmetry{y21.4948-4.31583x,y3.70763+0.231705x},Circumference54.6401,RotationAngle-1.34311,BaseConicEquation0.0079588
2
x
+0.030363
2
y
1,RotationAngle-1.34311,DisplacementFromOrigin{3.91139,4.61392}
Out[]=