Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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]

enter image description here

(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?

share|improve this question
    
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. –  Szabolcs Jul 18 at 13:57

2 Answers 2

up vote 7 down vote accepted

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

Mathematica graphics

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 -> {Scaled@.05, 0}];
Row@{g@350, label}

enter image description here

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

share|improve this answer
    
@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å Jul 16 at 12:15
    
@GuineaPig Better now :D –  Öskå Jul 16 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å Jul 16 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å Jul 16 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}. –  Guinea Pig Jul 17 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}]

enter image description here

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

enter image description here

share|improve this answer
    
Once again (and again and again) +1 :) –  Öskå Jul 11 at 8:53
    
Thank you @Öskå -- and, once again, I like your answer better as it works more generally. –  kguler Jul 11 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å Jul 11 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. –  Guinea Pig Jul 16 at 23:43

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.