Polykite

Author

Eric W. Weisstein
October 4, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/Polykite.nb.

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

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

Grid

Hexagon[x_]:=Line[x+#&/@(Through[{Cos,Sin}[Pi#/3]]&/@Range[0,6])]

HexagonalGrid[x_,y_]:=Module[{i,j},
Table[Hexagon[{3/2i,Sqrt[3]j+Mod[i,2]Sqrt[3]/2}],{i,x},{j,y}]
]

V5

Show[Graphics[{HexagonalGrid[7,5],
Table[Line[{{x,0},{x,11.5}}],{x,1.5,10,1.5}],
Table[Line[{{x,0},{x+19,11}}],{x,-15,20,3}],Table[Line[{{-x,0},{-(x+19),11}}],{x,-30,30,3}]
}],
AspectRatio->Automatic,PlotRange->{{.4,10},{2,10}}]

V6

Graphics[{HexagonalGrid[7,5],
Table[Line[{{x,0},{x,11.5}}],{x,1.5,10,1.5}],
Table[Line[{{x,0},{x+19,11}}],{x,-15,20,3}],Table[Line[{{-x,0},{-(x+19),11}}],{x,-30,30,3}]
},PlotRange->{{.4,10},{2,10}}]

Kite

With[{r=Sqrt[3]/2,R=1},
Solve[{x^2+y^2==R^2-r^2,(R-x)^2+y^2==r^2},{x,y}]
]

kite=With[{x=3/4,y=Sqrt[3]/4},2Reverse/@{{0,0},{x,y},{1,0},{x,-y}}];

MapIndexed[Text[#2[[1]],#]&,kite]

Graphics[{EdgeForm[Black],FaceForm[LightYellow],Polygon@kite,MapIndexed[Text[#2[[1]],#]&,kite]}]

poly

InputForm[%]

poly=Polygon[kite]

<<MathWorld`PlaneGeometry`

Area

Area[poly](a^2)

AreaMomentOfInertia

ineq=(Sqrt[3]) y≥3 x&&2 (Sqrt[3]) a≥x+(Sqrt[3]) y&&2 (Sqrt[3]) a+x≥(Sqrt[3]) y&&3 x+(Sqrt[3]) y≥0/.a->1

AreaInertiaTensor[ineq,{x,y}]

Centroid

RegionCentroid[poly]//FullSimplify

CircumcenterOfMass

CircumcenterOfMass[poly]

Circumcircle

circumcircle=Circumsphere[poly]//FullSimplify

Graphics[{EdgeForm[Black],FaceForm[LightYellow],poly,circumcircle}]

Convex

ConvexRegionQ[poly]

ConvexityCoefficient

MaxValue[(Sqrt[x^2+y^2]),{x,y}∈poly]

?ConvexityCoefficient

EdgeLengths

EuclideanDistance@@@Partition[poly[[1]],2,1,1]

GeneralizedDiameter

MaxValue[(Sqrt[x^2+y^2]),{x,y}∈poly]

Incircle

incircle=Insphere[poly]//FullSimplify

Graphics[{EdgeForm[Black],FaceForm[LightYellow],poly,incircle}]

Inequalities

Assuming[a>0,FullSimplify[Inequalities[poly,{x,y}]]]

InteriorAngles

$Version

poly=Polygon[{{0,0},{(((Sqrt[3]) a)/2),((3 a)/2)},{0,2 a},{-(((Sqrt[3]) a)/2),((3 a)/2)}}];

bug(434175): PolygonAngle[kite, "Interior"] gives different result from PolygonAngle[kite /. a -> 1, "Interior"]

PolygonAngle[poly]

PolygonAngle[poly,"Interior"]

PolygonAngle[poly/.a->1]

LineSegmentLengthMean

((Integrate[(Sqrt[x^2+y^2]),{x,y}∈poly])/(Area[poly]))//FullSimplify

Perimeter

Total[EuclideanDistance@@@Partition[poly[[1]],2,1,1]]/.a->1

RadiiOfGyration

RadiiOfGyration[ineq,{x,y}]//FullSimplify

Polykites

kite1[x_,y_]:={x,y}+#&/@({{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[-Pi/6].#&/@v)
kite2[x_,y_]:={x,y}+#&/@({{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[-Pi/2-Pi/3].#&/@v)
kite3[x_,y_]:={x,y}+#&/@({{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[-Pi/2].#&/@v)
kite4[x_,y_]:={x,y}+#&/@({{Cos[#],Sin[#]},{-Sin[#],Cos[#]}}&[Pi/2].#&/@v)

kite1=.

Show[GraphicsArray[
Graphics[Quadrilateral[#],AspectRatio->Automatic]&/@{kite1[0,0],kite2[0,0],kite3[0,0],kite4[0,0]}
]]

outline[x_]:={Quadrilateral[x],{Red,Polygon[x]}}

pk=Flatten[{
{{kite1[0,1.5]}},
{{kite1[0,0],kite2[Sqrt[3],0]},{kite2[3.5,0],kite3[3.5,0]}},
{{kite1[0,-2],kite2[Sqrt[3],-2],kite3[Sqrt[3],-2]},
{kite1[3,-2],kite2[3+Sqrt[3],-2],kite4[3+Sqrt[3]/2,-.5]},
{kite4[5+Sqrt[3]/2,-.5],kite2[5+Sqrt[3],-2],kite3[5+Sqrt[3],-2]},
{kite1[9,-2],kite2[9,-2],kite3[9,-2]}
}
},2];
Show[Graphics[{{Red,Polygon/@pk},Quadrilateral/@pk}
],AspectRatio->Automatic]