In[]:=
JapaneseTheoremOfAPolygonInscribedInACircle::usage=" The sum of the radii of the green circles is equal to the sum of the radii of the red circles. To make sure they are concyclic points, we will take them from Conway's circumference. References: Hayashi, T. Sur un soi-disant théorème chinois. Matesis 6,pp.24-26, 1985; Personal.";
Conway circle:
In[]:=
ConwayCircle[tri={{x1_,y1_},{x2_,y2_},{x3_,y3_}}]:=Module{},Test=Det[{{x1,y1,1},{x2,y2,1},{x3,y3,1}}];IfTest==0,Print[PasteButton["It's not a triangle"]],A={x1,y1};B={x2,y2};C1={x3,y3};c11=Norm[A-B];b11=Norm[B-C1];a1=Norm[A-C1];r1=;xAc=x1+;yAc=y1+;r2=;xBc=x2+;yBc=y2+;r3=;xBa=x3+;yBa=y3+;r4=;xCa=x1+;yCa=y1+;r5=;xAb=;yAb=;r6=;xCb=x2+;yCb=y2+;Ac={xAc,yAc};Bc={xBc,yBc};Ba={xBa,yBa};Ca={xCa,yCa};Ab={xAb,yAb};Cb={xCb,yCb};γ=TriangleCenter[tri,"Incenter"];xin=γ[[1]];yin=γ[[2]];I1={xin,yin};γ1=TriangleMeasurement[tri,"Inradius"];rin=γ1;rcirc=Norm[I1-Ab];Print[" "];Print[PasteButton["The coordinates of the concyclic points are:"]];Print[" "];l=Grid[{{,,,,,},{N[Bc],N[Ac],N[Ba],N[Ca],N[Ab],N[Cb]}},ItemSize15,ItemStyle15,FrameAll];Print[l];Print[" "];Print[PasteButton["The center and radius of the Conway's circle (red colored):"]];Print[" "];m=Grid[{{Center,Radius},{N[I1],N[rcirc]}},ItemSize15,ItemStyle15,FrameAll];Print[m];Print[" "];label[sym_,Point[pos_]]:={PointSize[Scaled[0.018]],Hue[1,1,1],Point[pos],Text[Style[sym,White,FontSizeScaled[0.012]],pos]};Show[{Graphics[{LightYellow,EdgeForm[{Thick,Black}],Polygon[{A,B,C1}]}],Graphics[{Black,Thick,Circle[I1,rin]}],Graphics[{Red,Thick,Circle[I1,rcirc]}],Graphics[{Black,Thick,Dashed,Line[{B,Ab}]}],Graphics[{Black,Thick,Dashed,Line[{B,Ac}]}],Graphics[{Black,Thick,Dashed,Line[{A,Ba}]}],Graphics[{Black,Thick,Dashed,Line[{A,Bc}]}],Graphics[{Black,Thick,Dashed,Line[{C1,Ca}]}],Graphics[{Black,Thick,Dashed,Line[{C1,Cb}]}],Graphics[{MapThread[label,{{"A","B","C","","","","","","","In"},{Point[A],Point[B],Point[C1],Point[Ac],Point[Bc],Point[Ba],Point[Ca],Point[Ab],Point[Cb],Point[I1]}}]}]},AxesTrue,BoxRatiosAutomatic,AxesOrigin{0,0},ImageSize900,PlotRangeAll]
c11
c11+a1
x2-x1
r1
y2-y1
r1
c11
c11+b11
x1-x2
r2
y1-y2
r2
a1
b11+a1
x1-x3
r3
y1-y3
r3
a1
a1+c11
x3-x1
r4
y3-y1
r4
a1
a1+b11
r5x3-x2
r5-1
r5y3-y2
r5-1
b11
b11+c11
x3-x2
r6
y3-y2
r6
PointA
c
PointB
c
PointA
a
PointC
a
PointB
b
PointC
b
B
c
A
c
A
a
C
a
B
b
C
b
In[]:=
ConwayCircle[tri={{-2,5},{7,12},{9,-4}}]
PointA c | PointB c | PointA a | PointC a | PointB b | PointC b |
{-14.7279,-4.89949} | {18.2188,20.7257} | {-14.4797,15.2107} | {17.8245,-11.22} | {5.23714,26.1029} | {10.4142,-15.3137} |
Center | Radius |
{4.06947,4.92508} | 21.21 |
Out[]=
Japanese Theorem:
We will take all the points:
We will take all the points:
In[]:=
Ac={xBc,yBc};Bc={xAc,yAc};Aa={xBa,yBa};Ca={xCa,yCa};Bb={xAb,yAb};Cb={xCb,yCb};tri1v={Ac,Aa,Bb};tri2v={Ac,Bb,Cb};tri3v={Cb,Bb,Ca};tri4v={Bb,Bc,Ca};tri1r={Aa,Bb,Bc};tri2r={Aa,Bc,Ca};tri3r={Ac,Aa,Ca};tri4r={Ac,Cb,Ca};α1v=TriangleCenter[tri1v,"Incenter"];xi1v=α1v[[1]];yi1v=α1v[[2]];In1v={xi1v,yi1v};α11v=TriangleMeasurement[tri1v,"Inradius"];ri1v=α11v;α2v=TriangleCenter[tri2v,"Incenter"];xi2v=α2v[[1]];yi2v=α2v[[2]];In2v={xi2v,yi2v};α22v=TriangleMeasurement[tri2v,"Inradius"];ri2v=α22v;α3v=TriangleCenter[tri3v,"Incenter"];xi3v=α3v[[1]];yi3v=α3v[[2]];In3v={xi3v,yi3v};α33v=TriangleMeasurement[tri3v,"Inradius"];ri3v=α33v;α4v=TriangleCenter[tri4v,"Incenter"];xi4v=α4v[[1]];yi4v=α4v[[2]];In4v={xi4v,yi4v};α44v=TriangleMeasurement[tri4v,"Inradius"];ri4v=α44v;α1r=TriangleCenter[tri1r,"Incenter"];xi1r=α1r[[1]];yi1r=α1r[[2]];In1r={xi1r,yi1r};α11r=TriangleMeasurement[tri1r,"Inradius"];ri1r=α11r;α2r=TriangleCenter[tri2r,"Incenter"];xi2r=α2r[[1]];yi2r=α2r[[2]];In2r={xi2r,yi2r};α22r=TriangleMeasurement[tri2r,"Inradius"];ri2r=α22r;α3r=TriangleCenter[tri3r,"Incenter"];xi3r=α3r[[1]];yi3r=α3r[[2]];In3r={xi3r,yi3r};α33r=TriangleMeasurement[tri3r,"Inradius"];ri3r=α33r;α4r=TriangleCenter[tri4r,"Incenter"];xi4r=α4r[[1]];yi4r=α4r[[2]];In4r={xi4r,yi4r};α44r=TriangleMeasurement[tri4r,"Inradius"];ri4r=α44r;Print[" "];Print[PasteButton["Verification that the sum of the radii is constant in each case:"]];Print[" "];z=Grid[{{GreenSum,RedSum},{N[ri1v+ri2v+ri3v+ri4v],N[ri1r+ri2r+ri3r+ri4r]}},ItemSize15,ItemStyle15,FrameAll];Print[z];Print[" "];label[sym_,Point[pos_]]:={PointSize[Scaled[0.018]],Hue[1,1,1],Point[pos],Text[Style[sym,White,FontSizeScaled[0.012]],pos]};Show[{Graphics[{Black,Thick,Circle[I1,rcirc]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Black}],Polygon[{Ac,Aa,Bb,Bc,Ca,Cb}]}],Graphics[{Green,Thick,Circle[In1v,ri1v]}],Graphics[{Green,Thick,Circle[In2v,ri2v]}],Graphics[{Green,Thick,Circle[In3v,ri3v]}],Graphics[{Green,Thick,Circle[In4v,ri4v]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Green}],Polygon[tri1v]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Green}],Polygon[tri2v]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Green}],Polygon[tri3v]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Green}],Polygon[tri4v]}],Graphics[{MapThread[label,{{"","","","","",""},{Point[Bc],Point[Ba],Point[Ab],Point[Ac],Point[Ca],Point[Cb]}}]}]},AxesTrue,BoxRatiosAutomatic,AxesOrigin{0,0},ImageSize900,PlotRangeAll]Show[{Graphics[{Black,Thick,Circle[I1,rcirc]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Black}],Polygon[{Ac,Aa,Bb,Bc,Ca,Cb}]}],Graphics[{Red,Thick,Circle[In1r,ri1r]}],Graphics[{Red,Thick,Circle[In2r,ri2r]}],Graphics[{Red,Thick,Circle[In3r,ri3r]}],Graphics[{Red,Thick,Circle[In4r,ri4r]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Red}],Polygon[tri1r]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Red}],Polygon[tri2r]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Red}],Polygon[tri3r]}],Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Red}],Polygon[tri4r]}],Graphics[{MapThread[label,{{"","","","","",""},{Point[Bc],Point[Ba],Point[Ab],Point[Ac],Point[Ca],Point[Cb]}}]}]},AxesTrue,BoxRatiosAutomatic,AxesOrigin{0,0},ImageSize900,PlotRangeAll]
A
c
A
a
B
b
B
c
C
a
C
b
A
c
A
a
B
b
B
c
C
a
C
b