# How to plot the given trihexagonal network?

Following my previous question

How to plot the given graph (irregular tri-hexagonal) with Mathematica?

I need a 2D network of the Fig. $$a$$, something like Fig. $$b$$ with red points on all vertices. Since I have drawn Fig. $$b$$ manually, it is not precise and symmetric. In this case, the blue and the violet edges have different lengths.

• @cvgmt Here it is. Regards. Jan 23, 2021 at 3:10
• related/possible duplicate: Drawing a Kagome lattice for given geometry
– kglr
Jan 23, 2021 at 5:25
• @kglr I had seen that question, but the answers given there were all for the regular case (for the case the graph has only one length) Jan 23, 2021 at 13:27

We can construct a hexagon with short edges (with length 1) and long edges (with length β >= 1) using AnglePath as follows:

ClearAll[diamondcoords, diamond]

diamondcoords[β_: 1] := AnglePath @
Thread[{{1, β, 1, β, 1, β}, {0, 1, 1, 1, 1, 1} 2 Pi / 6}]

diamond[β_: 1] := {AbsoluteThickness[10], CapForm["Round"],
MapIndexed[{{Red, Blue}[[Mod[#2[[1]], 2, 1]]], Line @ #} &,
Partition[diamondcoords[β], 2, 1]],
Gray, AbsolutePointSize @ 7, Point @ diamondcoords[β]}


With default value (β = 1) we get a regular hexagon:

Row[{Graphics[diamond[], ImageSize -> Medium],
Graphics[diamond[2], ImageSize -> Medium],
Graphics[diamond[4], ImageSize -> Medium]}]


We translate diamond[β] to get a tiling of desired size:

ClearAll[translations]
translations[n_] := Prepend[{0, 0}][Join @@
(Thread[{Range[-#, #, 2], -# }] & /@ Range[n])]

Graphics[Translate[diamond[],
-# {1/2, 1} (Subtract @@@ CoordinateBounds[diamondcoords[]])] & /@ translations[5],
ImageSize -> Large]


Graphics[Translate[diamond[2],
-# {1/2,1} (Subtract @@@ CoordinateBounds[diamondcoords[2]])] & /@ translations[7],
ImageSize -> Large]


Graphics[Translate[diamond[3],
-# {1/2, 1} (Subtract@@@CoordinateBounds[diamondcoords[3]])] & /@translations[5],
ImageSize -> Large]


Graphics[Translate[diamond[1/3],
-# {1/2, 1} (Subtract@@@CoordinateBounds[diamondcoords[1/3]])] & /@ translations[5],
ImageSize -> Large]


• Thanks, this was what I meant. Jan 23, 2021 at 13:28
cp = CirclePoints[6];
hexagon = {EdgeForm[Black], FaceForm[], Polygon@cp, Red, PointSize@Large, Point@cp};
Graphics[hexagon]


ClearAll[translations]
translations[n_] := Prepend[{0, 0}][Join @@
(Thread[{Range[-#, #, 2], -# Sqrt[3]}] & /@ Range[n])];

Graphics[Translate[hexagon, #] & /@ translations[5]]


Graphics[Translate[hexagon, #] & /@ translations[10]]