11
$\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?

Improve this question
$\endgroup$

1 Answer 1

Reset to default
17
$\begingroup$

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

ClearAll[eSF, vSF] eSF[clr_Association] := (Quiet@GraphComputation`GraphPropertyChart[]; 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

Improve this answer
$\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$ Commented Dec 25, 2018 at 11:19
  • 1
    $\begingroup$ @Majis, please see the update. $\endgroup$ Commented Dec 25, 2018 at 11:32
  • $\begingroup$ I like the first one. $\endgroup$ Commented Dec 25, 2018 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$ Commented Jan 2, 2019 at 0:29
  • $\begingroup$ Thank you @AntonAntonov; happy to hear that it was useful. $\endgroup$ Commented Jan 2, 2019 at 2:41

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.