How to represent a digraph in a 2D circle structure using NeighborhoodGraph[.]

Question

This code works and delivers NeighborhooGraph[.] of a chosen vertex. The resulting graph is bit difficult to understand and therefore I like represent the same graph on a 2D circles as shown in the figure below. The first circle should include those out-going edges from the selected vertex, say 4. It must exclude incoming edges because I will generate the same 2D figure using incoming edges separately.

My question is: How can I generate the 2D-circle plot using (1) only those out-going edges from the vertex chosen, and (2) how can separately generate the same plot using in-coming edges. Parallel edges between the neighbors of the selected vertex should remain as they are neither upward or downward.

Using Manipulate[.] seems to be necessary to answer this question, with the neighborhood controller k. Basically, Manipulate should have four controls: In, Out, neighborhood distance k, selected vertex sv.

ClearAll[wam, vLabels, sa, wag, evc, g];

(* convert the matrix into a directed graph *)
wam = {{0, 0.03, 0, 0.03, 0.02, 0.0, 0.02, 0, 0.01, 0.01, 0.02, 0.0, 
0.01, 0.02, 0.02}, {0.05, 0, 0.07, 0, 0, 0, 0.03, 0.0, 0, 0.01, 
0.06, 0.0, 0.01, 0.04, 0.0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0.06, 0, 
0, 0.07, 0, 0}, {0.05, 0, 0.03, 0, 0.0, 0.05, 0.0, 0.02, 0, 0.01, 
0.02, 0.03, 0.01, 0.0, 0.03}, {0.06, 0, 0, 0, 0, 0.05, 0.04, 0.06,
 0.03, 0.08, 0.06, 0.05, 0.03, 0.07, 0.06}, {0.01, 0.02, 0.0, 
0.03, 0.0, 0, 0.02, 0.01, 0.0, 0.01, 0.0, 0.05, 0.0, 0.02, 
0.0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0.02, 0.06, 0.06, 0.01, 0, 
0}, {0, 0.05, 0.0, 0.06, 0.0, 0.0, 0.09, 0, 0.0, 0.01, 0.0, 0.07, 
0, 0.0, 0.02}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0.07, 0, 0, 0.04, 0, 
0}, {0.01, 0.07, 0.03, 0.04, 0, 0.0, 0.05, 0.08, 0.0, 0, 0.03, 
0.02, 0.0, 0.03, 0.09}, {0.04, 0.07, 0.05, 0, 0, 0, 0, 0, 0, 0, 0,
 0, 0.03, 0, 0}, {0, 0.01, 0.06, 0, 0.01, 0.07, 0.0, 0.0, 0.0, 
0.0, 0.08, 0, 0, 0.01, 0.01}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0.05, 
0.05, 0.01, 0, 0.06, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0.05, 0, 0, 0, 0, 0, 0}};
vLabels = {1 -> AGF, 2 -> CO12, 3 -> MA1, 4 -> MA2, 5 -> EGW, 
6 -> CST, 7 -> WHS, 8 -> HOT, 9 -> TSC, 10 -> FIN, 11 -> EST, 
12 -> ADM, 13 -> EDU, 14 -> HLT, 15 -> ENT};
sa = SparseArray[wam];
wag = Graph[sa["NonzeroPositions"], EdgeWeight -> sa["NonzeroValues"],
DirectedEdges -> True, EdgeLabels -> "EdgeWeight"];

(* compute some statistics *)
evc = EigenvectorCentrality[wag] /. vLabels;

