2
$\begingroup$

Using IGraphM, I want to get the VertexComponent[] neighbors around all nodes, in a periodic IGTriangularLattice[] graph. To do that, I do:

(*Dimensions of the graph*)
i = 5;
j = 5;
(*Graph and neighborhoods distance {1} from each node*)
myPeriodicGraph = 
  IGTriangularLattice[{i, j}, VertexLabels -> "Name", 
   "Periodic" -> True,
   VertexCoordinates -> GraphEmbedding[IGTriangularLattice[{i, j}]]];
allNeighbors = 
  Table[VertexComponent[myPeriodicGraph, i, {1}], {i, 1, 
    VertexCount[myPeriodicGraph]}];

enter image description here

Now, just to visualize the order in which VertexComponent[] gives the neighborhoods, I have a list of colors to highlight these neighbors for any given focal cell:

colorNeighbors = {Red, Lighter[Red], Lighter[Lighter[Red]],
   Blue, Lighter[Blue], Lighter[Lighter[Blue]]}

enter image description here

Okay, let's see one particular neighborhood:

focalNode = 13;
GraphPlot[myPeriodicGraph, 
 VertexStyle -> (Rule[#[[2]], #[[1]]] & /@ 
    Transpose[{colorNeighbors, allNeighbors[[focalNode]]}])]

enter image description here

You can see that the Red[] tones are these neighbors to the "right" of the focalNode, and the Blue[] tones are these to the left. But this is not always the case! Especially when we query one of the nodes sitting at the "edges" of the graph (edge in spatial coordinates; topologically this is a "periodic" space).

focalNode = 23;
GraphPlot[myPeriodicGraph, 
 VertexStyle -> (Rule[#[[2]], #[[1]]] & /@ 
    Transpose[{colorNeighbors, allNeighbors[[focalNode]]}])]

enter image description here

You can see that the colors are now "disorganized". The same if you query other boundary nodes, and they disorganize in different ways: enter image description here

So, my question is, can I get the neighborhoods in a way that they are always oriented in the same order? Let's say I have a canonical ordering: {W, NW, NE, E, SE, SW}, can I always get this order, no matter where the queried focalNode is? (below an example from a 'central' node, a node on the edge of the graph should preserve the orientation of the list of neighbors). enter image description here

Thanks!

Note: It would be great if this could be extended to IGSquareLattice[].

$\endgroup$
2
  • $\begingroup$ It sounds like you want a combinatorial embedding of these graphs for the torus? I think you will need to do some manual work in this case ... $\endgroup$
    – Szabolcs
    Aug 31 '21 at 20:57
  • $\begingroup$ @Szabolcs What's combinatorial embedding? (in simple terms XD). And yeah, I'm thinking right now on figuring out what is the order of neighbors given in the 'edge' nodes, and then just reordering them to the desired canonical order. But I'm hoping there's a simpler solution without having to check if all special cases would work. I don't want a torus, I actually want them on a plane as they are now (doing some spatial calculations that would be lost in the torus). $\endgroup$ Aug 31 '21 at 21:35
2
$\begingroup$
  1. We can use AdjacencyList[g,v] to find the neighbors of a vertex v in graph g.
  2. Construct a subgraph of g formed by neighbors of the focal node.
  3. Then we can use FindHamiltonianPath on the subgraph starting with the east neighbor and ending with the south-east neighbor of the focal node to get the neighbors in desired order.
  4. Use the desired list of colors and ordered list of neighbors to construct a vertex styling rule.

Needs["IGraphM`"]

ClearAll[periodicGraph, ENeighbor, SENeighbor, orderedNeighborList, vertexStyle]

periodicGraph[{rows_, columns_}, opts : OptionsPattern[]] := 
 IGTriangularLattice[{rows, columns}, VertexLabels -> "Name", 
  "Periodic" -> True, opts, VertexCoordinates -> 
   GraphEmbedding[IGTriangularLattice[{rows, columns}]]]

ENeighbor[{rows_, columns_}, v_] := Mod[v + rows, rows columns, 1]

SENeighbor[{rows_, columns_}, v_] := Module[{g = periodicGraph[{rows, columns}]}, 
  First @ DeleteCases[Mod[v + 1, rows columns, 1] | 
      Mod[ENeighbor[{rows, columns}, v] + 1, rows columns, 1]]@
    AdjacencyList[Subgraph[g, AdjacencyList[g, v]], ENeighbor[{rows, columns}, v]]]

orderedNeighborList[{rows_, columns_}, v_] := 
 Module[{g = periodicGraph[{rows, columns}]}, 
  RotateRight @ FindHamiltonianPath[Subgraph[g, AdjacencyList[g, v]], 
    ENeighbor[{rows, columns}, v], SENeighbor[{rows, columns}, v]]]

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

colorNeighbors = {Red, Lighter[Red], Lighter[Lighter[Red]], Blue, 
   Lighter[Blue], Lighter[Lighter[Blue]]};

vertexStyle[{rows_, columns_}, v_] := Join[{_ -> White, v -> Green}, 
  MapThread[Rule, {orderedNeighborList[{rows, columns}, v], colorNeighbors}]]

Examples:

periodicGraph[{5, 5}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{5, 5}, 13]]

enter image description here

periodicGraph[{5, 5}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{5, 5}, 3]]

enter image description here

periodicGraph[{5, 5}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{5, 5}, 23]]

enter image description here

periodicGraph[{5, 5}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{5, 5}, 24]]

enter image description here

periodicGraph[{5, 5}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{5, 5}, 20]]

enter image description here

periodicGraph[{5, 5}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{5, 5}, 11]]

enter image description here

periodicGraph[{6, 4}, EdgeShapeFunction -> eSF, VertexStyle -> vertexStyle[{6, 4}, 2]]

enter image description here

Multicolumn[With[{i = 5, j = 5, v = #}, 
    Subgraph[periodicGraph[{i, j}], 
     Prepend[v]@RotateLeft@orderedNeighborList[{i, j}, v], 
     VertexLabels -> "Name", ImageSize -> Medium, 
     VertexLabelStyle -> 16,
     VertexStyle -> vertexStyle[{i, j}, v]]] & /@ 
   {13, 3, 23, 24, 20, 11}, 3]

enter image description here

Multicolumn[With[{i = 5, j = 5, v = #}, 
    Subgraph[periodicGraph[{i, j}], 
     Prepend[v]@RotateLeft@orderedNeighborList[{i, j}, v], 
     VertexLabels -> "Name", VertexLabelStyle -> 16, 
     ImageSize -> Medium, 
     VertexStyle -> vertexStyle[{i, j}, v]]] & /@ 
   {5, 10, 15, 20, 25}, 3, Appearance -> "Horizontal"]

enter image description here

$\endgroup$
0

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.