8
$\begingroup$

How can I create the hat polykite shape, also known as the "einstein" in mathematics?

enter image description here

$\endgroup$
2
  • $\begingroup$ For tilings also look at the Wolfram Function Repository function: HatHexagons $\endgroup$
    – SHuisman
    Commented Oct 11, 2023 at 15:35
  • 2
    $\begingroup$ See numerous related discussions: hat-1, hat-2, hat-3, hat-4, hat-5 $\endgroup$ Commented Oct 11, 2023 at 15:55

5 Answers 5

10
$\begingroup$

"HatPolykite" is also available in LaminaData:

hatpolykite = LaminaData["HatPolykite"];

hatpolykite["Diagram"]

enter image description here

The property "BoundaryMeshRegion" returns a function that gives a BoundaryMeshRegion as a function of a:

hatpolykite["BoundaryMeshRegion"]

enter image description here

For a = 1

hatpolykite["BoundaryMeshRegion"][1]

enter image description here

Similarly for the property "Vertices":

vertices = hatpolykite["Vertices"][1]

enter image description here

Show[hatpolykite["BoundaryMeshRegion"][1], 
 Graphics[{Red, PointSize@Large, Point /@ vertices}]]

enter image description here

$\endgroup$
8
$\begingroup$

This interesting topic can be exposed form various points of view allowing to have a better grasp of the subject. Rewriting vertices cyclically

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

we can plot the hat polykite without external information simply with

Graphics[ Line[vrts]]

We can elucidate several symmetries of the hat polykite on the various lattices of circles with different radii. First with a lattice of circles of radius $1$:

Graphics[{Thick, 
  Circle @@@ {{{0, 0}, 1}, {{2, 0}, 1}, {{1, Sqrt[3]}, 1}, {{4, 0}, 1},
    {{3, -Sqrt[3]}, 1}, {{3, Sqrt[3]}, 1}, {{-1, -Sqrt[3]}, 1},
    {{1, -Sqrt[3]}, 1}}, Red, Line[vrts]}]

enter image description here

or a denser lattice with more circles

Graphics[{Darker @ Magenta, 
  Circle @@@ {{{0, 0}, 1}, {{2, 0}, 1}, {{1, Sqrt[3]}, 1}, {{4, 0}, 1},
    {{3, -Sqrt[3]}, 1}, {{3, Sqrt[3]}, 1}, {{-1, -Sqrt[3]}, 1}, {{1,-Sqrt[3]}, 1}},
  Darker @ Cyan, 
  Circle @@@ {{{2, Sqrt[3]}, 1}, {{2, -Sqrt[3]}, 1}, {{1, 0}, 1}, 
    {{3, 0}, 1}, {{0, -Sqrt[3]}, 1}, {{0, Sqrt[3]}, 1}, {{-1, 0}, 1},
    {{-2, -Sqrt[3]}, 1}, {{4, -Sqrt[3]}, 1}}, 
  Darker @ Blue, Thickness[0.005], Line[vrts]}]

enter image description here

We need not restrict to circles of radius $1$, here we have circles of radii $2$ and $\sqrt{3}$:

Graphics[{Darker @ Magenta, 
  Circle @@@ {{{1, Sqrt[3]}, 2}, {{3, Sqrt[3]}, 2}, {{1, -Sqrt[3]}, 2},
    {{3, -Sqrt[3]}, 2}}, 
  Darker @ Cyan, 
  Circle @@@ {{{-(3/2), Sqrt[3]/2}, Sqrt[3]}, {{3/2, Sqrt[3]/2}, Sqrt[3]},
    {{3/2, -(Sqrt[3]/2)}, Sqrt[3]}, {{-(3/2), -(Sqrt[3]/2)}, Sqrt[3]}, 
    {{9/2, Sqrt[3]/2}, Sqrt[3]}, {{9/2, -(Sqrt[3]/2)}, Sqrt[3]}},
  Darker @ Blue, Thickness[0.005], Line[vrts]}]

enter image description here

