How to extract cascades of layers from a directed graph?

Question

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.

Answer 1

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