10
$\begingroup$

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.
enter image description here One can change this number from one to two, as shown below. enter image description here 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};
mat = AdjacencyMatrix[ResourceFunction["TorusGraph"][{nx, ny}]];
gph = AdjacencyGraph[mat, VertexLabels -> Automatic];

nv[g_, v_, k_] := VertexList[NeighborhoodGraph[g, v]][[k]];
edgeA[m_, g_, v_, k_] := 
  EdgeAdd[
   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?

$\endgroup$
10
  • 2
    $\begingroup$ Perhaps a double periodic lattice might be represented as a TorusGraph since both sides wrap around? e.g ResourceFunction["TorusGraph"][{10, 4}] $\endgroup$
    – flinty
    Jul 1 at 18:08
  • $\begingroup$ @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? $\endgroup$
    – Shamina
    Jul 1 at 18:32
  • $\begingroup$ 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. $\endgroup$ Jul 1 at 23:57
  • 1
    $\begingroup$ 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. $\endgroup$ Jul 2 at 17:21
  • 1
    $\begingroup$ an aside: you can use Prepend[v]@AdjacencyList[g, v] instead of VertexList[NeighborhoodGraph[g, v]] $\endgroup$
    – kglr
    Jul 6 at 2:44
8
+50
$\begingroup$

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]

enter image description here

Add a node in the middle of horizontal edges:

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

enter image description here

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

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

enter image description here

Highlight the added vertices:

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

enter image description here

Make the edges straight lines:

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

enter image description here

Used curved edges to indicate periodic boundaries:

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

enter image description here

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}]]]]}, 
   {Arrowheads[{{.03, .75}}], 
    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]

enter image description here

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

enter image description here

$\endgroup$
5
  • $\begingroup$ 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? $\endgroup$
    – Shamina
    Jul 6 at 14:05
  • $\begingroup$ @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. $\endgroup$
    – kglr
    Jul 6 at 14:13
  • 3
    $\begingroup$ @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. $\endgroup$ Jul 6 at 16:01
  • $\begingroup$ 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. $\endgroup$ Jul 6 at 16:11
  • 1
    $\begingroup$ @Shamina, if you are content with the solutions, it is a good practice to accept them as "answered" if you haven't already $\endgroup$ Jul 6 at 18:56
10
$\begingroup$

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

linked[mat_?MatrixQ, r_?Positive] := 
 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[
    MapThread[
     linked[periodicDistanceCartesianPair[#1, 
        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]]

enter image description here

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

enter image description here

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

enter image description here

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"]=Tuples[Range[-latticeRadius,latticeRadius-1],2];
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]];
gg["rect"]=AdjacencyGraph[pdm["rect"],VertexCoordinates->Join@@lattice["rect"]];
VertexDegree[gg["rect"]]//Tally
HighlightGraph[gg["rect"],NeighborhoodGraph[gg["rect"],Position[Join@@lattice["rect"],{1/2,0}][[1,1]]]]

{{4, 36}, {2, 36}}
enter image description here

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}};
lattice["rect"]=Tuples[Range[-latticeRadius,latticeRadius-1],2].latticeVectors["rect"];
pdm["rect"]=periodicDistanceLattice[lattice["rect"].Inverse[latticeVectors["rect"]],2 latticeRadius];
gg["rect"]=AdjacencyGraph[linked[pdm["rect"],1],VertexCoordinates->lattice["rect"]];
VertexDegree[gg["rect"]]//Tally
HighlightGraph[gg["rect"],NeighborhoodGraph[gg["rect"],Position[lattice["rect"],{2,0}][[1,1]]]]

{{4,36}}
enter image description here

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}]
latticeRadius = 3;
latticeConstant = 1;

Examples

Hexagonal Lattice (2D)

latticeVectors["hexagonal"]=latticeConstant{{1/2,-Sqrt[3]/2},{1/2,Sqrt[3]/2}};
lattice["hexagonal"]=Tuples[Range[-latticeRadius,latticeRadius-1],2].latticeVectors["hexagonal"];
pdm["hexagonal"]=periodicDistanceCartesian[lattice["hexagonal"],2 latticeRadius,latticeVectors["hexagonal"]];
gg["hexagonal"]=AdjacencyGraph[linked[pdm["hexagonal"],latticeConstant],VertexCoordinates->lattice["hexagonal"]];
VertexDegree[gg["hexagonal"]]//Tally
HighlightGraph[gg["hexagonal"],NeighborhoodGraph[gg["hexagonal"],Position[lattice["hexagonal"],{0,0}][[1,1]]]]

(*{{6,36}}*)

enter image description here

Square Lattice (2D)

latticeVectors["square"]=latticeConstant{{1,0},{0,1}};
lattice["square"]=Tuples[Range[-latticeRadius,latticeRadius-1],2].latticeVectors["square"];
pdm["square"]=periodicDistanceCartesian[lattice["square"],2 latticeRadius,latticeVectors["square"]];
gg["square"]=AdjacencyGraph[linked[pdm["square"],latticeConstant],VertexCoordinates->lattice["square"]];
VertexDegree[gg["square"]]//Tally
HighlightGraph[gg["square"],NeighborhoodGraph[gg["square"],Position[lattice["square"],{0,0}][[1,1]]]]

(*{{4,36}}*)

enter image description here

Face-Centered Cubic Lattice (3D)

latticeVectors["FCC"]=latticeConstant{{0,1/2,1/2},{1/2,0,1/2},{1/2,1/2,0}};
lattice["FCC"]=Tuples[Range[-latticeRadius,latticeRadius-1],3].latticeVectors["FCC"];
pdm["FCC"]=periodicDistanceCartesian[lattice["FCC"],2 latticeRadius,latticeVectors["FCC"]];
gg["FCC"]=AdjacencyGraph[linked[pdm["FCC"],latticeConstant/Sqrt[2]],VertexCoordinates->lattice["FCC"]];
VertexDegree[gg["FCC"]]//Tally
HighlightGraph[gg["FCC"],NeighborhoodGraph[gg["FCC"],Position[lattice["FCC"],{0,0,0}][[1,1]]]]

(*{{12,216}}*)

enter image description here

$\endgroup$
5
  • 2
    $\begingroup$ 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. $\endgroup$ Jul 2 at 18:08
  • 1
    $\begingroup$ Thanks for your answer! As already mentioned by @DavidG.Stork, it is quite close. But I am interested in the case, when the vertex spacing is not 1 in each direction, as already pointed above. That is, can we add a vertex with a different coordination number? For instance, in your square lattice, to add a vertex between adjacent vertices? (Don’t hesitate to see the main question) $\endgroup$
    – Shamina
    Jul 5 at 9:38
  • $\begingroup$ 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!! $\endgroup$
    – Shamina
    Jul 6 at 12:15
  • $\begingroup$ Also, is there a way to control the size of the lattice? $\endgroup$
    – Shamina
    Jul 6 at 12:22
  • 1
    $\begingroup$ @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. $\endgroup$ Jul 6 at 13:08

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.