1
$\begingroup$

This code generates a community structure where each community is shown with a different color. The same color is used for bars within a community and outgoing edges from that community. I would like to have the same bar chart, with two modifications:

  1. make all within-community edges transparent (very low opacity);
  2. give a name for each community on the edge of the circle above the community bars.

The code in the link is too complex for me to understand!

EDIT

ClearAll[circleToCoords, poincareESF, VSF]

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

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


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

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

generates:

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ At a minimum, please share some input data to play with. $\endgroup$
    – MarcoB
    Feb 28 at 19:11
  • $\begingroup$ @MarcoB: I will edit the question. Thanks. $\endgroup$ Feb 28 at 19:47

1 Answer 1

3
$\begingroup$

add the following:

roundingText[text_,{a_, b_}, r_, ts_, style_:Black] :=
    Block[{txt, l, ang, st, ds},
        txt = Reverse@Characters[text];
        l = Length[txt];
        ds = ts;
        st = ((b - a) - l ts) / 2;
        If[st < 0, st = (b - a)*(0.02); ds = (b-a-st 2)/l];
        Table[
            ang = a + st + ds(i - 1);
            Text[Style[txt[[i]], style], r {Cos[ang],Sin[ang]}, Automatic, Through[{Cos,Sin}[ang - Pi/2]]]
        ,{i, 1, l}]
 ]

opfunc = 
  Function[{e}, 
   If[AnyTrue[community, SubsetQ[#, List @@ e] &], {Arrowheads[0], 
     Opacity[.2]}, {Arrowheads[{{Large, .75}}], Opacity[1]}]];

arcs = Mod[ArcTan @@@ (#[[{1, -1}]]), 2 Pi] & /@ vertexCoordinates;

comnames = {"community 1", "community 2", "community 3"};

groupbar = {{Opacity[.3], #1, 
      ChartElementData["Sector"][{#2, {2.45, 2.8}}]}, {Black, Thick, 
      Circle[{0, 0}, 2.45, #2]}} & @@@ Transpose[{groupColors, arcs}];

cnames = 
  Thread[roundingText[comnames, arcs, 2.6, .07, 
    Directive[20, GrayLevel[0], Thick]]];

Graph[vertexlist, el, VertexCoordinates -> Join @@ vertexCoordinates, 
 EdgeShapeFunction -> poincareESF, 
 VertexShapeFunction -> (VSF[][clrRules@#2, lblRules@#2, vA@#2, 
      barcount, gap][##] &), 
 EdgeStyle -> {e_ :> 
    Directive[Thick, opfunc[e], 
     clrRules[e[[1]]]]}, ImageSize -> Large, PlotRange -> 3, 
 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], groupbar, cnames}]

enter image description here

$\endgroup$
6
  • $\begingroup$ Thanks for the code. It works very well! Which parameter is used to increase the size of the inner circle with edges? $\endgroup$ Feb 28 at 22:11
  • $\begingroup$ Sorry for my correction request. Since the outgoing arrows originate from the same color community, there is no need to use arrow heads. I think that way the middle part of the figure will look cleaner. $\endgroup$ Feb 28 at 22:16
  • $\begingroup$ @TugrulTemel do you just want to remove arrowheads for same community? $\endgroup$
    – halmir
    Feb 28 at 22:37
  • $\begingroup$ I found the way to remove arrow heads. My only request is to enlarge the inner circle of the figure so that the between-community edges are separated little bit. In my original graph, the density of the between-community edges is high. $\endgroup$ Feb 28 at 22:51
  • 2
    $\begingroup$ @TugrulTemel It seems like it depends on many places in the code (vertex coordinates, shape functions, circles, etc). You better ask this to original author of plot. $\endgroup$
    – halmir
    Feb 28 at 23:11

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.