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.

This is my code, I want each line leaving a vertex to be the same colour from that vertex. So there should be 5 different coloured lines one colour for each vertex.

GraphPlot[{"Non-Drinker" -> "Non-Drinker", 
"Non-Drinker" -> "Moderate", "Non-Drinker" -> "Harmful", 
"Non-Drinker" -> "Deed", "Moderate" -> "Moderate", 
"Moderate" -> "Hazardous", "Moderate" -> "Harmful", 
 "Moderate" -> "Deed", "Hazardous" -> "Non-Drinker", 
 "Hazardous" -> "Moderate", "Hazardous" -> "Hazardous", 
 "Hazardous" -> "Harmful", "Hazardous" -> "Deed", 
 "Harmful" -> "Non-Drinker", "Harmful" -> "Hazardous", 
 "Harmful" -> "Harmful", "Harmful" -> "Deed", 
 "Deed" -> "Non-Drinker"}, VertexLabeling -> True, 
 DirectedEdges -> {True, "ArrowheadsSize" -> 0.1}, 
 MultiedgeStyle -> 0.1, PlotStyle -> {Black}, SelfLoopStyle -> 0.3, 
 EdgeRenderingFunction -> (If[First[#2] == Last[#2], 
    {Red, Arrow[#1, 0.05]}, {GrayLevel[0.1],Arrow[#1, 0.05]}] &)]

ThanksThis is what I have so far

share|improve this question

3 Answers 3

My solution is:

edgeColor[type_] := 
 Switch[type , "Non-Drinker", Blue, "Moderate", Orange, "Harmful", 
  Pink, _, Black]
GraphPlot[{"Non-Drinker" -> "Non-Drinker", 
  "Non-Drinker" -> "Moderate", "Non-Drinker" -> "Harmful", 
  "Non-Drinker" -> "Deed", "Moderate" -> "Moderate", 
  "Moderate" -> "Hazardous", "Moderate" -> "Harmful", 
  "Moderate" -> "Deed", "Hazardous" -> "Non-Drinker", 
  "Hazardous" -> "Moderate", "Hazardous" -> "Hazardous", 
  "Hazardous" -> "Harmful", "Hazardous" -> "Deed", 
  "Harmful" -> "Non-Drinker", "Harmful" -> "Hazardous", 
  "Harmful" -> "Harmful", "Harmful" -> "Deed", 
  "Deed" -> "Non-Drinker"}, VertexLabeling -> True, 
 DirectedEdges -> {True, "ArrowheadsSize" -> 0.1}, 
 MultiedgeStyle -> 0.1, PlotStyle -> {Black}, SelfLoopStyle -> 0.3, 
 EdgeRenderingFunction -> (If[
     First[#2] == Last[#2], {Red, 
      Arrow[#1, 0.05]}, {edgeColor[First@#2], Arrow[#1, 0.05]}] &)]

enter image description here

share|improve this answer

If GraphPlot is not mandatory, here is a more convenient (and prettier IMO) solution using Graph and its option EdgeStyle:

list = {"Non-Drinker" -> "Non-Drinker", "Non-Drinker" -> "Moderate", 
 "Non-Drinker" -> "Harmful", "Non-Drinker" -> "Deed", 
 "Moderate" -> "Moderate", "Moderate" -> "Hazardous", 
 "Moderate" -> "Harmful", "Moderate" -> "Deed", 
 "Hazardous" -> "Non-Drinker", "Hazardous" -> "Moderate", 
 "Hazardous" -> "Hazardous", "Hazardous" -> "Harmful", 
 "Hazardous" -> "Deed", "Harmful" -> "Non-Drinker", 
 "Harmful" -> "Hazardous", "Harmful" -> "Harmful", 
 "Harmful" -> "Deed", "Deed" -> "Non-Drinker"};

Graph[list, VertexLabels -> "Name", 
  EdgeStyle -> 
    Flatten[({# \[DirectedEdge] _ -> 
      ColorData["Rainbow"]@RandomReal[]} & /@ VertexList@Graph@list), 1]]

Mathematica graphics

share|improve this answer
gp = GraphPlot[{"Non-Drinker" -> "Non-Drinker", 
     "Non-Drinker" -> "Moderate", "Non-Drinker" -> "Harmful", 
     "Non-Drinker" -> "Deed", "Moderate" -> "Moderate", 
     "Moderate" -> "Hazardous", "Moderate" -> "Harmful", 
     "Moderate" -> "Deed", "Hazardous" -> "Non-Drinker", 
     "Hazardous" -> "Moderate", "Hazardous" -> "Hazardous", 
     "Hazardous" -> "Harmful", "Hazardous" -> "Deed", 
     "Harmful" -> "Non-Drinker", "Harmful" -> "Hazardous", 
     "Harmful" -> "Harmful", "Harmful" -> "Deed", 
     "Deed" -> "Non-Drinker"}, VertexLabeling -> True, 
   DirectedEdges -> {True, "ArrowheadsSize" -> 0.1}, 
   MultiedgeStyle -> 0.1, PlotStyle -> {Black}, SelfLoopStyle -> 0.3, 
   EdgeRenderingFunction -> (If[First[#2] == Last[#2], {Red, Arrow[#1, 0.05]},
           {GrayLevel[0.1], Arrow[#1, 0.05]}] &), ImageSize -> 500];

Post-process gp to change the colors:

colors = ColorData[63, "ColorList"];
vertcoords = Cases[gp, GraphicsComplex[v_, y__] :> v[[;; 5]], {0, Infinity}][[1]];
gp /. Text[x_, y_] :> Text[x /. HoldPattern[Background -> _] :> 
          (Background -> colors[[y]]),   y] 
   /. {c_,  Arrow[x_, y___]} :> 
          {colors[[x[[1]] /. Thread[vertcoords -> Range@5]]],  Arrow[x, y]}

enter image description here

If you need the change the edge colors only:

 gp /. {c_, Arrow[x_, y___]} :> {colors[[x[[1]] /. Thread[vertcoords -> Range@5]]],
                                  Arrow[x, y]}

enter image description here

share|improve this answer

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.