How to plot the given trihexagonal network?

Question

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.

related/possible duplicate: Drawing a Kagome lattice for given geometry — kglr, Jan 23 '21 at 05: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) — Phys96, Jan 23 '21 at 13:27

score 7 · Answer 1 · answered Jan 23 '21 at 05:43

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]]

kglr · Accepted Answer · 2021-01-23T15:59:53.603

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. – Phys96 Jan 23 '21 at 13:28 — Phys96, Jan 23 '21 at 13:28

How to plot the given trihexagonal network?

2 Answers2