4
$\begingroup$

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.

enter image description here

Improve this question
$\endgroup$
3
  • $\begingroup$ @cvgmt Here it is. Regards. $\endgroup$
    – Phys96
    Commented Jan 23, 2021 at 3:10
  • $\begingroup$ related/possible duplicate: Drawing a Kagome lattice for given geometry $\endgroup$
    – kglr
    Commented Jan 23, 2021 at 5:25
  • 1
    $\begingroup$ @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) $\endgroup$
    – Phys96
    Commented Jan 23, 2021 at 13:27

2 Answers 2

Reset to default
7
$\begingroup$

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

enter image description here

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]

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thanks, this was what I meant. $\endgroup$
    – Phys96
    Commented Jan 23, 2021 at 13:28
7
$\begingroup$ 
cp = CirclePoints[6];
hexagon = {EdgeForm[Black], FaceForm[], Polygon@cp, Red, PointSize@Large, Point@cp};
Graphics[hexagon]

enter image description here

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


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

enter image description here

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

enter image description here

Improve this answer
$\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.