$6$ vertices lie on any cyan circle of one or more hat polykites on the tiling of the plane.

$\endgroup$
7
$\begingroup$

Try this:

reg = Entity["Lamina", "HatPolykite"]["BoundaryDiagram"] // 
  BoundaryDiscretizeGraphics

enter image description here

The polygon coordinates are:

MeshPrimitives[reg, 0] /. Point[a_] :> a
$\endgroup$
7
  • $\begingroup$ Where did you get the word Lamina from? $\endgroup$ Commented Oct 11, 2023 at 12:44
  • $\begingroup$ It showed up when I started the query with = sign and entered hat polykite. $\endgroup$
    – Syed
    Commented Oct 11, 2023 at 12:46
  • $\begingroup$ To guess that word would take me much more time than figuring out coordinates of the shape by hand. I think more appropriate world would be Tile. $\endgroup$ Commented Oct 11, 2023 at 12:50
  • 3
    $\begingroup$ No need to guess anything, that's why there is Free-Form Input. For "hat polykite", it returns Entity["Lamina", "HatPolykite"]. $\endgroup$
    – Domen
    Commented Oct 11, 2023 at 12:53
  • 1
    $\begingroup$ It works correctly with "HatPolykite tile". Also, read the description for lamina at the MathWorld (Polygon), paragraph "While the "filled" usage ...". Lastly, I don't think the users' usage of the word matters here; these polygons are simply stored under the Lamina entity in the Wolfram Language. $\endgroup$
    – Domen
    Commented Oct 11, 2023 at 13:07
3
$\begingroup$

It's also easy to represent as an AnglePath

path = With[{t1 = 60 °, t2 = 90 °, r = Sqrt[3]},
   AnglePath[{{1, 0}, {1, t1}, {r, -t2}, {r, -t1}, {1, t2},
              {1, -t1}, {r, -t2}, {r, -t1}, {1, t2},
              {2, -t1}, {1, -t1}, {r, -t2}, {r, t1}}]];

Graphics[Line[path], AspectRatio -> 1, PlotRange -> {{-5, 5}, {-5, 5}}]
$\endgroup$
3
$\begingroup$
  • Use the lattice to directly draw the polygon( we start from {0,0}).
basis = {e1, e2, e3, e4, e5, e6} = CirclePoints[{1, 0}, 6];
lattice = 
  Tuples[{Range[0, 5], Range[0, 4], Range[0, 2], Range[0, 1], 
     Range[0, 1], Range[0, 1]}] . basis;
pts = FoldList[
   Plus, {0, 0}, {e1 + e1, e2, e1 + e6, e1 + e2, e3, e4, e3 + e2, 
    e3 + e4, e5, e4, e6 + e5, e5 + e4, e6}];
Graphics[{LightYellow, Polygon@pts, Green, AbsolutePointSize[5], 
  Arrow@Partition[pts, 2, 1, 1], Brown, Point /@ lattice}, 
 Axes -> True, Method -> {"AxesInFront" -> False}]

enter image description here

Clear[e1, e2, lattice, five, polys];
{e1, e2} = {AngleVector[0], AngleVector[π/3]};
lattice = Table[{i, j} . {e1, e2}, {i, -4, 4}, {j, -3, 4}];
five = Polygon[{{0, 0}, {0, -1}, {2, -2}, {3, -1}, {2, 0}} . {e1, e2}];
polys = {five, 
   TransformedRegion[five, 
    RotationTransform[π, {0, -1} . {e1, e2}]], 
   TransformedRegion[five, 
    RotationTransform[(2 π)/3, {0, 0} . {e1, e2}]], 
   TransformedRegion[five, 
    ReflectionTransform[RotationTransform[π/2]@e2, {0, 0}]]};
Graphics[{{RandomColor[], #} & /@ polys, Point /@ lattice}]

enter image description here

reg = RegionUnion[BoundaryDiscretizeGraphics /@ polys];
Graphics[{LightYellow, reg, Green, 
  MeshPrimitives[reg, 1] /. Line -> Arrow}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.