# Arbitrary lattice graph in 2D

My purpose is to generate a graph representing a lattice, where the vertices are essentially the lattice sites. This lattice has to be periodic. That means the opposite boundaries are identical.
MWE for a square lattice:

nx = 5;
ny = 5;
DistributeDefinitions[nx, ny];
mat = (# + Transpose[#]) &[
ArrayFlatten[
ParallelTable[
KroneckerDelta[Mod[xi + 1, nx, 1], xj] KroneckerDelta[yi, yj] +
KroneckerDelta[Mod[yi + 1, ny, 1], yj] KroneckerDelta[xi,
xj], {xi, nx}, {xj, nx}, {yi, ny}, {yj, ny}]]];


This essentially generates a periodic square lattice.
Now we can put a lattice site between two adjacent sites at one of the edges, which is shown in the below graph. To illustrate, there is 3 between 1 and 2, which was previously missing in the square lattice.
One can change this number from one to two, as shown below. Actually, this number can change, which I refer to as arbitrary (in the heading). Is there a single piece of code that can generate all of these kinds of lattices? Unfortunately, I have to write a single piece of code for each of them. Importantly, there are periodic boundaries shown with red along the $$y$$-axis and black along the $$. x$$-axis

NEW EDIT:
After useful comments from @flinty, @David and @kglr. My update MWE:

ClearAll[nx, ny, mat, gph, nv, edgeA, i, j, nv, edgeA];
{nx, ny} = {4, 4};
gph = AdjacencyGraph[mat, VertexLabels -> Automatic];

nv[g_, v_, k_] := VertexList[NeighborhoodGraph[g, v]][[k]];
edgeA[m_, g_, v_, k_] :=
g, {nv[g, v, 1] \[UndirectedEdge] Length[m] + 2 k + v^2 - 1,
Length[m] + 2 k + v^2 - 1 \[UndirectedEdge] nv[g, v, k + 1]}];
vertexA[m_, g_, v_, k_] :=
EdgeDelete[
edgeA[m, g, v, k], {nv[g, v, 1] \[UndirectedEdge] nv[g, v, k + 1]}];
checkA[m_, g_, v_, k_] :=
If[(v < Length[VertexList[NeighborhoodGraph[g, 1]]] - 1 \[And]
v == k) \[Or] (nv[g, v, 1] < nv[g, v, k + 1]),
vertexA[m, g, v, k], Nothing];

DistributeDefinitions[mat, gph, checkA, nv, edgeA];

ParallelTable[
checkA[mat, gph, i, j], {i, 1, Length[mat] - 1}, {j, 1,
Length[VertexList[NeighborhoodGraph[gph, 1]]] - 1}]


This actually generates a graph that has added vertex between each pair of adjacent vertices. However, this only generates a different graph, the idea is to update the original graph, and to equip it with these changes. Can we do this?

• Perhaps a double periodic lattice might be represented as a TorusGraph since both sides wrap around? e.g ResourceFunction["TorusGraph"][{10, 4}] Jul 1, 2021 at 18:08
• @flinty This might work for square type tilling but can we also do it for the one I showed in my questions by tweaking some parameters maybe? Jul 1, 2021 at 18:32
• I would start with @flinty's TorusGraph solution and then use AddEdge (in an iterated loop) to add edges along one of the component graph (circular) paths. Jul 1, 2021 at 23:57
• Step by step: g = Graph[{1 <-> 2, 2 <-> 3}, VertexLabels -> "Name"], EdgeDelete[g, 1 <-> 2],h = VertexAdd[g, 4],k = EdgeAdd[h, {1 <-> 4, 4 <-> 2}]. Hope this helps. Jul 2, 2021 at 17:21
• an aside: you can use Prepend[v]@AdjacencyList[g, v] instead of VertexList[NeighborhoodGraph[g, v]]
– kglr
Jul 6, 2021 at 2:44

We can add a second argument to TorusGraph to specify the number of segments between nodes with integer coordinates in each dimension:

