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

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


## 1 Answer

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


• Shockingly excellent! One very tiny question: What is the meaning of circle closeness? Sometimes, they are very close to each other, sometimes they are far distant. Why does that mean? I suppose that the bubble sizes of vertices are proportionally kept. Thank you very much. Commented Aug 25, 2023 at 12:42
• A vertex w in ioNeighborhoodGraph[_][g,v] ls located on circle with radius equal to the GraphDistance of w from v in the NeighborhoodGraph[g,v]
– kglr
Commented Aug 25, 2023 at 19:57