How to create an hexagonal lattice structure

Question

Given an array of atoms A-B-A-B-A-B in an hexagonal pattern, how can I use Mathematica to create with an hexagonal lattice (infinite) with this array so each atom A is sorrounded only by B atoms and vice-versa.

Answer 1

In 2D

unitCell[x_, y_] := {
  Red
  , Disk[{x, y}, 0.1]
  , Blue
  , Disk[{x, y + 2/3 Sin[120 Degree]}, 0.1]
  , Gray,
  , Line[{{x, y}, {x, y + 2/3 Sin[120 Degree]}}]
  , Line[{{x, y}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]
  , Line[{{x, y}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}]
  }

This creates the unit cell

Graphics[unitCell[0, 0], ImageSize -> 100]  

We place it into a lattice

Graphics[
 Block[
  {
   unitVectA = {Cos[120 Degree], Sin[120 Degree]}
  ,unitVectB = {1, 0}
   }, Table[
   unitCell @@ (unitVectA j + unitVectB k)
   , {j, 1, 12}
   , {k, Ceiling[j/2], 20 + Ceiling[j/2]}
   ]
  ], ImageSize -> 500
 ]

---

In 3D

unitCell3D[x_, y_, z_] := {
  Red
  , Sphere[{x, y, z}, 0.1]
  , Blue
  , Sphere[{x, y + 2/3 Sin[120 Degree], z}, 0.1]
  , Gray
  , Cylinder[{{x, y, z}, {x, y +2/3 Sin[120 Degree], z}}, 0.05]
  , Cylinder[{{x, y, z}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2, 
     z}}, 0.05]
  , Cylinder[{{x, y, z}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2, 
     z}}, 0.05]
  }

Graphics3D[
 Block[
  {unitVectA = {Cos[120 Degree], Sin[120 Degree], 0}, 
   unitVectB = {1, 0, 0}
  }, 
  Table[unitCell3D @@ (unitVectA j + unitVectB k), {j, 20}, {k, 20}]]
 , PlotRange -> {{0, 10}, {0, 10}, {-1, 1}}
 ]

Answer 2

In 2D,

Manipulate[(
  basis = {{s, 0}, {s/2, s Sqrt[3]/2}};
  points = Tuples[Range[0, max], 2].basis;
  Graphics[Point[points], Frame -> True, AspectRatio -> Automatic])
 , {s, 0.1, 1}
 , {max, 2, 10}
 ]

Answer 3

Another way is to use GeometricTransformation, which might render faster, but is limited by $IterationLimit.

With[{base = Line[{
      {{-(1/2), -(1/(2 Sqrt[3]))}, {0, 0}}, 
      {{0, 0}, {0, 1/Sqrt[3]}}, 
      {{0, 0}, {1/2, -(1/(2 Sqrt[3]))}}
    }]
  },
  Graphics[{
    GeometricTransformation[
      base,
      Flatten@Array[
        TranslationTransform[
          {1/2, -(1/(2 Sqrt[3]))} + {#1 + 
            If[OddQ[#2], 1/2, 0], #2 Sqrt[3]/2}
        ] &, 
        {16, 16}
      ]
    ]
  }]
]

This does not work without increasing $IterationLimit when you replace {16, 16} by {128, 128}.

Answer 4

There are few resource functions that can help for making hexagonal grids. The code below is from the examples of HextileBins.

HextileBins

hexes2 = Keys[
   ResourceFunction["HextileBins"][
    Flatten[Table[{x, y}, {x, 0, 16}, {y, 0, 12}], 1], 2]];
Graphics[{EdgeForm[Blue], FaceForm[Opacity[0.1]], hexes2}]

lsBCoords = Union[Flatten[First /@ hexes2, 1]];

Graphics[{EdgeForm[Blue], 
  hexes2 /. Polygon[p_] :> Line[Append[p, First[p]]], Red, 
  PointSize[0.02], Point[lsBCoords]}]

HexagonalGridGraph

(Note that this function is submitted by Wolfram Research.)

grHex = ResourceFunction["HexagonalGridGraph"][{16, 12}]

lsVCoords = GraphEmbedding[grHex];
lsVCoords[[1 ;; 12]]

(* {{0, 0}, {0, 2}, {Sqrt[3], -1}, {Sqrt[3], 3}, {2 Sqrt[3], 0}, {Sqrt[
  3], 5}, {2 Sqrt[3], 2}, {2 Sqrt[3], 6}, {3 Sqrt[3], -1}, {3 Sqrt[3],
   3}, {2 Sqrt[3], 8}, {3 Sqrt[3], 5}} *)

grHexPolygons = 
  Map[Polygon@(List @@@ #)[[All, 1]] &, 
    FindCycle[grHex, {6, 6}, All]] /. v_Integer :> lsVCoords[[v]];
Graphics[{EdgeForm[Blue], FaceForm[Opacity[0.2]], grHexPolygons}]