# Creating hexagonal grid (hexagonal grid graph)

Is there a function that can create hexagonal grid?

We have square grid graph, where we can specify m*n dimensions:

GridGraph[{m, n}]


We have triangular grid graph (which works only for argument n up to 10 - for unknown reason):

GraphData[{"TriangularGrid", n}, "Graph"]


I can not find a function that would generate a hexagonal grid graph. I would like it like it is with GridGraph something like HexagonalGridGraph[{m,n,o}] where m,n,o are dimensions m*n*o of planar graph - or other way said - "lengths" of the sides of the graph.

I can make my own code, I am asking just in case there already exist implemented function.

UPDATE:

What I mean by m*n*o hexagonal grid is for example this 3*5*7 hexagonal grid:

My code for producing it is very long and cumbersome so I will not upload it unless I can make it simpler.

• HexagonalGridGraph resource function Commented Oct 8, 2020 at 11:20
• @C.E. You're right, that was a bad fit. Well, I recalled that this question had been asked already several times and just picked the first hit in search results. Was a bad idea. I am sorry. Commented Oct 8, 2020 at 11:39
• @LouisB: Nice but it lacks generality because we can have m*n*o hexagonal grids, the function can produce only m*n*1 grids. See image I uploaded. Commented Oct 8, 2020 at 12:39
• Possible duplicate: mathematica.stackexchange.com/questions/230017/… Commented Oct 8, 2020 at 13:34
• @LouisB So.. Anyone CAN create their own ResourceFunction[] .. and Wolfram will never make define HexagonalGridGraph[] mathworld.wolfram.com/HexagonalGridGraph.html ? Commented Apr 3, 2022 at 7:27

With IGraph/M:

IGMeshGraph@IGLatticeMesh["Hexagonal", {6, 4}]


We can also crop it to a hexagon:

IGMeshGraph@IGLatticeMesh["Hexagonal", Polygon@CirclePoints[10, 6]]


It can also generate many other kinds of lattices, not just hexagonal.

• Can it also make 3x5x7 hexagonal grid? Like IGMeshGraph@IGLatticeMesh["Hexagonal", {3, 5, 7}]? Because it is possible to have not only "rectangular hexagonal grid" but also "hexagonal hexagonal grid", where we can have three pairs of sides of distinct length. Like 3x5x7x3x5x7. Commented Oct 8, 2020 at 12:03
• See image I uploaded - can it do such a grid? Commented Oct 8, 2020 at 12:41
• @azerbajdzan You can crop an infinite lattice it to any shape, you just have to specify the shape: szhorvat.net/mathematica/IGDocumentation/#iglatticemesh Commented Oct 8, 2020 at 13:47

Here is my generalization of the code from link provided by @LouisB:

