JapaneseTheoremOfAQuadrilateralInscribedInACircle::usage="
​ By triangular an arbitrary cyclic quadrilateral through its diagonals, four overlappiing triangles are obtained (each diagonal create two triangles). The centers of the inscribed circles of these triangles form a rectangle. To make sure they are concyclic points, we will take them from Conway's circumference. References: Wataru Uegaki: [​[hdl:10076/4917|\"Japanese Theoremの起源と歴史\"]​] (On the Origin and History of the Japanese Theorem). Departmental Bulletin Paper, Mie University Scholarly E-Collections, 2001-03-01; Personal.";
Conway circle:
In[]:=
ConwayCircle[tri={{x1_,y1_},{x2_,y2_},{x3_,y3_}}]:=​​Module{},Test=Det[{{x1,y1,1},{x2,y2,1},{x3,y3,1}}];​​IfTest==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=
c11
c11+a1
;xAc=x1+
x2-x1
r1
;yAc=y1+
y2-y1
r1
;r2=
c11
c11+b11
;xBc=x2+
x1-x2
r2
;yBc=y2+
y1-y2
r2
;​​r3=
a1
b11+a1
;xBa=x3+
x1-x3
r3
;yBa=y3+
y1-y3
r3
;r4=
a1
a1+c11
;xCa=x1+
x3-x1
r4
;yCa=y1+
y3-y1
r4
;​​r5=
a1
a1+b11
;​​xAb=
r5x3-x2
r5-1
;yAb=
r5y3-y2
r5-1
;r6=
b11
b11+c11
;xCb=x2+
x3-x2
r6
;yCb=y2+
y3-y2
r6
;​​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[{{
PointA
c
,
PointB
c
,
PointA
a
,
PointC
a
,
PointB
b
,
PointC
b
},{N[Bc],N[Ac],N[Ba],N[Ca],N[Ab],N[Cb]}},ItemSize15,ItemStyle15,FrameAll];​​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]}},ItemSize15,ItemStyle15,FrameAll];​​Print[m];​​Print[" "];​​label[sym_,Point[pos_]]:={PointSize[Scaled[0.018]],Hue[1,1,1],Point[pos],Text[Style[sym,White,FontSizeScaled[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","
B
c
","
A
c
","
A
a
","
C
a
","
B
b
","
C
b
","In"},{Point[A],Point[B],Point[C1],Point[Ac],Point[Bc],Point[Ba],Point[Ca],Point[Ab],Point[Cb],Point[I1]}}]}]},AxesTrue,BoxRatiosAutomatic,AxesOrigin{0,0},ImageSize900,PlotRangeAll]
In[]:=
ConwayCircle[tri={{-2,5},{7,12},{9,-4}}]
The coordinates of the concyclic points are:
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}
The center and radius of the Conway's circle (red colored):
Center
Radius
{4.06947,4.92508}
21.21
Out[]=
Japanese Theorem:
We will take the points: Aa, Ac, Bc and Cb:
In[]:=
Ac={xBc,yBc};Aa={xBa,yBa};Bc={xAc,yAc};Cb={xCb,yCb};​​tri1={Aa,Cb,Ac};​​tri2={Aa,Bc,Cb};tri3={Ac,Aa,Bc};tri4={Ac,Bc,Cb};​​α1=TriangleCenter[tri1,"Incenter"];​​xi1=α1[[1]];​​yi1=α1[[2]];​​In1={xi1,yi1};​​α11=TriangleMeasurement[tri1,"Inradius"];​​ri1=α11;​​α2=TriangleCenter[tri2,"Incenter"];​​xi2=α2[[1]];​​yi2=α2[[2]];​​In2={xi2,yi2};​​α22=TriangleMeasurement[tri2,"Inradius"];​​ri2=α22;​​α3=TriangleCenter[tri3,"Incenter"];​​xi3=α3[[1]];​​yi3=α3[[2]];​​In3={xi3,yi3};​​α33=TriangleMeasurement[tri3,"Inradius"];​​ri3=α33;​​α4=TriangleCenter[tri4,"Incenter"];​​xi4=α4[[1]];​​yi4=α4[[2]];​​In4={xi4,yi4};​​α44=TriangleMeasurement[tri4,"Inradius"];​​ri4=α44;​​Lado1=Norm[In1-In3];Lado2=Norm[In2-In4];Lado3=Norm[In3-In2];Lado4=Norm[In1-In4];​​V1=In3-In1;V2=In2-In3;V3=In4-In2;V4=In1-In4;​​Print[" "];​​Print[PasteButton["Verification that it is a rectangle:"]];​​Print[" "];​​z=Grid[
In
1
In
3
,
In
2
In
4
,
In
3
In
2
,
In
1
In
4
,
Vector
In
1
In
3
.
Vector
In
3
In
2
,
Vector
In
2
In
4
.
Vector
In
4
In
1
,{N[Lado1],N[Lado2],N[Lado3],N[Lado4],N[V1.V2],N[V3.V4]},ItemSize15,ItemStyle15,FrameAll];​​Print[z];​​Print[" "];​​​​label[sym_,Point[pos_]]:={PointSize[Scaled[0.018]],Hue[1,1,1],Point[pos],Text[Style[sym,White,FontSizeScaled[0.012]],pos]};​​Show[{​​Graphics[{Red,Thick,Circle[I1,rcirc]}],Graphics[{LightBlue,EdgeForm[{Thick,Black}],Polygon[{Ac,Aa,Bc,Cb}]}],Graphics[{Black,Thick,Line[{Ac,Bc}]}],Graphics[{Black,Thick,Line[{Aa,Cb}]}],​​Graphics[{Black,Thick,Dashed,Circle[In1,ri1]}],Graphics[{Black,Thick,Dashed,Circle[In2,ri2]}],Graphics[{Black,Thick,Dashed,Circle[In3,ri3]}],Graphics[{Black,Thick,Dashed,Circle[In4,ri4]}],​​Graphics[{LightBlue,Opacity[0.01],EdgeForm[{Thick,Black,Dashed}],Polygon[{In1,In3,In2,In4}]}],​​Graphics[{MapThread[label,{{"Ac","
A
a
","
B
c
","
C
b
","
In
1
","
In
2
","
In
3
","
In
4
"},{Point[Ac],Point[Aa],Point[Bc],Point[Cb],Point[In1],Point[In2],Point[In3],Point[In4]}}]}]},AxesTrue,BoxRatiosAutomatic,AxesOrigin{0,0},ImageSize900,PlotRangeAll]
*It is due to the accuracy of the calculations, but it can be considered as zero.