# How to color edges of a graph which has multiple edges connecting certain vertices

I'm studying BIBD(Balanced Incomplete Block Design) and want to draw some graphs by coloring their blocks in different colors, respectively. A block is a collection of edges (or vertices).

For example, (10,4,2)-BIBD, with blocks

{{0,1,2,3},{0,1,4,5},{0,2,4,6},{0,3,7,8},{0,5,7,9},{0,6,8,9},
{1,2,7,8},{1,3,6,9},{1,4,7,9},{1,5,6,8},{2,3,5,9},{2,4,8,9},
{2,5,6,7},{3,4,5,8},{3,4,6,7}}


can be drawn by

GraphPlot[{0 -> 1, 1 -> 2, 2 -> 3, 0 -> 1, 1 -> 4, 4 -> 5, 0 -> 2, 2 -> 4,
4 -> 6, 0 -> 3, 3 -> 7, 7 -> 9, 0 -> 6, 6 -> 8, 8 -> 9, 1 -> 2,
2 -> 7, 7 -> 8, 1 -> 3, 3 -> 6, 6 -> 9, 1 -> 4, 4 -> 7, 7 -> 9,
1 -> 5, 5 -> 6, 6 -> 8, 2 -> 3, 3 -> 5, 5 -> 9, 2 -> 4, 4 -> 8,
8 -> 9, 2 -> 5, 5 -> 6, 6 -> 7, 3 -> 4, 4 -> 5, 5 -> 8, 3 -> 4,
4 -> 6, 6 -> 7},
Method -> "CircularEmbedding",
BaselinePosition -> Top,
VertexLabeling -> True,
MultiedgeStyle -> 0.04]


(This example is from the text book Combinatorial Design - Stinson).

I want to draw each block in its own individual color. How do I do that?

• I deleted my answer because it didn't solve your problem and because I don't think that it is possible to colour two edges between the same two vertices differently using Graph in Mathematica 10. The the new-in-10 multigraph support is not the way to go. Commented Jul 18, 2014 at 13:57

## It seems that the following doesn't work on v9. It does work on v8 and v10.

Here is what I propose based on this:

