10
$\begingroup$

This is a chord visualization taken from here. The corresponding code for visualization is

g = ExampleData[{"NetworkGraph", "LesMiserables"}, "FullGraph"]
v = VertexList[g]
e = EdgeList[g];
r = 10;
tsep = 1.0;
ang = 2 Pi/Length[v] + 0.0;
gelt2 = Table[vind1 = Position[v, e[[i, 1]]][[1, 1]];
   vind2 = Position[v, e[[i, 2]]][[1, 1]];
   {Opacity[0.5], RGBColor[0.6, 0.729, 1], 
    BSplineCurve[{{(r - 0.5)*Cos[ang*vind1], (r - 0.5)*
        Sin[ang*vind1]}, {0, 
       0}, {(r - 0.5)*Cos[ang*vind2], (r - 0.5)*
        Sin[ang*vind2]}}]}, {i, 1, Length[e]}];
gdyn = Table[cv = v[[j]];
  tempe = EdgeList[g, cv \[UndirectedEdge] _];
  rot = (ang*j > Pi/2) && (ang*j < 3*Pi/2);
  Mouseover[
   (*if mouse not on top*)(*render the character name*)
   Rotate[Text[
     Style[(*Limit the character name to 8 characters only*)
      If[StringLength[cv] > 8, StringTake[cv, 8] <> ".", cv], 
      Medium], {(r + tsep)*Cos[ang*j], (r + tsep)*Sin[ang*j]}], 
    If[rot, ang*j - Pi, 
     ang*j]], {(*if mouse on top*)(*render the character name*)
    Rotate[
     Text[Style[cv, Medium, Blue, 
       Bold], {(r + tsep)*Cos[ang*j], (r + tsep)*Sin[ang*j]}], 
     If[rot, ang*j - Pi, ang*j]],(*render thick bsplines curves*)
    Table[vind1 = Position[v, tempe[[i, 1]]][[1, 1]];
     vind2 = Position[v, tempe[[i, 2]]][[1, 1]];
     {Thick, 
      BSplineCurve[{{(r - 0.5)*Cos[ang*vind1], (r - 0.5)*
          Sin[ang*vind1]}, {0, 
         0}, {(r - 0.5)*Cos[ang*vind2], (r - 0.5)*
          Sin[ang*vind2]}}]}, {i, 1, Length[tempe]}] (*end of thick b-
    spline table*)} (*end of Mouseover second argument*)
   ],(*end of Mouseover*){j, 1, Length[v]}];(*end of gdyn table*) 

The corresponding visualization is:

enter image description here

Now I wish to color each edge with two colors - the first half with one color and the second half with another color and all the edges from the same vertex should have the same color. A sample is shown below:

enter image description here

How can I do this?

$\endgroup$
14
$\begingroup$

Update 2: An alternative approach that gives better-looking curved edges:

ClearAll[eSF, vSF]
eSF[clr_Association] := GraphComputation`GraphChartDump`pEdge[blah, blah, blah, #1, #2]/.
     Style[circ_Circle, _] :> circ /.  Circle[aa_, bb_, cc_] :> 
      MapThread[Function[{x, y}, {x, Circle[aa, bb, y]}], 
        {clr /@ {First@#2, Last@#2}, Partition[Subdivide[## & @@ cc, 2], 2, 1]}] &;

vSF[clr_Association] := Module[{off = If[-Pi/2 < ArcTan @@ # < Pi/2, Left, Right]},
  {clr @ #2, Text[Style[Framed[#2, FrameStyle -> None], 
       FontSize -> Scaled[.03]], #, {off, Center}, 
       ArcTan[#] (off /. {Left -> 1, Right -> -1})],
     PointSize[Large], Point@#}] &;

Example:

g = ExampleData[{"NetworkGraph", "LesMiserables"}, "FullGraph"];

vColors = AssociationThread[VertexList[g], 
   RandomSample[ColorData[{"Rainbow", {1, VertexCount@g}}] /@ 
     Range[VertexCount[g]]]];

SetProperty[g, {ImageSize -> Large, 
  GraphLayout -> "CircularEmbedding", 
  VertexShapeFunction -> vSF[vColors], 
  EdgeShapeFunction -> eSF[vColors]}]

enter image description here

Update: You can also use custom functions for the options EdgeShapeFunction and VertexShapeFunction:

ClearAll[eSf, vSf]
eSf[g_, cols_] := Module[{bsf = BSplineFunction[{#[[1]], 
     RegionNearest[Disk[Mean[#[[{1, -1}]]], Norm[#[[1]] - #[[-1]]]], {0, 0}], #[[-1]]}], 
     p1 = Subdivide[0, 1/2, 50], p2 = Subdivide[1/2, 1, 50]}, 
   {Thin, cols[[VertexIndex[g, #2[[1]]]]], Line[bsf /@ p1], 
     cols[[VertexIndex[g, #2[[2]]]]], Line[bsf /@ p2]}] &;
vSf[g_, cols_] := Module[{off = If[-Pi/2 < ArcTan @@ # < Pi/2, Left, Right]},
   {cols[[VertexIndex[g, #2]]], 
    Text[Style[Framed[#2, FrameStyle -> None], FontSize -> Scaled[.03]],
       #, {off, Center}, ArcTan[#] (off /. {Left -> 1, Right -> -1})],
    PointSize[Large], Point @ #}] &;

Example:

g = ExampleData[{"NetworkGraph", "LesMiserables"}, "FullGraph"];
cols = RandomSample[ColorData[{"Rainbow", {1, VertexCount@g}}] /@ Range[VertexCount[g]]]; 

SetProperty[g, {ImageSize -> Large, GraphLayout -> "CircularEmbedding", 
  VertexShapeFunction -> vSf[g, cols], EdgeShapeFunction -> eSf[g, cols]}]

enter image description here

You can add Epilog -> Circle[] in the second argument of SetProperty above to get:

enter image description here

Original answer:

You can use BSplineFunction:

cps1 = {{8, 5}, {0, 0}, {10, 1}};
Graphics[{Thick, Red, Line[BSplineFunction[cps1] /@ Subdivide[0, 1/2, 50]], 
   Blue, Line[BSplineFunction[cps1] /@ Subdivide[1/2, 1, 50]]}]

enter image description here

$\endgroup$
5
  • $\begingroup$ The visualization looks much better now with the chords of different sizes. The answer is already acceptable to me. However, since you have answered it, I feel a bit greedy. You have already removed the circular outline which is great. Can you please put a colored dot at each end as updated in my question? $\endgroup$
    – Majis
    Dec 25 '18 at 11:19
  • 1
    $\begingroup$ @Majis, please see the update. $\endgroup$
    – kglr
    Dec 25 '18 at 11:32
  • $\begingroup$ I like the first one. $\endgroup$
    – Majis
    Dec 25 '18 at 12:07
  • 2
    $\begingroup$ Great answer! I used the provided functions in a call-graph-making package; see community.wolfram.com/groups/-/m/t/1580800 . $\endgroup$ Jan 2 '19 at 0:29
  • $\begingroup$ Thank you @AntonAntonov; happy to hear that it was useful. $\endgroup$
    – kglr
    Jan 2 '19 at 2:41

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.