How to plot the given graph (irregular tri-hexagonal) with Mathematica?
Edit
Another effect by use ParametricPlot
a = 1;
{p1, p2, p3} = SSSTriangle[3/2 a, a, a][[1]];
e1 = p2 - p1;
e2 = p3 - p1;
fig = ParametricPlot[{u, v} . {e1, e2}, {u, 0, 10}, {v, 0, 10},
MeshFunctions -> {#3 &, #4 &, #3 + #4 - 1 &},
Mesh -> {Range[0, 20, 2]}, PlotPoints -> 80, Axes -> False,
Frame -> False,
MeshShading ->
ArrayReshape[ColorData[114, "ColorList"], {2, 2, 2}]];
pts = ParametricPlot[{u, v} . {e1, e2}, {u, 0, 10}, {v, 0, 10},
MeshFunctions -> {#3 &, #4 &, #3 + #4 - 1 &},
Mesh -> {Range[0, 20, 2]}, PlotStyle -> None, Axes -> False,
Frame -> False, BoundaryStyle -> None, PlotPoints -> 100] //
Graphics`Mesh`FindIntersections;
Show[fig, Graphics[{PointSize[Large], Black, Point[pts]}]]
Updated
a = 1;
SSSTriangle[3/2 a, a, a];
{p1, p2, p3} = %[[1]];
lines1 = Table[
TranslationTransform[i*2 (p2 - p1)][
InfiniteLine[{p1, p3}]], {i, -5, 5}];
lines2 = Table[
TranslationTransform[i*2 (p3 - p1)][
InfiniteLine[{p1, p2}]], {i, -5, 5}];
lines3 = Table[
TranslationTransform[i*2 (p2 - p1)][
InfiniteLine[{p2, p3}]], {i, -5, 5}];
points1 = Outer[RegionIntersection[{#1, #2}] &, lines1, lines2];
points2 = Outer[RegionIntersection[{#1, #2}] &, lines2, lines3];
points3 = Outer[RegionIntersection[{#1, #2}] &, lines3, lines1];
Graphics[{lines1, lines2, lines3, Red, PointSize[Large], points1,
points2, points3}, PlotRange -> 5]
Original
a = 1;
SSSTriangle[3/2 a, a, a];
{p1, p2, p3} = %[[1]]
Graphics[{Table[
TranslationTransform[i*2 (p2 - p1)][
InfiniteLine[{p1, p3}]], {i, -5, 5}],
Table[TranslationTransform[i*2 (p3 - p1)][
InfiniteLine[{p1, p2}]], {i, -5, 5}],
Table[TranslationTransform[i*2 (p2 - p1)][
InfiniteLine[{p2, p3}]], {i, -5, 5}]}, PlotRange -> 5]
Update: We can generalize the method in the original answer to make the side length a parameter:
ClearAll[angleList, anglePath, hexaGon, hexTile]
angleList[α_] := TriangleMeasurement[SSSTriangle[α, 1, 1], {"InteriorAngle", All}]
angleList[α]
{ArcCos[1 - α^2/2], ArcCos[Sqrt[α^2]/2], ArcCos[Sqrt[α^2]/2]}
anglePath[α_] := FullSimplify @ AnglePath[Prepend[{1, 0}] @
PadRight[Thread[{{1, α, 1}, angleList[α]}], 5, "Periodic"]]
hexaGon[α_] := {Black, Line[anglePath[α]], Red, PointSize @ Large, Point @ anglePath[α]}
Examples:
Row[{Graphics[hexaGon[1], ImageSize -> 1 -> 100, PlotLabel -> Style["α = 1", 16]],
Graphics[hexaGon[3/2], ImageSize -> 1 -> 100, PlotLabel -> Style["α = 3/2", 16]],
Graphics[hexaGon[5/4], ImageSize -> 1 -> 100, PlotLabel -> Style["α = 5/4", 16]],
Graphics[hexaGon[2/3], ImageSize -> 1 -> 100, PlotLabel -> Style["α = 2/3", 16]]},
Spacer[20]]
hexTile[α_, nc_, nr_, opts : OptionsPattern[]] :=
Module[{tr = Subtract @@ anglePath[α][[{1, 4}]]},
Graphics[Table[Translate[hexaGon[α],
{2 i - j First[tr], -j Last[tr]}], {i, nc}, {j, 0, nr - 1}],
opts, ImageSize -> Large]]
Examples:
hexTile[1, 7, 5]
hexTile[3/2, 7, 5]
hexTile[5/4, 7, 5]
hexTile[2/3, 7, 5]
Original answer:
angles = TriangleMeasurement[SSSTriangle[3/2, 1, 1], {"InteriorAngle", All}]
{ArcCos[-(1/8)], ArcCos[3/4], ArcCos[3/4]}
We can use angles
and desired lengths (1
, 3/2
and 1
) with AnglePath
to get the coordinates of desired hexagon primitive:
anglepath = FullSimplify @ AnglePath[Prepend[{1, 0}] @
PadRight[Thread[{{1, 3/2, 1}, angles}], 5, "Periodic"]];
hex = {Line @ anglepath, Red, PointSize @ Large, Point @ anglepath};
Graphics[hex]
We get the desired picture using translations of hex
:
Graphics[Table[Translate[hex, {2 i - j/4, j 3 Sqrt[7]/4}], {i, 5}, {j, 0, 5}]]
Graphics[Table[Translate[hex, {2 i - j/4, j 3 Sqrt[7]/4}], {i, 10}, {j, 0, 4}],
ImageSize -> Large]