# How to extract cascades of layers from a directed graph?

I request an efficient Code for the following computations. The computations do exactly what I intend to achieve (I assume?), however, the code looks poor and inefficient, and I cannot go on with higher order layers because of my poor programming skills. Therefore, for illustrative purposes, I could compute two layers only.

Here is a brief description of how to identify cascades of layers of one-edge neighbors of a given sector i in a directed graph.

1. Layer(i,1) denotes layer 1 of sector i, which is defined by one-edge neighbors of i (denoted by N(i)={sectors(i), binary links(i)});
2. Suppose that sectors j, k, l are elements of the set sectors(i) in N(i), for each sector j, k, l, find their one-edge neighbors: N(j), N(k), N(l);
3. Subtract binary links(i) from the Union of binary links(j), binary links(k), binary links(l). The remaining list of binary links and the associated sectors define Layer(i, 2);
4. To obtain Layer(i,3), repeat the same procedure using N(j), N(k), N(l);
5. Identification of layers should stop when all the sectors in the given start network are exhausted.

Here is the code implementing the above procedure for two layers only:

el = {"EGW" \[DirectedEdge] "MA2", "EGW" \[DirectedEdge] "HLT",   "EGW" \[DirectedEdge] "AGF", "EGW" \[DirectedEdge] "WHS", "EGW" \[DirectedEdge] "TSC", "EGW" \[DirectedEdge] "CST", "HLT" \[DirectedEdge] "MA2", "HLT" \[DirectedEdge] "EGW", "HLT" \[DirectedEdge] "TSC", "HLT" \[DirectedEdge] "CST", "AGF" \[DirectedEdge] "EGW", "AGF" \[DirectedEdge] "HLT", "AGF" \[DirectedEdge] "WHS", "AGF" \[DirectedEdge] "TSC", "CO12" \[DirectedEdge] "HLT", "CO12" \[DirectedEdge] "AGF", "CO12" \[DirectedEdge] "WHS", "FIN" \[DirectedEdge] "AGF", "WHS" \[DirectedEdge] "CO12", "TSC" \[DirectedEdge] "CO12", "TSC" \[DirectedEdge] "FIN", "CST" \[DirectedEdge] "FIN"};

vl = {"MA2", "EGW", "HLT", "AGF", "CO12", "FIN", "WHS", "TSC", "CST"};

ewl = {0.021, 0.019, 0.017, 0.026, 0.023, 0.026, 0.015, 0.011, 0.015,
0.013, 0.017, 0.015, 0.026, 0.016, 0.025, 0.018, 0.018, 0.017,
0.016, 0.012, 0.021, 0.014};

wGraph = Thread[{el, ewl}];

gr = Graph[el, VertexLabels -> "Name", PlotLabel -> "Given a graph",
ImageSize -> 250];
HighlightGraph[gr, Subgraph[gr,layer1 = NeighborhoodGraph[gr, "MA2", PlotLabel -> "Layer 1"]], ImageSize -> 250];
el1 = EdgeList[layer1];
vl1 = VertexList[layer1];

HighlightGraph[gr,Subgraph[gr, layer21 = NeighborhoodGraph[gr, "EGW"]]];
HighlightGraph[gr,Subgraph[gr, layer22 = NeighborhoodGraph[gr, "HLT"]]];
el21 = EdgeList[layer21];
vl21 = VertexList[layer21];
el22 = EdgeList[layer22];
vl22 = VertexList[layer22];

el21Uel22 = Union[el21, el22];
layer2 = Graph[Complement[el21Uel22, el1], VertexLabels -> "Name",
PlotLabel -> "Layer 2", ImageSize -> 250];

Row[{gr, Spacer[20], layer1, Spacer[20], layer2}]


Here is what it produces:

I would be grateful if the efficient Code derives layers

• as a sequence of Subgraphs like I did above to allow for the reconstruction of the starting graph by sequentially clipping individual layers (Subgraphs) to each other.
• show the final layered graph as a CommunityGraph.

## 1. Getting the layers

ClearAll[nextLayer, layersList]
nextLayer[g_] := Complement[
EdgeList @ Apply[GraphUnion] @ Map[NeighborhoodGraph[g, #] &] @ VertexList[#],
EdgeList @ #] &;

layersList[g_, startingVertex_, steps_] :=
Rest @ NestList[nextLayer[g], Graph[{startingVertex}, {}], steps]


Examples:

Transpose[{Range[5], layersList[gr, "MA2", 5]}] // Grid


MapIndexed[
Graph[#, VertexLabels -> "Name", ImageSize -> 200,
PlotLabel -> Row[{"Layer " , #2[[1]]}]] &] @
layersList[gr, "MA2", 5] // Row[#, Spacer[10]] &


Alternatively, use NestWhileList to get a cycle-free list:

ClearAll[allLayers]
allLayers[g_, startingVertex_] :=
Rest @ NestWhileList[nextLayer[g], Graph[{startingVertex}, {}],
DuplicateFreeQ @* List, All, Infinity, -1]


Examples:

MapIndexed[{#2[[1]], #} &]@allLayers[gr, "MA2"] // Grid


MapIndexed[
Graph[#, VertexLabels -> "Name", ImageSize -> 300,
PlotLabel -> Row[{"Layer " , #2[[1]]}]] &] @ allLayers[gr, "MA2"] //
Row[#, Spacer[10]] &


## 2. CommunityGraphPlot

Map VertexList on allLayers[gr, "MA2"] to get a community structure:

communitystructure = VertexList /@ allLayers[gr, "MA2"]

{{"EGW", "HLT", "MA2"},
{"AGF", "EGW", "HLT", "TSC", "WHS", "CO12", "CST"},
{"CO12", "WHS", "CST", "FIN", "EGW", "HLT", "MA2", "AGF",  "TSC"}}


Use communitystructure in the second argument of CommunityGraphPlot:

CommunityGraphPlot[EdgeList@gr, communitystructure,
ImageSize -> Large, VertexLabels -> Placed["Name", Center],
VertexSize -> Large,
CommunityRegionStyle -> (Opacity[.3, #] & /@ {Red, Green, Blue}),
PlotLegends -> SwatchLegend[
Opacity[.3, #] & /@ {Red, Green, Blue},
{"Layer 1", "Layer 2", "Layer 3"},
LegendMarkerSize -> Medium, "Spacings" -> {1, 1}]]


• Thanks for this very efficient code. It seems that the code is doing a slightly different computation than I was expecting. (1) The layers need to be mutually exclusive (in edges but not in vertices), (2) previously computed layers should not show up in latter layers. These conditions are violated in the code. I tried the code with different examples, but again these two conditions are not satisfied. One reason is that somewhere in the code, previously found edges are not subtracted from the latter layers. Feb 3, 2023 at 12:58