8
$\begingroup$

The following code generates a community graph and a set of bar charts, each one of which corresponds to a community.

ClearAll[vl, el, ew, names, community, g];

el = {"str4" \[DirectedEdge] "scst", "ma15" \[DirectedEdge] "srtl", 
   "ma15" \[DirectedEdge] "shot", "ma15" \[DirectedEdge] "str4", 
   "ma15" \[DirectedEdge] "ma8", "ma15" \[DirectedEdge] "str3", 
   "sfin" \[DirectedEdge] "shot", "sfin" \[DirectedEdge] "ma6"};
vl = VertexList[el];
ew = {0.01313, 0.0139, 0.0188, 0.01145, 0.01842, 0.01786, 0.0137, 
   0.01561};
names = {
   "agr: Agriculture, hunting, forestry, fishing", 
   "min: Mining and quarrying", "ma1: Food, beverages, tobacco", 
   "ma2: Textiles, textile products", 
   "ma3:   Leather, leather products, footwear", 
   "ma4: Wood & products of wood and cork", 
   "ma5: Pulp, paper, paper products, printing, publishing", 
   "ma6: Coke, refined petroleum, nuclear fuel", 
   "ma7: Chemicals & chemical products", 
   "ma8: Rubber-plastics products", 
   "ma9: Other non-metallic mineral products", 
   "ma10: Manufacture of basic metals", 
   "ma11: Machinery-equipment n.e.c", "ma12: Electrical equipment", 
   "ma13: Transport equipment", "ma14: Manufacturing, nec; recycling",
    "segw: Electricity, gas, water supply", "scst: Construction", 
   "ma15: Sale-maintenance; repair-install. of mach. equip.", 
   "swhl: Wholesale trade, except motor vehicles", 
   "srtl: Retail trade, except of motor vehicles", 
   "shot: Hotels & restaurants", "str1: Inland transport", 
   "str2: Water transport", "str3: Air transport", 
   "str4: Other supporting-transport act. of travel agencies", 
   "stel: Post & telecommunications", 
   "sfin: Financial intermediation", "sest: Real estate activities", 
   "sbus: Renting of M&Eq and other business activities", 
   "sadm: Public adm.-defence;compulsory social security", 
   "sedu: Education", "shlt: Human health-social work", 
   "soth: Other community, social & personal services"
   };

g = Graph[vl, el, VertexLabels -> "Name", EdgeWeight -> ew];

community = FindGraphCommunities[g];
CommunityGraphPlot[g]
vName = Lookup[Flatten@community]@
   MapApply[Rule]@
    Map[StringTrim@*StringDelete["\n" | "  "]]@
     StringSplit[names, ": "];
vRule = Thread[Flatten[community] -> vName];

value = {12, 34, 51, 80, 45, 68, 34, 56, 73};
valueAdded = Thread[vl -> value];

