Hat Polykite

Author

Eric W. Weisstein
May 3, 2024

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Tilings/HatPolykite.nb.

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

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

Figure

Import["https://arxiv.org/pdf/2303.10798.pdf",{"PageGraphics",2}]

Import["https://arxiv.org/pdf/2303.10798.pdf","Elements"]

Entity

LaminaData["HatPolykite"]

LaminaData["HatPolykite","Dataset"]

Construction

<<MathWorld`Graphs`

v=Delete[CirclePoints[{(Sqrt[3]),Pi/2},6],2];
v=Join[{{0,0}},v,Delete[CirclePoints[{2,Pi/2-30Degree},6],List/@{2,3}]];
v=DeleteDuplicates@Join[v,SimilarityTransform[v,{{7,2},{7,6}},{1,6,7,2}]];//Quiet
v=FullSimplify@DeleteDuplicates@Join[v,SimilarityTransform[v,{{12,7},{6,10}},{11,12,7,6}]];//Quiet
v=DeleteDuplicates@FullSimplify@Join[v,SimilarityTransform[v,{{15,14},{5,14}},{13,6,14,15}]];//Quiet
v=DeleteDuplicates@FullSimplify@Join[v,SimilarityTransform[v,{{14,5},{14,13}},{14,13,10,5}]]//Quiet

v={{0,0},{0,(Sqrt[3])},{-(3/2),-((Sqrt[3])/2)},{0,-(Sqrt[3])},{(3/2),-((Sqrt[3])/2)},{(3/2),((Sqrt[3])/2)},{1,(Sqrt[3])},{-1,-(Sqrt[3])},{1,-(Sqrt[3])},{2,0},{3,(Sqrt[3])},{(3/2),((3 (Sqrt[3]))/2)},{3,0},{3,-(Sqrt[3])},{(9/2),-((Sqrt[3])/2)},{4,0}};

f={{1,6,7,2},{1,5,10,6},{1,4,9,5},{1,3,8,4},{12,7,6,11},{11,6,10,13},{13,10,5,14},{16,13,14,15}};

