How to get neighbor lists in the same order/orientation from a periodic IGTriangularLattice[] graph?

Question

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

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

Okay, let's see one particular neighborhood:

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

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

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

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).

Thanks!

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

Answer 1

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

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

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

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

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

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

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

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]

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