1
$\begingroup$

I'm making a visualisation of an email network of a company. Each vertex represents a person and vertex color represents their position(BOD,CEO,manager,leader). The edges' Thickness according to weights(amount of emails they send from a person to another). I also need to move the position of the vertex so I can show the visualisation of the clustering and also to improve angles. Here's my adjacency matrix with weights:

weightedNonSym = {
   {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0},
   {0, 0, 0, 5, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 1},
   {0, 0, 0, 5, 0, 0, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0},
   {0, 0, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0},
   {0, 0, 0, 0, 4, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 2, 0},
   {0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 5, 0, 0, 0, 0, 0, 2, 0},
   {0, 0, 0, 0, 7, 0, 0, 0, 0, 7, 5, 3, 0, 0, 0, 0, 0, 0},
   {0, 0, 0, 0, 4, 0, 0, 0, 0, 2, 4, 4, 0, 0, 0, 0, 2, 0},
   {0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 3, 0, 3, 0, 0, 0, 2, 0},
   {0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
   {0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0},
   {0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 5, 0}
   };

Here's what I have so far for the graph:

    edgeMappingToWeights = 
      Sort[<|Join @@ 
         MapIndexed[Rule @@ #2 -> # &, weightedNonSym/100, {2}]|>, 
       Greater];
    edgeCount = 45;
    edge45 = Keys@Take[edgeMappingToWeights, edgeCount];
    color = {{1, 0.6, 0.8}, {1, 0.6, 0.8}, {0.9, 1, 0.7}, {1, 0.7, 
    0.2}, {1, 0.7, 0.2}, {1, 0.7, 0.2}
     , {0.9, 1, 0.9}, {0.9, 1, 0.9}, {0.9, 1, 0.9}, {0.9, 1, 
    0.9}, {0.9, 1, 0.9}, {0.9, 1, 0.9}
     , {0.9, 1, 0.9}, {0.9, 1, 0.9}, {0.9, 1, 0.9}, {0.9, 1, 
    0.9}, {0.9, 1, 0.9}, {0.9, 1, 0.9}
    };     
    GraphPlot[
 Graph[edge45, 
  EdgeStyle -> Thread[edge45 -> (Thickness[#] & /@ weights)]], 
 VertexShapeFunction -> (Text[
     Framed[Style[#2 - 1, 8, Black], 
      Background -> (RGBColor[#[[1]], #[[2]], #[[3]] &] & /@ 
         color)], #1] &)]

Which produces this output: enter image description here

The Vertex background doesnt seem to work though. And I'm still trying to figure out how to incorporate these coordinates for the vertex:

xcoor = {0, 0, 1, 6, 8, 3, 7, 5, 6, 9, 11, 7, 10, 11, 7, 4, 5, 4};
ycoor = {6, 5, 5.5, 0.5, 11, 5, 2.5, 2.5, 3.5, 6.5, 7.5, 7.5, 11, 10, 
   10, 6, 5, 4};

colors = {RGBColor[1, 0.6, 0.8], RGBColor[1, 0.6, 0.8], 
   RGBColor[0.9, 1, 0.7], RGBColor[1, 0.7, 0.2], 
   RGBColor[1, 0.7, 0.2], RGBColor[1, 0.7, 0.2]
   , RGBColor[0.9, 1, 0.9], RGBColor[0.9, 1, 0.9], 
   RGBColor[0.9, 1, 0.9], RGBColor[0.9, 1, 0.9], 
   RGBColor[0.9, 1, 0.9], RGBColor[0.9, 1, 0.9]
   , RGBColor[0.9, 1, 0.9], RGBColor[0.9, 1, 0.9], 
   RGBColor[0.9, 1, 0.9], RGBColor[0.9, 1, 0.9], 
   RGBColor[0.9, 1, 0.9], RGBColor[0.9, 1, 0.9]};
vertexLabel = {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17};
$\endgroup$
2
$\begingroup$
wag = WeightedAdjacencyGraph[Range[18] - 1, weightedNonSym /. 0 -> ∞];

GraphPlot[wag, 
  EdgeStyle -> {e_ :> Directive[Opacity[.8], Blue, 
     Thickness[PropertyValue[{wag, e}, EdgeWeight]/400]]}, 
 VertexStyle -> {v_ :> (RGBColor @@ color[[v + 1]])}, 
 VertexCoordinates -> Transpose[{xcoor, ycoor}],  
 PlotTheme -> "ClassicLabeled"]

enter image description here

$\endgroup$

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.