Graphics[{
FaceForm[LightYellow],EdgeForm[Black],Polygon[v,f],
PointSize[Large],Point[v],
MapIndexed[Text[#2[[1]],#,-2{1,1},Background->White]&,v]
}]

f={{1,6,7,2},{1,5,10,6},{1,4,9,5},{1,3,8,4},{12,7,6,11},{11,6,10,13},{13,10,5,14},{16,13,14,15}};
v={{0,0},{0,(Sqrt[3])},{-(3/2),-((Sqrt[3])/2)},{0,-(Sqrt[3])},{(3/2),-((Sqrt[3])/2)},{(3/2),((Sqrt[3])/2)},{1,(Sqrt[3])},{-1,-(Sqrt[3])},{1,-(Sqrt[3])},{2,0},{3,(Sqrt[3])},{(3/2),((3 (Sqrt[3]))/2)},{3,0},{3,-(Sqrt[3])},{(9/2),-((Sqrt[3])/2)},{4,0}};
v2=v[[{8,9,5,14,15,16,13,11,12,7,2,1,3}]];
GraphicsRow[Graphics[{FaceForm[LightYellow],EdgeForm[Black],#}]&/@{Polygon[v,f],Polygon[v2]}]

bound=BoundaryMeshRegion[Polygon[v,f]]

Properties

lamina="HatPolykite";

poly=Polygon[v2]

poly=Polygon[];

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

Area

Entity["Lamina",lamina]["Area"][a]

Area[poly](a^2)

AreaMomentOfInertiaTensor

Entity["Lamina",lamina]["AreaMomentOfInertiaTensor"][a]

Integrate[AreaInertiaMatrix[{x,y},"CoordinateSystem"->"Cartesian"],{x,y}∈poly]//FullSimplify

Centroid

Entity["Lamina",lamina]["Centroid"][a]

RegionCentroid[poly]//FullSimplify

CircumcenterOfMass

Entity["Lamina",lamina]["CircumcenterOfMass"][a]

CircumcenterOfMass[poly]

Graphics[{EdgeForm[Black],FaceForm[LightYellow],poly,PointSize[.02],Point[{3/2,-1/4}]},Axes->True]

tris=Polygon[Append[#,ctr={3/2,-(1/(16 (Sqrt[3])))}]]&/@Partition[poly[[1]],2,1,1]

Graphics[{EdgeForm[Black],FaceForm[LightYellow],tris,PointSize[.02],Point[ctr]},Axes->True]

CircumcenterOfMass[poly,ctr]//FullSimplify

CircumcenterOfMass[poly,{3/2,-1/4}]//FullSimplify

Circumcircle

Entity["Lamina",lamina]["Circumcircle"]

circumcircle=Circumsphere[poly]//FullSimplify

Classes

Entity["Lamina",lamina]["Classes"]

Convex

Entity["Lamina",lamina]["Convex"]

ConvexRegionQ[poly]

ConvexityCoefficient

Entity["Lamina",lamina]["ConvexityCoefficient"]

EdgeLengths

Entity["Lamina",lamina]["EdgeLengths"][a]

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

GeneralizedDiameter

Entity["Lamina",lamina]["GeneralizedDiameter"][a]

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

Graphics

Entity["Lamina",lamina]["Graphics"]

Incircle

Entity["Lamina",lamina]["Incircle"]

incircle=Insphere[poly]//FullSimplify

Inequalities

Entity["Lamina",lamina]["Inequalities"]

InteriorAngles

Entity["Lamina",lamina]["InteriorAngles"][a]

PolygonAngle[poly]/Pi

Internal edges

v

f

mutipoly=Polygon[v,f];

g1=Graphics[{FaceForm[LightYellow],EdgeForm[Black],mutipoly}]

outerpoly=Polygon[v[[rim={8,4,9,5,14,15,16,13,11,12,7,2,1,3}]]];

g2=Graphics[{FaceForm[LightYellow],EdgeForm[Black],outerpoly,MapIndexed[Text[#2[[1]],v[[#]]]&,rim]}]

alledges=Sort[Sort/@Join@@(Partition[#,2,1,1]&/@f)]

outeredges=Sort[Sort/@Partition[rim,2,1,1]]

interioredgeindices=Complement[alledges,outeredges]

interiorlines=Line[v[[#]]&/@interioredges]

Graphics[{FaceForm[LightYellow],EdgeForm[Black],outerpoly,Blue,interiorlines}]

LineSegmentLengthMean

Entity["Lamina",lamina]["LineSegmentLengthMean"][a]

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

FullSimplify[i]

N[i1=(1/4917248)(-39102 (Sqrt[3]) ArcCosh[2]+290304 (Sqrt[7]) ArcCoth[(5/(Sqrt[7]))]-21376 (Sqrt[7]) ArcCsch[(2/(Sqrt[3]))]-60480 (Sqrt[7]) ArcCsch[3 (Sqrt[3])]-21376 (Sqrt[7]) ArcSinh[(2/(Sqrt[3]))]+7 (285376+134505 (Sqrt[3])+4320 (Sqrt[7])) Log[3]+246960 (Sqrt[3]) Log[1+(2/(Sqrt[3]))]+207858 (Sqrt[3]) Log[-3+2 (Sqrt[3])]+64 (9604 (-1+(Sqrt[3])+2 (Sqrt[21]))+1323 (Sqrt[7]) Log[(1/9) (16-5 (Sqrt[7]))]-14406 (Sqrt[3]) Log[-2+(Sqrt[7])]-945 (Sqrt[7]) Log[2+(Sqrt[7])]+57624 Log[3+(Sqrt[21])]-9604 Log[69984 (5+(Sqrt[21]))]+334 (Sqrt[7]) Log[(1/6) (6+7 (Sqrt[3])+(Sqrt[21 (7+4 (Sqrt[3]))]))]))]

N[i2=(1/4917248)(-39102 (Sqrt[3]) ArcCosh[2]+290304 (Sqrt[7]) ArcCoth[(5/(Sqrt[7]))]-21376 (Sqrt[7]) ArcCsch[(2/(Sqrt[3]))]-60480 (Sqrt[7]) ArcCsch[3 (Sqrt[3])]-21376 (Sqrt[7]) ArcSinh[(2/(Sqrt[3]))]+7 (285376+134505 (Sqrt[3])+4320 (Sqrt[7])) Log[3]+246960 (Sqrt[3]) (Log[(Sqrt[3])+2]-(1/2)Log[3])+207858 (Sqrt[3]) Log[-3+2 (Sqrt[3])]+64 (9604 (-1+(Sqrt[3])+2 (Sqrt[21]))+1323 (Sqrt[7])(- 2Log[3]+Log[16-5 (Sqrt[7])])-14406 (Sqrt[3]) Log[-2+(Sqrt[7])]-945 (Sqrt[7]) Log[2+(Sqrt[7])]+57624 Log[3+(Sqrt[21])]-9604(5Log[2]+7Log[3]+Log[5+(Sqrt[21])])+334 (Sqrt[7]) (-Log[6 ]+Log[6+7 (Sqrt[3])+(Sqrt[21 (7+4 (Sqrt[3]))])])))]

i3=TrigToExp[i2]

N[i3]

N[i4=-(1/8)+((Sqrt[3])/8)+((Sqrt[21])/4)-((5 Log[2])/8)-((15 Log[3])/32)+((2385 (Sqrt[3]) Log[3])/14336)-((621 Log[3])/(3136 (Sqrt[7])))-((167 Log[6])/(5488 (Sqrt[7])))-((135 (Log[2(Sqrt[ 7])+1]-(3/2)Log[3]))/(1568 (Sqrt[7])))-((167 (Log[(Sqrt[7])+2]-(1/2)Log[3]))/(5488 (Sqrt[7])))+((303 (Sqrt[3]) Log[2+(Sqrt[3])])/7168)+((303 (Sqrt[3]) Log[-3+2 (Sqrt[3])])/7168)+((27 Log[16-5 (Sqrt[7])])/(224 (Sqrt[7])))-((81 (Log[5-(Sqrt[7])]-Log[5]))/(392 (Sqrt[7])))+((81( Log[5+(Sqrt[7])]-Log[5]))/(392 (Sqrt[7])))-((167 (Log[(Sqrt[3])+(Sqrt[7])]-Log[2]))/(5488 (Sqrt[7])))-(3/16) (Sqrt[3]) Log[-2+(Sqrt[7])]-((135 Log[2+(Sqrt[7])])/(1568 (Sqrt[7])))+(3/4) Log[3+(Sqrt[21])]-(1/8) Log[5+(Sqrt[21])]+((167 Log[6+7 (Sqrt[3])+(Sqrt[21 (7+4 (Sqrt[3]))])])/(5488 (Sqrt[7])))]

i5=Expand[i4]//FullSimplify

N[%]

Table[(((1+(Sqrt[7])))^n),{n,5}]//Expand

Table[(((1+2(Sqrt[7])))^n),{n,5}]//Expand

Table[(((2+(Sqrt[7])))^n),{n,5}]//Expand

N[i6=(1/76832)(9604 (-1+(Sqrt[3])+2 (Sqrt[21]))-28 (1715+81 (Sqrt[7])) Log[2]-(36015+5459 (Sqrt[7])) Log[3]+1323 (Sqrt[7]) Log[16-5 (Sqrt[7])]+(14406 (Sqrt[3])-1279 (Sqrt[7])) Log[2+(Sqrt[7])]+4536 (Sqrt[7]) Log[5+(Sqrt[7])]-945 (Sqrt[7]) Log[1+2 (Sqrt[7])]+57624 Log[3+(Sqrt[21])]-9604 Log[5+(Sqrt[21])]-167 (Sqrt[7]) (Log[2]+Log[5+(Sqrt[21])])+334 (Sqrt[7]) Log[6+7 (Sqrt[3])+(Sqrt[21 (7+4 (Sqrt[3]))])])]

Expand[i6]

ParameterRange

corners=MinMax/@Transpose[poly[[1]]]

Graphics[{EdgeForm[Black],FaceForm[LightYellow],poly,PointSize[.02],Blue,Point[Transpose@corners]},Axes->True]

Perimeter

Entity["Lamina",lamina]["Perimeter"][a]

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

RadiiOfGyration

Entity["Lamina",lamina]["RadiiOfGyration"]

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

Region

Entity["Lamina",lamina]["Region"][a]

RightAngleCount

Entity["Lamina",lamina]["RightAngleCount"][a]

Count[PolygonAngle[poly],Pi/2]

Vertices

Entity["Lamina",lamina]["Vertices"][a]

poly[[1]]