HexagonalGridGraph2[{wide1_Integer?Positive, wide2_Integer?Positive,
wide3_Integer?Positive}, opts : OptionsPattern[Graph]] :=
Module[{cells, edges, vertices},
cells =
Flatten[Table[
CirclePoints[{Sqrt[3] (1 j + k - 2 ) + Sqrt[3] (1 j + l - 2 ),
3 k - 2 - 3 l}, {2, \[Pi]/2}, 6], {j, wide1}, {k, wide2}, {l,
wide3}], 2];
edges = Union[Sort /@ Flatten[Partition[#, 2, 1, 1] & /@ cells, 1]];
vertices = Union[Flatten[edges, 1]];
IndexGraph[
Graph[UndirectedEdge @@@ edges, opts,


And here are some examples:

Sort /@ Tuples[Range[4], {3}] // Union;
Partition[
Rasterize /@ (HexagonalGridGraph2[#, PlotLabel -> #,
ImageSize -> {100, 100}] & /@ %), 5];
ImageAssemble[%]


• Instead of Sort /@ Tuples[Range[4], {3}] // Union, look into the IntegerPartitions function Commented Oct 11, 2020 at 12:20

We can generate the vertex coordinates using a slightly modified version of azerbajdan's cells and use them with NearestNeighborGraph:

ClearAll[vCoords]
vCoords = DeleteDuplicates @ Flatten[
Table[CirclePoints[{(2 j + k + l - 4) Sqrt[3] , 3 k - 2 - 3 l}, {2, π/2}, 6],
{j, #}, {k, #2}, {l, #3}], 3] &;

ClearAll[hexGridGraph]
hexGridGraph = Module[{v = vCoords @@ #},
NearestNeighborGraph[v, ##2, VertexCoordinates -> v]] &;


Examples:

hexGridGraph[{3, 5, 7},
VertexLabels -> Placed["Index", Center],
VertexSize -> .7,
VertexStyle -> White,
VertexLabelStyle -> 8,
ImageSize -> 400]


args = Sort /@ Tuples[Range[4], {3}] // Union;

hexGridGraph[#, PlotLabel -> #, ImageSize -> {100, 100}] & /@ args //
Multicolumn[#, 5] &


## Edit-7

θ = π/2;
vertexs = CirclePoints[{Sqrt[3]/3, π/2 + θ}, 3];
coordinate[{λ1_, λ2_, λ3_}] :=
1/(λ1 + λ2 + λ3) {λ1, λ2, λ3} . vertexs;
{a, b, c} = {6, 2, 5};
δ = 3;
n = Total[{a, b, c}] + δ;
coords = {{b, n - b, 0}, {0, n - b, b}, {0, c, n - c}, {c, 0,
n - c}, {n - a, 0, a}, {n - a, a, 0}};
pts = coordinate /@
Select[Tuples[{Range[0, n - a], Range[0, n - b], Range[0, n - c]}],
Total@# == n &];
polys = CirclePoints[#, {1/(Sqrt[3] n), π/2 + θ}, 6] & /@
pts;
graph = MeshConnectivityGraph[
Line /@ Partition[#, 2, 1, 1] & /@ polys // Graphics //
DiscretizeGraphics, PlotTheme -> "LargeGraph"];
g = Graphics[{Cyan, Polygon[coordinate /@ coords], Red, Point@pts}];
GraphicsRow[{g, graph}]


## Edit-6

To truncated the equilateral triangle,we use the idea of TernaryListPlot.

Clear["Global*"];
{p, q, r} = {4, 7, 8};
L = 9;
n = p + q + r + L;
unit = 1/n;
{a, b, c} = {p - 2, q - 2, r - 2}*unit;
data = Complement[
Flatten[Table[{u, 1 - u - w, w}, {u, 0, 1, unit}, {w, 0, 1 - u,
unit}], 1],
Flatten[{Table[{u, 1 - u - w, w}, {u, 0, a, unit}, {w, 1 - a, 1,
unit}], Table[{u, v, 1 - u - v}, {u, 1 - b, 1, unit}, {v, 0, b,
unit}],
Table[{1 - v - w, v, w}, {v, 1 - c, 1, unit}, {w, 0, c, unit}]},
2]];
ternarylistplot =
TernaryListPlot[data,
Prolog -> {Polygon[{{a, 0, 1 - a}, {1 - b, 0, b}, {1 - b, b,
0}, {c, 1 - c, 0}, {0, 1 - c, c}, {0, a, 1 - a}}], Blue,
Polygon[{{a, 0, 1 - a}, {1 - b, 0, b}, {1 - b, b, 0}, {a, b,
1 - a - b}}], Green,
Polygon[{{1 - b, b, 0}, {c, 1 - c, 0}, {0, 1 - c, c}, {1 - b - c,
b, c}}], Yellow,
Polygon[{{0, 1 - c, c}, {0, a, 1 - a}, {a, 0, 1 - a}, {a,
1 - a - c, c}}], Red,
Polygon[{{1, 0, 0}, {1 - b, b, 0}, {1 - b, 0, b}}],
Polygon[{{0, 1, 0}, {0, 1 - c, c}, {c, 1 - c, 0}}],
Polygon[{{0, 0, 1}, {a, 0, 1 - a}, {0, a, 1 - a}}]}];
ternary[{p1_, p2_, p3_}] := {p1 + 1/2 p2, Sqrt[3]/2 p2};
pts = ternary /@ data;
polys = CirclePoints[#, {1/(Sqrt[3] n), π/2}, 6] & /@ pts;
graph = MeshConnectivityGraph[
Line /@ Partition[#, 2, 1, 1] & /@ polys // Graphics //
DiscretizeGraphics, PlotTheme -> "LargeGraph"];
Labeled[GraphicsRow[{ternarylistplot, graph}], {n - p - q, q,
n - q - r, r, n - r - p, p}]


## Edit-5

Try to directly to construct the type {L + c, b, L + a, c, L+ b, a} where a,b,c are positive integers and L is a non-negative integer(when L==0 then the type become {c,b,a,c,b,a} is the original type {c,b,a}.

Clear["Global*"];
e = {e1, e2, e3, e4, e5, e6} = CirclePoints[{1, 0}, 6];
L = 9;
{a, b, c} = {4, 7, 8};
triangle =
Flatten[Table[{i, k - i} . {e1, e2}, {k, 0, L}, {i, 0, k}], 1];
parallelogram1 =
Flatten[Table[{L, 0} . {e1, e2} + {i, j} . {e1, e3}, {i, 1, c}, {j,
0, L + a}], 1];
parallelogram2 =
Flatten[Table[{0, L} . {e1, e2} + {i, j} . {e3, e5}, {i, 1, a}, {j,
0, L + b}], 1];
parallelogram3 =
Flatten[Table[{0, 0} . {e1, e2} + {i, j} . {e5, e1}, {i, 1, b}, {j,
0, L + c}], 1];
graphics =
Graphics[{Red, Point /@ triangle, Blue, Point /@ parallelogram1,
Green, Point /@ parallelogram2, Brown, Point /@ parallelogram3}];
pts = Join[triangle, parallelogram1, parallelogram2, parallelogram3];
vor = VoronoiMesh[pts];
graph = MeshPrimitives[VoronoiMesh[pts], {2, "Interior"}] //
Graphics // DiscretizeGraphics // MeshConnectivityGraph;
Labeled[GraphicsRow[{graphics, graph}], {L + c, b, L + a, c, L + b,
a}]


Edit-4

Besides of type {m,n,o},here we want to find the type {n[1],n[2],n[3],n[4],n[5],n[6]}. Simple calculate, for example

Solve[Array[n, 6] . CirclePoints[{0, 0}, {1, 0}, 6] == 0,
Array[n, 6], PositiveIntegers]


We can find that it satisfy two equations.

{n[1] - n[4] + n[2] - n[5] == 0, n[2] - n[5] + n[3] - n[6] == 0}


( so {m,n,o,m,n,o} always satisfy this relation)

e[1] = AngleVector[0];
e[3] = AngleVector[2 π/3];
e[2] = e[1] + e[3];
e[4] = -e[1];
e[5] = -e[2];
e[6] = -e[3];
sol = Simplify[
SolveValues[Array[n, 6] . Array[e, 6] == {0, 0}, Array[n, 6],
PositiveIntegers][[1]], Array[C, 5] ∈ PositiveIntegers];
type = sol /. Thread[Array[C, 5] -> RandomInteger[{1, 10}, 5]]
bd = Accumulate@
Catenate[MapThread[ConstantArray, {Array[e, 6], type - 1}]];
reg = BoundaryMeshRegion[bd,
Line /@ {##, #1} & @@ Partition[Range@Length@bd, 2, 1, 1]];
allpts = Tuples[Range[0, 2 Max@type], 2] . {e[1], e[3]};
pts = Pick[allpts, RegionMember[reg]@allpts];
Graphics[{EdgeForm[Blue], FaceForm[],
RegularPolygon[#, {1/Sqrt[3], π/2}, 6] & /@ pts, Red, Point@bd}]


{12, 10, 11, 15, 7, 14}

Edit-3

{m, n, o} = {3, 5, 7};
Graphics[{EdgeForm[Blue], FaceForm[],
RegularPolygon[#, {1, 0},
6] & /@ (Sqrt[
3] SolveValues[{0 <= x <= o - 1, 0 <= y <= n - 1,
0 <= z <= m - 1, x == 0 || y == 0 || z == 0}, {x, y, z},
Integers] . CirclePoints[{1, Pi/6}, 3])}]

{x, y, z} = {7, 5, 3};
bases = CirclePoints[{1, 30 Degree}, 3];
coordinates =
Catenate[{Tuples[{Range[0, x - 1], Range[0, y - 1], {0}}],
Tuples[{Range[1, x - 1], {0}, Range[1, z - 1]}],
Tuples[{{0}, Range[0, y - 1], Range[1, z - 1]}]}];
Graphics[{EdgeForm[Blue], FaceForm[],
RegularPolygon[#, {1, 0}, 6] & /@ (Sqrt[3]*coordinates . bases)}]


Edit-2

The ideal comes from 3D.

Graphics3D[Cuboid[], BoxRatios -> {5, 7, 3}, Boxed -> False,
ViewProjection -> "Orthographic", ViewPoint -> {2.0, -1.7, 2.0}]


{eX, eY, eZ} = CirclePoints[{1, 30 Degree}, 3];
{x, y, z} = {7, 5, 3};
(*{x,y,z}={8,8,8};*)
pXY = Sqrt[3] Tuples[{Range[x] - 1, Range[y - 1]}] . {eX, eY};
pYZ = Sqrt[3] Tuples[{Range[y] - 1, Range[z - 1]}] . {eY, eZ};
pZX = Sqrt[3] Tuples[{Range[z] - 1, Range[x - 1]}] . {eZ, eX};
Graphics[{EdgeForm[White], Red, RegularPolygon[#, {1, 0}, 6] & /@ pXY,
Green, RegularPolygon[#, {1, 0}, 6] & /@ pYZ, Blue,
RegularPolygon[#, {1, 0}, 6] & /@ pZX, Black, Point[pXY],
PointSize[Medium], Point[pYZ], PointSize[Large], Point[pZX]}]


Edit-1

If we introduce three coordinates {x1,y1,z1} and three bases e1,e2,e3 instead of just two coordinates and two bases, the construction of the type {m, n, o} = {3, 5, 7} is relatively easy.

{m, n, o} = {3, 5, 7};
eM = AngleVector[90 Degree];
eN = AngleVector[150 Degree];
eO = AngleVector[30 Degree];
pts = Sqrt[3] Tuples[Range /@ {m, n, o}] . {eM, eN, eO} // Union;
Graphics[{EdgeForm[White],
Table[RegularPolygon[p, {1, 0}, 6], {p, pts}], Red, Point[pts]}]


Graphics[{EdgeForm[Blue], FaceForm[],
Table[RegularPolygon[p, {1, 0}, 6], {p, pts}], Red, Point[pts],
Riffle[{Red, Green, Blue}, Arrow[{{0, 0}, 2 #}] & /@ {eM, eN, eO}]}]


• n[6]-n[3]==n[4]-n[1]==n[2]-n[5] Commented Sep 16, 2023 at 15:02

You can make a hexagonal grid using only MMA built in functions. You may adapt the code to your liking:

c3 = Cos[30 Degree]; s3 = Sin[30 Degree];
del1 = {Sqrt[c3^2 + Sqrt[(1 + s3^2)^2 + c3^3]], c3} // N;
del2 = {-Sqrt[c3^2 + Sqrt[(1 + s3^2)^2 + c3^3]], c3} // N;
del3 = {0, 2 c3};
trans[del_] := Map[(del + #) &, hex, {2}];
n = 3;
grid = Flatten[
Table[trans[i1 del1 + i2 del2 + i3 del3], {i1, n}, {i2, n}, {i3,
n}], 2];
Graphics[Line /@ grid]


There is a resource function that makes hexagonal graphs: HexagonalGridGraph. (Contributed by WRI.)

• will WRI go for mathworld.wolfram.com/HexagonalGridGraph.html ? Commented Apr 3, 2022 at 7:30
• @p._phidot_ you should be sending this kind of feedback directly to WRI instead of leaving it in comments where they are less likely to be seen and addressed. Commented Jul 24, 2022 at 13:36

Looks like there's an undocumented function GraphComputationHexagonalGridGraph. I don't know what version it first appeared, but I see it in V13.3:

GraphComputationHexagonalGridGraph[{10, 6}]