g = Graph[
sa["NonzeroPositions"],
VertexSize -> {v_ :> ({#, #} &@Normalize[evc, Total][[v]])},
PerformanceGoal -> 
"Quality",(*so that arrow heads are not covered by vertex disks*)
ImagePadding -> 
10,                      (*so that vertex labels are not clipped*)
EdgeWeight -> sa["NonzeroValues"],
DirectedEdges -> True,
VertexLabels -> vLabels
];

HighlightGraph[g, NeighborhoodGraph[g, 4]]

Answer 1

Maybe something like this:

Given a graph g and vertex v, find all directed shortest paths in NeighborhoodGraph[g, v] starting from (respectively, ending in) v.

ClearAll[ioSPaths, ioEdgeList, ioAnglesList, ioRadiiList, 
 ioVertexCoordinates, ioNeighborhoodGraph]

In/Out shortest paths

ioSPaths[io_ : "Out"][g_, v_] := 
 Map[FindShortestPath[g, io /. {"Out" -> v, "In" -> #}, 
     io /. {"Out" -> #, "In" -> v}] &]@(io /. {"Out" -> 
       VertexOutComponent, "In" -> VertexInComponent})[
   NeighborhoodGraph[g, v], v]

EdgeLists

Construct path graphs from shortest paths, take their GraphUnion and take the EdgeList of the resulting graph

ioEdgeList[io_ : "Out"][g_, v_] := EdgeList @
   Apply[GraphUnion] @
   Map[PathGraph[#, DirectedEdges -> True] &] @
   ioSPaths[io][g, v]

VertexCoordinates

For each path

1. Associate an angle for each shortest path based on the position of the path in ioSPaths[.][..] list;
2. Associate a radius for each vertex based on its GraphDistance from v;
3. Use the angles and radii found above to specify VertexCoordinates

ioAnglesList[io_ : "Out"][g_, v_] := Association @ Catenate @
   MapApply[Thread[# -> #2, List, {1}] &]@
   Thread[Sort @ ioSPaths[io][g, v] -> 
      CirclePoints[Length@ioSPaths[io][g, v]]]

ioRadiiList[io_ : "Out"][g_, v_] := Association @
  Map[# -> 
      GraphDistance[NeighborhoodGraph[g, v], 
       io /. {"Out" -> v, "In" -> #}, 
       io /. {"Out" -> #, "In" -> v}] &] @
  (io /. {"Out" -> 
        VertexOutComponent, "In" -> VertexInComponent})[
    NeighborhoodGraph[g, v], v]

ioVertexCoordinates[io_ : "Out"][g_, v_] := 
 Merge[Apply[Times]][{ioRadiiList[io][g, v], ioAnglesList[io][g, v]}]

ioNeighborhoodGraph

Define a function that constructs a graph using ioEdgeList["Out"][g, v] as the edge list and ioVertexCoordinates["Out"][g, v] as vertex coordinates. Similarly, for "In".

ioNeighborhoodGraph[io_ : "Out", opts : OptionsPattern[]][g_, v_] :=
 Graph[ioEdgeList[io][g, v], 
  PerformanceGoal -> "Quality", 
  VertexSize -> {w_ :>  Scaled[EigenvectorCentrality[g, io][[w]]]}, 
  VertexCoordinates -> {w_ :> ioVertexCoordinates[io][g, v]@w},  
  Prolog -> {Dashed, 
    Circle[{0, 0}, #] & /@ Union[Values@ioRadiiList[io][g, v]]}, 
  opts,
  PlotRange -> 1.1 {{-1, 1} #, {-1, 1} #} &@
    Max @ Abs @ CoordinateBounds[ioVertexCoordinates[io][g, v]], 
  ImageSize -> Large, 
  ImagePadding -> 40]

Examples:

vLabels = {1 -> AGF, 2 -> CO12, 3 -> MA1, 4 -> MA2, 5 -> EGW, 
   6 -> CST, 7 -> WHS, 8 -> HOT, 9 -> TSC, 10 -> FIN, 11 -> EST, 
   12 -> ADM, 13 -> EDU, 14 -> HLT, 15 -> ENT};

g = Graph[sa["NonzeroPositions"],
  VertexSize -> {v_ :> ({#, #} & @ evc[[v]])},
  PerformanceGoal ->  "Quality",
  ImagePadding -> 10, 
  EdgeWeight -> sa["NonzeroValues"],
  DirectedEdges -> True,
  VertexLabels -> vLabels];


Manipulate[ioNeighborhoodGraph[io, 
   VertexStyle -> 
    {v_ :> ColorData["Rainbow"][Rescale[EigenvectorCentrality[g, io]][[v]]]}, 
   VertexLabels -> {v_ :> Placed[v /. vLabels, Center]}][g, v], 
 {{io, "Out", "in/out"}, {"Out", "In"}}, 
 {{v, 1, "vertex"}, vLabels, SetterBar} ]