rule = {0 -> 1, 1 -> 2, 2 -> 3, 0 -> 1, 1 -> 4, 4 -> 5, 0 -> 2, 2 -> 4, 4 -> 6, 0 -> 3,
3 -> 7, 7 -> 9, 0 -> 6, 6 -> 8, 8 -> 9, 1 -> 2, 2 -> 7, 7 -> 8, 1 -> 3, 3 -> 6,
6 -> 9, 1 -> 4, 4 -> 7, 7 -> 9, 1 -> 5, 5 -> 6, 6 -> 8, 2 -> 3, 3 -> 5, 5 -> 9,
2 -> 4, 4 -> 8, 8 -> 9, 2 -> 5, 5 -> 6, 6 -> 7, 3 -> 4, 4 -> 5, 5 -> 8, 3 -> 4,
4 -> 6, 6 -> 7};
blocks = {{0, 1, 2, 3}, {0, 1, 4, 5}, {0, 2, 4, 6}, {0, 3, 7, 8}, {0, 5, 7, 9},
{0, 6, 8, 9}, {1, 2, 7, 8}, {1, 3, 6, 9}, {1, 4, 7, 9}, {1, 5, 6, 8},
{2, 3, 5, 9}, {2, 4, 8, 9}, {2, 5, 6, 7}, {3, 4, 5, 8}, {3, 4, 6, 7}};
coloredRule = Select[Flatten[
Thread[{Rule @@@ Subsets[blocks[[#]], {2}],
ConstantArray[#, 6]}] & /@ Range@Length@blocks, 1], MemberQ[rule, First@#] &];
col = Flatten[{#, {#2, Line[foo]}} & @@@
Thread[{Range@Length@blocks,
RGBColor /@ RandomReal[{0, 1}, {Length@blocks, 3}]}] /. foo -> #1, 1];
GraphPlot[coloredRule, ImagePadding -> 10,
EdgeRenderingFunction -> (Function@Switch[Slot@3, foo] /. foo -> Sequence @@ Evaluate@col),
VertexLabeling -> True,
Method -> "CircularEmbedding"]


Of course, the doubled edges are coloured twice, so the last colour applied remains. I was wrong, the edges in that example are doubled, with two different colours.

The following produces the right number of edges:

grule = GatherBy[Gather[rule], Length];
singledColoredRule = Delete[coloredRule, List /@ Last /@ Table[Flatten@
Position[MemberQ[grule[[2, i]], First@#] & /@ coloredRule,
True], {i, Length@grule[[2]]}]];
SeedRandom@4;
colours = RandomReal[{0, 1}, {Length@blocks, 3}];
col = Flatten[{#, {#2, Line[foo]}} & @@@
Thread[{Range@Length@blocks, RGBColor /@ colours}] /. foo -> #1, 1];
g[size_] := GraphPlot[singledColoredRule,
EdgeRenderingFunction -> (Function@Switch[Slot@3, foo] /. foo -> Sequence @@ Evaluate@col), VertexLabeling -> True,
Method -> "CircularEmbedding", ImageSize -> size];

label =
Grid[Partition[Graphics[{RGBColor@#, Rectangle[], White, Text[#2, {0.5, 0.5}]}] & @@@
Thread@{colours, StringJoin /@ Map[ToString, blocks, {2}]}, 3, 3, 1, {}],
Spacings -> {-1, -1}, ItemSize -> {[email protected], 0}];
Row@{g@350, label}


Of course, now one edge belonging to two different blocks will only take the colour of the latest block.

• @GuineaPig I know.. :) I fixed this but didn't update the answer .. :) I was trying to make the edge dashed with two different colours.. :) Or fading from one to an other with VertexColors but I've failed so far.
– Öskå
Commented Jul 16, 2014 at 12:15
• @GuineaPig Better now :D
– Öskå
Commented Jul 16, 2014 at 12:27
• @GuineaPig foo is anything you like. It's just a variable that I replace so it doesn't appear in the function. It wouldn't work if it was appearing there. Since I am using #1 or #2 I just need to trick Matematica by doing Something[foo, #1, #2]&@@@{somelists}/.foo->#1 in order to have the correct syntax (in the first case Line[#1]).
– Öskå
Commented Jul 16, 2014 at 22:52
• @GuineaPig If I was using Something[Line[#1], #1, #2]&@@@{somelists} the expression inside of Line would be replaced by values of somelists while it needs to stand as #1 so EdgeRenderingFunction works.
– Öskå
Commented Jul 16, 2014 at 22:58
• I have one more question. How do I choose each color, not randomly? I think I should change colours... but don't know how to do it. Your code is marvelous but it's very hard to interpret for me. Some colors between adjacent blocks are similar, so it's quite hard to recognize them distinctly. For example, check the blocks {0,2,4,6} and {2489}, or {0,5,7,9} and {2,3,5,9}. Commented Jul 17, 2014 at 21:10
 blocks = {{0, 1, 2, 3}, {0, 1, 4, 5}, {0, 2, 4, 6}, {0, 3, 7, 8},
{0, 5, 7, 9}, {0, 6, 8, 9}, {1, 2, 7, 8}, {1, 3, 6, 9},
{1, 4, 7, 9}, {1, 5, 6, 8}, {2, 3, 5, 9}, {2, 4, 8, 9},
{2, 5, 6, 7}, {3, 4, 5, 8}, {3, 4, 6, 7}};
edglst = {0 -> 1, 1 -> 2, 2 -> 3, 0 -> 1, 1 -> 4, 4 -> 5, 0 -> 2,
2 -> 4, 4 -> 6, 0 -> 3, 3 -> 7, 7 -> 9, 0 -> 6, 6 -> 8, 8 -> 9,
1 -> 2, 2 -> 7, 7 -> 8, 1 -> 3, 3 -> 6, 6 -> 9, 1 -> 4, 4 -> 7,
7 -> 9, 1 -> 5, 5 -> 6, 6 -> 8, 2 -> 3, 3 -> 5, 5 -> 9, 2 -> 4,
4 -> 8, 8 -> 9, 2 -> 5, 5 -> 6, 6 -> 7, 3 -> 4, 4 -> 5, 5 -> 8,
3 -> 4, 4 -> 6, 6 -> 7};


The following trick works in Version 9 if the number of edges between a pair of vertices is at most 2:

edglst2 = Join @@ (Tally[edglst] /.
{Rule[a_, b_], 2} :> {Rule[a, b], Rule[b, a]} /. {x_Rule, 1} :> {x});
vopts = {VertexStyle -> LightYellow, VertexSize -> 0.20,
VertexLabels -> Placed["Name", {1/2, 1/2}],
VertexLabelStyle -> Directive[20, Red, Bold, Italic]};

gg = Graph[edglst2, vopts, GraphLayout -> "CircularEmbedding",
VertexLabels -> "Name", ImagePadding -> 20, ImageSize -> 500,
EdgeShapeFunction -> "Line", BaseStyle -> Thick];
gg2 = HighlightGraph[gg, (EdgeList[Subgraph[gg, #]] & /@ blocks),
ImageSize -> 500, BaseStyle -> Thick];
Row[{gg, gg2}]


To "mimic" the edge directions in the original graph, one can use EdgeShapeFunction as follows:

eS = Property[DirectedEdge[#, #2], EdgeShapeFunction ->
GraphElementData[{"FilledArrow", "ArrowSize" -> #3, "ArrowPositions" -> #4}]] &;

edglstb = Join @@ (Tally[edglst] /. {Rule[a_, b_], 2} :>
{esf[a, b, .03, .9], esf[b, a, -.03, .1]} /.
{Rule[a_, b_], 1} :> {esf[a, b, .03, .98]});
ggb = Graph[edglstb, vopts,GraphLayout -> "CircularEmbedding", VertexLabels -> "Name",
ImagePadding -> 20, ImageSize -> 500, BaseStyle -> Thick];
ggb2 = HighlightGraph[ggb, EdgeList[Subgraph[ggb, #]] & /@ blocks,
ImageSize -> 500, BaseStyle -> Thick];
Row[{ggb, ggb2}]


• Once again (and again and again) +1 :)
– Öskå
Commented Jul 11, 2014 at 8:53
• Thank you @Öskå -- and, once again, I like your answer better as it works more generally.
– kglr
Commented Jul 11, 2014 at 9:10
• My answer is not correct as it stands right now, I need to fix the fact that some edges are doubled while they shouldn't (e.g. 0->3). Two edges with different colours shouldn't be doubled, like it is on your example. Mine gives two different edges with two different colours, I need to fix this :)
– Öskå
Commented Jul 11, 2014 at 9:12
• My question is that I want to color blocks in different colors. For example, a block {0, 1, 2, 3} must has different color compared to {0, 1, 4, 5}. But in your answer, two edges {0,1} has same color. Commented Jul 16, 2014 at 23:43