ClearAll[torusGraph]
torusGraph[dims : {__Integer}, segs: {__Integer} : {1, 1},
opts : OptionsPattern[Graph]] := Module[{m = Length[dims], tg},
tg = Graph[Flatten[Array[Table[Rule @@@
Partition[Function[x, Mod[{##} + UnitVector[m, i] x, dims, 1]] /@
Subdivide[segs[[i]]], 2, 1], {i, m}] &, dims, 1]], opts,
DirectedEdges -> False];
IndexGraph @ Graph[Sort@VertexList[tg], EdgeList[tg],
VertexCoordinates -> ScalingTransform[{1, -1}][
RotationTransform[-Pi/2] @ Sort @ VertexList[tg]], opts,
VertexLabels -> "Index", EdgeShapeFunction -> "CurvedArc"]]


Examples:

Default number of segments between original sites is 1:

torusGraph[{4, 5}, ImageSize -> 400]


Add a node in the middle of horizontal edges:

torusGraph[{4, 5}, {1, 2}, ImageSize -> 400]


Add two nodes on horizontal and 1 node on vertical edges:

g0 = torusGraph[{4, 5}, {2, 3}, ImageSize -> 500]


HighlightGraph[g0,
VertexList[g0, _?(Nand @@ (IntegerQ /@ PropertyValue[{g0, #}, VertexCoordinates]) &)]]


Make the edges straight lines:

torusGraph[{4, 5}, {2, 3}, EdgeShapeFunction -> "Line", ImageSize -> 500]


Used curved edges to indicate periodic boundaries:

SetProperty[g0, EdgeShapeFunction ->
(If[ManhattanDistance @@ #[[{1, -1}]] > 1,
GraphElementData["CurvedArc"][##],
GraphElementData["Line"][##]] &)]


Use a custom EdgeShapeFunction to indicate periodic boundaries:

ClearAll[periodicEdges, eSF]
periodicEdges[off_: 50] := Module[{vc = Sort[#[[{1, -1}]]],
offset = off Unitize[Subtract @@ Sort[#[[{1, -1}]]]]},
Arrow[{vc[[1]], Offset[- offset, vc[[1]]]}],
Arrow[{vc[[2]], Offset[ offset, vc[[2]]]}]}] &

eSF = If[ManhattanDistance @@ #[[{1, -1}]] > 1, periodicEdges[][#],
GraphElementData["Line"][##]] &;

torusGraph[{4, 5}, EdgeShapeFunction -> eSF]


torusGraph[{4, 5}, {2, 3}, EdgeShapeFunction -> eSF, ImageSize -> 500]


• Billion thanks @kglr! You have fully answered the problem in its full glory :) Just a naive question, can we also implement, for instance, a hexagonal lattice and then add vertices similarly? Jul 6, 2021 at 14:05
• @Shamina, my pleasure. ResourceFunction[TorusGraph] was easy to modify to get the desired result. If you have a similar function that generates a hexagonal lattice it may be possible to modify it in a similar way.
– kglr
Jul 6, 2021 at 14:13
• @Shamina You can use IGraphM to generate a periodic triangular lattice (which gives you a hexagonal neighborhood). I suppose that then would be easy to apply the method by kglr. Jul 6, 2021 at 16:01
• If you want to simply add vertices as subdivisions along the hexagonal lattice vectors, then note that's the same as the rectangular lattice topology @kglr showed above - and then use the hexagonal lattice vectors to transform VertexCoordinates. Jul 6, 2021 at 16:11
• @Shamina, if you are content with the solutions, it is a good practice to accept them as "answered" if you haven't already Jul 6, 2021 at 18:56

## Edit 03

Here's a function to wrap all this up and answer the latest questions in the comments.
Some utility functions:

makePeriodicLattice2D[pts_, {sizeH_, sizeV_}] :=
With[{d = ArrayDepth[pts]},
Transpose[
Mod[#1, #2, -#2/2] &, {Transpose[pts,
RotateLeft[Range[d]]], {sizeH, sizeV}}],
RotateRight[Range[d]]]]
makePeriodicCartesian2D[pts_, {sizeH_, sizeV_}, latticeVectors_] :=
With[{inv = Inverse[latticeVectors]},
makePeriodicLattice2D[pts . inv, {sizeH, sizeV}] . latticeVectors]

periodicDistanceLatticePair[{x1_, x2_}, {sizeH_, sizeV_}] :=
With[{d = ArrayDepth[x1]},
Map[Norm,
makePeriodicLattice2D[
Outer[Subtract, x1, x2, 1], {sizeH, sizeV}], {d}]]
periodicDistanceCartesianPair[{x1_, x2_}, {sizeH_, sizeV_},
latticeVectors_] :=
With[{d = ArrayDepth[x1]},
Map[Norm,
makePeriodicCartesian2D[Outer[Subtract, x1, x2, 1], {sizeH, sizeV},
latticeVectors], {d}]]

Map[Boole[0 < # <= r] &, mat, {2}]


Main function:

periodicLatticeGraph[latticeVecs_,
motif_, {horizontalExtent_, verticalExtent_}, bondsMatrix_] :=
Block[{latt, pdm, gg},
latt = Tuples[{Range[-horizontalExtent, horizontalExtent - 1],
Range[-verticalExtent, verticalExtent - 1]}];
latt = # . latticeVecs & /@ Outer[Plus, motif, latt, 1];

pdm = ArrayFlatten[
2 {horizontalExtent, verticalExtent},
latticeVecs], #2] &, {Partition[Tuples[latt, 2],
Length[motif]], bondsMatrix}, 2]];
gg = AdjacencyGraph[pdm, VertexCoordinates -> Join @@ latt,
EdgeShapeFunction -> "CurvedArc"]]


and the rectangular example again with different horizontal/vertical extents and a curved EdgeShapeFunction to illustrate it's indeed periodic:

periodicLatticeGraph[
{{1, 0}, {0, 3/4}},
{{0, 0}, {1/3, 0}, {2/3, 0}},
{4, 2},
ReplacePart[ConstantArray[1/2, {3, 3}], {1, 1} -> 3/4]]


A hexagonal lattice with (2,1) subdivisions along the lattice vectors

periodicLatticeGraph[{{1/2,-Sqrt[3]/2},{1/2,Sqrt[3]/2}},N[{{0,0},{0,1/2},{1/3,0},{2/3,0}}],{3,3},ReplacePart[ConstantArray[0.1,{4,4}],{{1,2},{2,1},{1,3},{3,1},{1,4},{4,1},{3,4},{4,3}}->0.5]]


and just for fun, a graphene (honeycomb) lattice:

periodicLatticeGraph[{{1/2,-Sqrt[3]/2},{1/2,Sqrt[3]/2}},N[{{0,0},{1/3,2/3}}],{3,3},ReplacePart[ConstantArray[1/Sqrt[2],{2,2}],{1,1}->0.1]]


## Edit 02

Perhaps what you're looking for can be achieved using a lattice motif and a block periodic distance matrix (think of it like making a crystal lattice with different types of atoms and then specifying different 'bond lengths'). Here's an example:

First, let's change the periodicDistance functions to accept two sets of lattice points:

periodicDistanceLatticePair[{x1_, x2_}, size_] :=
With[{d = ArrayDepth[x1]},
Map[Norm,
makePeriodicLattice[Outer[Subtract, x1, x2, 1], size], {d}]]
periodicDistanceCartesianPair[{x1_, x2_}, size_, latticeVectors_] :=
With[{d = ArrayDepth[x1]},
Map[Norm,
makePeriodicCartesian[Outer[Subtract, x1, x2, 1], size,
latticeVectors], {d}]]


make a lattice using the motif ((0,0),(1/2,0))

latticeVectors["rect"]=latticeConstant{{1,0},{0,3/4}};
motif["rect"]={{0,0},{1/2,0}};
lattice["rect"]=#.latticeVectors["rect"]&/@Outer[Plus,motif["rect"],lattice["rect"],1];


and then compute the periodic distance matrix block-wise, i.e. (top-left, A-A, bond-length 3/4 a), (top-right, A-B, bond-length 1/2 a), (bottom-left, B-A, bond-length 1/2 a), (bottom-right, B-B, bond-length 1/2 a), where A,B denote the different motif atoms and a is the lattice constant:

pdm["rect"]=ArrayFlatten[MapThread[linked[periodicDistanceCartesianPair[#1,2 latticeRadius,latticeVectors["rect"]],#2]&,{Partition[Tuples[lattice["rect"],2],2],latticeConstant{{3/4,1/2},{1/2,1/2}}},2]];
VertexDegree[gg["rect"]]//Tally
HighlightGraph[gg["rect"],NeighborhoodGraph[gg["rect"],Position[Join@@lattice["rect"],{1/2,0}][[1,1]]]]


{{4, 36}, {2, 36}}

## Edit 01

In response to a comment about identifying nearest-neighbors not based on cartesian distance, I realized it's actually much simpler to construct the adjacency graph in the lattice domain.

E.g. for a rectangular lattice:

latticeVectors["rect"]=latticeConstant{{1,0},{0,1/4}};
VertexDegree[gg["rect"]]//Tally
HighlightGraph[gg["rect"],NeighborhoodGraph[gg["rect"],Position[lattice["rect"],{2,0}][[1,1]]]]


{{4,36}}

## Original Post

Not sure I understood your question correctly, especially the part about adding vertices along edges to augment the lattice.

However, the following builds arbitrary periodic lattice graphs in n dimensions (well, at-least 2 and 3). Tested with primitive unit cells (i.e. one atom per unit-cell), but should be easy to extend to a lattice with a motif.

The idea is to generate a lattice of points, and then compute the adjacency matrix of the graph using a periodic distance matrix. I suspect there's many ways to do this, here I just using Mod in the regular lattice domain and then transform back to the cartesian domain.

makePeriodicLattice[pts_, size_] := Mod[pts, size, -size/2 ]
makePeriodicCartesian[pts_, size_, latticeVectors_] :=
With[{inv = Inverse[latticeVectors]},
Mod[pts . inv, size, -size/2 ] . latticeVectors]

periodicDistanceLattice[x_, size_] :=
With[{d = ArrayDepth[x]},
Map[Norm,
makePeriodicLattice[Outer[Subtract, x, x, 1], size], {d}]]
periodicDistanceCartesian[x_, size_, latticeVectors_] :=
With[{d = ArrayDepth[x]},
Map[Norm,
makePeriodicCartesian[Outer[Subtract, x, x, 1], size,
latticeVectors], {d}]]


Finally, let's define some utility functions and constants to make the adjacency graph:

linked[mat_?MatrixQ, r_?Positive] := Map[Boole[0 < # <= r] &, mat, {2}]
latticeConstant = 1;


## Examples

### Hexagonal Lattice (2D)

latticeVectors["hexagonal"]=latticeConstant{{1/2,-Sqrt[3]/2},{1/2,Sqrt[3]/2}};
VertexDegree[gg["hexagonal"]]//Tally
HighlightGraph[gg["hexagonal"],NeighborhoodGraph[gg["hexagonal"],Position[lattice["hexagonal"],{0,0}][[1,1]]]]


(*{{6,36}}*)

### Square Lattice (2D)

latticeVectors["square"]=latticeConstant{{1,0},{0,1}};
VertexDegree[gg["square"]]//Tally
HighlightGraph[gg["square"],NeighborhoodGraph[gg["square"],Position[lattice["square"],{0,0}][[1,1]]]]


(*{{4,36}}*)

### Face-Centered Cubic Lattice (3D)

latticeVectors["FCC"]=latticeConstant{{0,1/2,1/2},{1/2,0,1/2},{1/2,1/2,0}};

(*{{12,216}}*)
• If I understand the OP, you're close, but you still have vertex spacing of $1$ in each direction. The OP wants (for example) $5$ vertices linked horizontally for each $1$ link vertically.... not square. Jul 2, 2021 at 18:08
• Your edit looks excellent! Is there a way to change the number of added vertices in the horizontal section? For e.g., now you have one extra, can we have two, three, four, etc. Also can we have a periodic boundary condition for the gg["rect"]? (in edit 3). Many thanks!! Jul 6, 2021 at 12:15
• @Shamina have a look at the new edit - The number of in-between vertices (or any other arrangement of vertices really) is controlled by the motif argument above. This is expecting a list of (u,v) lattice coordinates for each vertex, whereby they'll get dotted with the lattice vectors (a,b) to give (x,y) = (u,v).(a,b). In your case we can use something as simple as Thread[{Most[Subdivide[3]], 0}] for two subdivisions. Jul 6, 2021 at 13:08