barCharts = 
 BarChart[# /. valueAdded, ChartLabels -> {None, #}] & /@ community

enter image description here

I simply want to replace three bar charts with three communities in such a way as to best show the distribution of the edges in a circular embedding format. I have extracted the sets of within-community and between-community edges as follows (by @kglr):

ClearAll[cToCedges, edgesBetweenCommunities]
cToCedges = Module[
    {vToC = 
      Association[
       Join @@ MapIndexed[Thread[# -> #2[[1]]] &]@
         FindGraphCommunities[#]]}, 
    KeySort@GroupBy[EdgeList@#, 
      Sort[vToC /@ 
      VertexList[{#}]] &]] &; (* Community-to-Community edges *)
edgesBetweenCommunities = 
  KeySelect[Unequal @@ # &]@*
   cToCedges;  (* edges between communities *)
   
    TableForm[
  PadRight[{{(cToCedges@g)[[1]], (cToCedges@g)[[4]], (cToCedges@g)[[5]],Flatten@Table[edgesBetweenCommunities[g][[i]], {i, Length[edgesBetweenCommunities[g]]}]}}], 
  TableHeadings -> {None, {"\nC1", "\nC2", "\nC3", 
     "Edges between\ncommunities"}}
  ] /. {0 -> _}

enter image description here

These edges should be mapped onto the bar charts (i.e., communities) to construct a community graph with bar charts.

Update

Here is the picture of the desired output:

enter image description here

The arrows originating from a community should take the color of that community. For example, the arrows originating from community 2 should be green, the arrows originating from community 1 should be blue and so on. In my exercises, the number of communities varies, and hence, the figure should be flexible to automatically adjust to the number of communities in a graph.

$\endgroup$
2
  • 2
    $\begingroup$ could you add a hand-drawn sketch of desired output? $\endgroup$
    – kglr
    Oct 18, 2023 at 15:32
  • $\begingroup$ @kglr: I will do that in a moment. $\endgroup$ Oct 18, 2023 at 15:44

1 Answer 1

7
+50
$\begingroup$

First, two custom functions to be used as option settings for EdgeShapeFunction and VertexShapeFunction:

ClearAll[circleToCoords, poincareESF, VSF]

circleToCoords[Circle[ctr_, rad_, {a1_, a2_}]] := 
  Module[{al = Subdivide[a1, a2, 50]}, 
   (ctr + rad {Cos[#1], Sin[#1]} &) /@ al];

poincareESF = Module[{}, GraphComputation`GraphPropertyChart;
  ReplaceAll[c_Circle :> Arrow@circleToCoords[c]]@
   GraphComputation`GraphChartDump`geo[0.99 First @ #, 0.99 Last @ #, 
     "segment"]] &;

VSF[shape_ : "Bar"][clr_, lbl_, val_, vcount_, gap_ : .2, fs_ : .05] :=
  Module[{seg, angle = ArcTan @@ #,
     width = (1 - gap) 2 Pi /(1 + vcount),
     off = If[0 < ArcTan @@ # < Pi, 1, -1],
     tr = If[shape == "Bar", TranslationTransform[val #], Map[(1 + val) # &]]},
    seg = {Cos @ #, Sin @ #} & /@ 
      Subdivide[angle - width/2, angle + width/2, 50];
    {clr, 
     Text[Style[lbl, Darker @ clr, FontSize -> Scaled[fs]], 
       (1 + val) #, {0, -off 1.5}, - off Cross @ #],
     Polygon[Join[seg, tr @ Reverse[seg]]] }] &;

Examples:

Inputs from OP:

el = {"str4" -> "scst", "ma15" -> "srtl", "ma15" -> "shot", "ma15" -> "str4", 
   "ma15" -> "ma8", "ma15" -> "str3", "sfin" -> "shot", "sfin" -> "ma6"};

community = {{"ma15", "srtl", "ma8", "str3"}, {"shot", "sfin", 
    "ma6"}, {"str4", "scst"}};

valueAdded = {"str4" -> 12, "scst" -> 34, "ma15" -> 51, "srtl" -> 80, 
   "shot" -> 45, "ma8" -> 68, "str3" -> 34, "sfin" -> 56, "ma6" -> 73};

Rules for styling and labeling:

vA = Normalize[Association @ valueAdded, Max];

groupColors = ColorData["Rainbow"] /@ Subdivide[-1 + Length @ community];

clrRules = Join @@ 
   MapThread[(x |-> Blend[{#, White}, x]) /@ Normalize[#2, Total] &]@
    {groupColors, Query[#] @ vA & /@ community};

lblRules = AssociationThread[Join @@ community, Join @@ community];

With these inputs and sorted vertex list

vertexlist = Join @@ community;

gap = .2;

vertexCoordinates = TakeList[Rest @ 
   CirclePoints[{1, 0}, 1 + Length @ vertexlist], 
   Length /@ community]

barcount = Length[vertexlist];

Graph[vertexlist, el,
 VertexCoordinates -> Join @@ vertexCoordinates,
 EdgeShapeFunction -> poincareESF,
 VertexShapeFunction -> (VSF[][clrRules @ #2, lblRules @ #2, 
      vA @ #2, barcount, gap][##] &), 
 EdgeStyle -> {e_ :> 
    Directive[Thick, Opacity[1], Arrowheads[{{Large, .75}}], 
     clrRules[e[[1]]]]},
 ImageSize -> Large,
 PlotRange -> 2,
 ImagePadding -> 30,
 Prolog -> {AxisObject[
    Line[{{1, 0}, {2, 0}}], {0, Max @ Values @ valueAdded}, 
    LabelStyle -> 14, 
    AxisLabel -> Placed["Value Added", {1/2, {1/2, 3/2}}],
    TickLabelPositioning -> "Tip"],
   Thin, Gray, Circle[{0, 0}, 1 + #] & /@ Subdivide[5]}]

enter image description here

To introduce spaces between groups change vertexCoordinates and barcount as

vertexCoordinates = TakeList[Rest@
  CirclePoints[{1, 0}, 1 + Length[vertexlist] + 2 Length[community]], 
     2 + (Length /@ community)][[All, 2 ;; -2]];

barcount = Length[vertexlist] + 2 Length @ community;

gap = 0;

enter image description here

Replace VSF[] with VSF["anystring"] to get

enter image description here

$\endgroup$
6
  • 1
    $\begingroup$ TODO : add group labels $\endgroup$
    – kglr
    Oct 22, 2023 at 9:06
  • $\begingroup$ Thank you very much for the code! Since vA in graph is not defined in the code, I cannot get any graph picture as you present above. I tried different combinations of valueAdded variable to get the right vA but no success. Second, in community 3 in graph, str4 bar should have the same color as scst (in my computer it looks they are of different colors). Currently, the colors of the bars in the 3rd community are different. Also, what do you mean with VSF["anystring"]? $\endgroup$ Oct 22, 2023 at 14:32
  • 1
    $\begingroup$ I added the definition of vA. The reason for different colors within a group is that I blended the group color with White using the relative bar height as weight. By VSF["anystring"], I meant any string except "Bar" (e.g, VSF["blah"], VSF["A"], ... VSF["123"] gives the same result. $\endgroup$
    – kglr
    Oct 22, 2023 at 14:50
  • 1
    $\begingroup$ to get same color for bars in a group you can use clrRules = Association[Join @@ Map[Thread]@Thread[community -> groupColors]] $\endgroup$
    – kglr
    Oct 22, 2023 at 14:58
  • $\begingroup$ All works fine now. You have done much more than I could think of. I really appreciate very elegant pictures. $\endgroup$ Oct 22, 2023 at 14:59

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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