Problem with making torus graph in Graph3D by identifying edge of a square graph

I'd recommend using IGraphM, you can find a thorough documentation here.

Within it, there are graphs with periodic boundary conditions for the square/hexagonal cases, and it is fully compatible with all the network functionality of MMA, so you can perform any computations with the graphs.

For instance, suppose I want a m x n square lattice with periodic boundaries.

Install IGraphM. This is, of course, done only the first time you need to use IGraphM:

Get["https://raw.githubusercontent.com/szhorvat/IGraphM/master/IGInstaller.m"]

Load the packlet. This is done every time you need IGraphM functionality in your code:

<< IGraphM`

Declare your dimensions, and the periodicity option, plot the Graph in 3D (optional):

m = 15;
n = 15;
mySquareGraph = Graph3D[IGSquareLattice[{m, n}, "Periodic" -> True]]

enter image description here

Just for demonstration, the hexagonal periodic graph (which is, in effect, a triangular lattice):

myHexagonalGraph = Graph3D[IGTriangularLattice[{m, n}, "Periodic" -> True]]

enter image description here

Now you can do all sorts of computations with them, either with IGraphM commands or the regular MMA commands.


If it is not essential to get a Graph3D object, you can use ParametricPlot3D to get the desired looks:

ClearAll[torus, toroidalGrid]

torus[t_, v_, a_: 1, b_: 3] := {(b + a Cos[t]) Sin[v], (b + a Cos[t]) Cos[v], a Sin[t]}

toroidalGrid[n_, m_, a_: 1, b_: 3][ opts___ : OptionsPattern[]] := 
  Module[{sd = 0.001 + Range[0, 2 Pi - 2 Pi/#, 2 Pi/#] & /@ {n, m}}, 
   Show[ParametricPlot3D[torus[v, t, a, b], {t, 0, 2 Pi}, {v, 0, 2 Pi}, 
      Mesh -> sd, PlotStyle -> None, opts, MeshStyle -> Gray,   
      Axes -> False, Boxed -> False, ImageSize -> Medium], 
   Graphics3D[GraphicsComplex[torus[#2, #, a, b] & @@@ Tuples[sd], 
     {PointSize[Large], Point@Range[n m]}]]]]

Examples:

Grid @ 
 Transpose[{GridGraph[{##}], toroidalGrid[##][ ]} & @@@ {{2, 2}, {3, 3}, {3, 5}, {4, 3}}]

enter image description here

You can use MaxRecursion -> 0 and small values for PlotPoints to get straight edges:

Grid @ Transpose @ 
 ({GridGraph[{##}], 
   toroidalGrid[##][MaxRecursion -> 0, PlotPoints -> {##} + 1, 
     PlotRangePadding -> Scaled[.1] ]} & @@@ {{3, 3}, {4, 4}, {3, 5}, {5, 6}}) 

enter image description here

We can post-process lines into tubes and points into spheres to get something that looks like the output from Graph3D:

toroidalGrid[##][MaxRecursion -> 0, PlotPoints -> {##} + 1, 
    PlotRangePadding -> Scaled[.1] , ImageSize -> 800, 
    Lighting -> {{"Directional", GrayLevel[0.7], 
       ImageScaled[{1, 1, 0}]}, {"Point", GrayLevel[0.9], 
       ImageScaled[{0, 0, 3.5}], {0, 0, 0.07}}}] &[10, 6] /. 
  {l_Line :> {Hue[0.6, 0.2, 0.8], Tube[l[[1]], .06]}, 
   Point[x_] :> {Hue[.6, .6, 1], Sphere[x, .2]}}

enter image description here

A variant that adds vertex labels:

ClearAll[toroidalGrid2]

toroidalGrid2[n_, m_, a_: 1, b_: 3][opts___ : OptionsPattern[]] := 
 Module[{sd = 0.001 + Range[0, 2 Pi - 2 Pi/#, 2 Pi/#] & /@ {n, m}}, 
  Show[ParametricPlot3D[torus[t, v, a, b], {v, 0, 2 Pi}, {t, 0, 2 Pi},
     Mesh -> sd, PlotStyle -> None, opts, 
    MeshStyle -> Directive[Hue[0.6, 0.2, 0.8], Thick], Axes -> False, 
    Boxed -> False, ImageSize -> Medium, PlotRangePadding -> Scaled[.2]], 
   Graphics3D[GraphicsComplex[torus[#2, #, a, b] & @@@ Tuples[sd],
      {Text[##] & @@@ Transpose[{Join @@ Transpose@Partition[Range[n m], n], 
         Range[n m]}], Hue[.6, .6, 1], Sphere[#, .35] & /@ Range[n m]}]]]]

Examples:

Grid @ Transpose @
  ({GridGraph[{##}, VertexLabels -> Placed["Name", Center], VertexSize -> .3], 
    toroidalGrid2[##][Method -> {"ShrinkWrap" -> True}]} & @@@ 
  {{2, 2}, {3, 3}, {3, 5}, {4, 3}})

enter image description here


You could set up coordinates manually:

rings = Range @@@ Most[Transpose[{vortexD, vortexU - 1}]];
coords = Table[{4 + (3 + Cos[v]) Sin[u], 4 + (3 + Cos[v]) Cos[u], 
  4 + Sin[v]}, {u, 0, 2 Pi, 2 Pi/(Length[rings] - 1)}, {v, 0, 2 Pi, 
  2 Pi/(Length[rings[[1]]] - 1)}];

Graph[Fold[VertexContract[#1, #2] &, Graph[ha], 
  Join[Transpose[{vortexR, vortexL}], Transpose[{vortexD, vortexU}]]],
  VertexCoordinates -> Thread[Flatten[rings] -> Flatten[coords, 1]]]

enter image description here