4
$\begingroup$

I'm new to Mathematica and I'm using it to study graph theory and network data processing and analysis. I recently started to deal with graph data visualization and directed graphs. Which lead me to the wonder about ways of presenting directed graphs.

Lets suppose the following graph:

vlist = {1, 2, 3, 4, 5}
vrules = {1 -> 2, 1 -> 3, 1 -> 5, 2 -> 1, 2 -> 4, 2 -> 5, 3 -> 2, 4 -> 1, 4 -> 5, 5 -> 3, 5 -> 4}
g=Graph[vlist,vrules]

Which is rendered as follows:

graph

Now I want to make bidirectional connections to be presented as a thick line with arrowheads in both ends, single direction connections to be presented with a thin line and the arrowhead indicating its direction.

I also want the vertices to reflect the centrality of the nodes, so nodes with higher centrality would be presented bigger in proportion to its centrality up to a maximum size.

Fo example, the betweeness and degree centralities of this graph are:

BetweennessCentrality[g]
{2., 3.5, 1., 1., 1.5}

DegreeCentrality[g]
{5, 5, 3, 4, 5}

I've looked into the documentation but didn't find much insight on how to do this kind of stuff, I know that I essentially have to deal with GraphStyle options, but most of them are either poorly documented or not documented at all.

Regards and thanks in advance,

$\endgroup$
  • 2
    $\begingroup$ Have you considered making all bidirectional connections explicit? Instead of having 4 -> 5 and 5 -> 4 as edges, instead use 4 <-> 5 $\endgroup$ – Jason B. Apr 19 '17 at 22:08
  • $\begingroup$ @Jason B., Thanks for your reply, it would be a very helful helpful option, but only address 1/3 of the problem. $\endgroup$ – nicholas80 Apr 20 '17 at 20:54
4
$\begingroup$

A bit more styling:

color[x_, minmax_] := ColorData[{"GrayTones", "Reverse"}][Rescale[x, minmax, {.1, 1}]];

iEShapeFunction[UndirectedEdge[x_, y_], {vsrule_, vstyle_}, dcheck_:True] := 
  With[{sback = {vsrule[x], vsrule[y]}, acolor = {vstyle[x], vstyle[y]}}, 
   ({If[TrueQ[dcheck] && dcheck[x] != #[[1]], sback = Reverse[sback]; 
      acolor = Reverse[acolor]];Blend[acolor, Divide @@ Reverse[sback]], 
      Arrowheads[{-.05, .05}], Thickness[.01], 
      Arrow[Line[#, VertexColors -> acolor], sback]} &)];

iEShapeFunction[DirectedEdge[x_, y_], {vsrule_, vstyle_}, dcheck_:True] := 
  With[{sback = {vsrule[x], vsrule[y]}, acolor = {vstyle[x], vstyle[y]}}, 
   ({Blend[acolor, Divide @@ Reverse[sback]], 
      Arrowheads[{.03}], Thickness[.001], 
      Arrow[Line[#, VertexColors -> acolor], sback]} &)];

For example:

g = RandomGraph[{15, 35}, DirectedEdges -> True];

dc = DegreeCentrality[g];
{vmin, vmax} = {.02, .15};
vsrule = Association[Thread[VertexList[g] -> Rescale[dc, MinMax[dc], {vmin, vmax}]]];
vstyle = color[#, {vmin, vmax}] & /@ vsrule;
labelstyle = 
  Normal[Directive[White, Bold, Rescale[#, {vmin, vmax}, {8, 20}]] & /@ vsrule];

vlist = VertexList[g];
vcoords = 
  Association[Thread[vlist -> GraphEmbedding[Graph[vlist, edges]]]];

edges = GatherBy[EdgeRules[g], 
    Union] /. {{Rule[x_, y_], Rule[y_, x_]} :> 
     UndirectedEdge[x, y], {Rule[x_, y_]} :> DirectedEdge[x, y]};

Graph[edges, VertexSize -> Normal[{#, #} & /@ vsrule], 
 EdgeStyle -> Blue, VertexStyle -> Normal[vstyle], 
 EdgeShapeFunction -> ((# -> iEShapeFunction[#, {vsrule, vstyle}, vcoords]) & /@
     edges), VertexLabels -> Placed["Name", Center],
 VertexLabelStyle -> labelstyle
 ]

enter image description here

$\endgroup$
  • $\begingroup$ @halmir, thanks for your help, this is way beyond my expectations and I certainly would spend some time to explore and understand this piece of code, but it would certainly be worth the time. $\endgroup$ – nicholas80 Apr 20 '17 at 21:00
2
$\begingroup$
edges=Flatten[GatherBy[vrules, Union] /. {Rule[x_,y_],Rule[y_,x_]}:> 
  Property[UndirectedEdge[x,y], 
    EdgeShapeFunction->({Arrowheads[{-.05, .05}], Thickness[.01], Arrow@#}&)]];

vertices=Property[#,VertexSize->#2]& @@@ Transpose[{vlist,{"Scaled",#/2} & /@ 
   Normalize[DegreeCentrality[Graph[vlist, vrules]], Total]}];

Graph[vertices, edges, VertexLabels -> Placed["Name", Center],
   GraphLayout -> { "RenderingOrder" -> "EdgeFirst"}, 
   EdgeStyle -> Blue, VertexStyle->White]

Mathematica graphics

$\endgroup$
  • $\begingroup$ @kglr, thanks for your help, as always, your answers are interesting and full of stuff to learn while reverse engineering them. $\endgroup$ – nicholas80 Apr 20 '17 at 21:02
  • $\begingroup$ @nicholas80, my pleasure. Welcome to mma.se. $\endgroup$ – kglr Apr 20 '17 at 22:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.