Kenmotu Point

Author

Eric W. Weisstein
November 17, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PlaneGeometry/KenmotuPoint.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/KenmotuPoint.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Code

KenmotuEdge[t_Triangle]:=2a b c/(a^2+b^2+c^2+4Area[t])/.Thread[{a,b,c}->SideLengths[Evaluate[t]]]
KenmotuRadius[t_Triangle]:=KenmotuEdge[t]/Sqrt[2]
KenmotuSquares[t_Triangle]:=Module[{i,k=KenmotuPoint[t],pos,pairs},
i=Flatten[Intersections[KenmotuCircle[t],#]&/@Sides[t]];
pos=Flatten[Position[Chop[Dot@@@Map[#-Coordinates[k]&,pairs=Subsets[Coordinates/@i,{2}],{2}]],0]];
Polygon/@({Coordinates[k],#[[1]],Coordinates[Reflection[k,Line[#]]],#[[2]]}&/@pairs[[pos]])
]

Graphic

t=Triangle[{{0,0},{1,0},{.5,.7}}];
Show[Graphics[{
t,
{Blue,KenmotuSquares[t]},
Circle[Coordinates[KenmotuPoint[t]],KenmotuRadius[t]],
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{KenmotuPoint[t],"Ke",Red}
}
],LabelOffset->.04]
}],AspectRatio->Automatic,PlotRange->All]

t=Triangle[{{0,0},{1,0},{.31,.7}}];
Show[Graphics[{
t,
{Blue,KenmotuSquares[t]},
Circle[Coordinates[KenmotuPoint[t]],KenmotuEdge[t]/Sqrt[2]],
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{KenmotuPoint[t],"Ke",Red}
}
],LabelOffset->.04]
}],AspectRatio->Automatic,PlotRange->All]

t=Triangle[{{0,0},{1,0},{.2,.7}}];
Show[Graphics[{
{Blue,KenmotuSquares[t]},
t,
Circle[Coordinates[KenmotuPoint[t]],KenmotuEdge[t]/Sqrt[2]],
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{KenmotuPoint[t],"Ke",Red}
}
],LabelOffset->.04]
}],AspectRatio->Automatic,PlotRange->All]

t=Triangle[{{0,0},{1,0},{.0001,.7}}];
Show[Graphics[{
{Blue,KenmotuSquares[t]},
t,
Circle[Coordinates[KenmotuPoint[t]],KenmotuEdge[t]/Sqrt[2]],
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{KenmotuPoint[t],"Ke",Red}
}
],LabelOffset->.04]
}],AspectRatio->Automatic,PlotRange->All]

t=Triangle[{{0,0},{1,0},{-.2,.7}}];
Show[Graphics[{
{Blue,KenmotuSquares[t]},
t,
Circle[Coordinates[KenmotuPoint[t]],KenmotuEdge[t]/Sqrt[2]],
PointLabels[Join[
Transpose[{VertexPoints[t],{"A","B","C"}}],
{
{KenmotuPoint[t],"Ke",Red}
}
],LabelOffset->.04]
}],AspectRatio->Automatic,PlotRange->All]