9
$\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$
13
$\begingroup$

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$
  • $\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
  • 1
    $\begingroup$ Great answer! I used the provided functions in a call-graph-making package; see community.wolfram.com/groups/-/m/t/1580800 . $\endgroup$ – Anton Antonov Jan 2 at 0:29
  • $\begingroup$ Thank you @AntonAntonov; happy to hear that it was useful. $\endgroup$ – kglr Jan 2 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.