EdgeRenderingFunction on a Graph plot

Question

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

Thanks

Answer 1

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

Answer 2

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

Answer 3

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

If you need the change the edge colors only:

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

Answer 4

With VertexStyle, EdgeStyle and pattern matching (instead of EdgeRenderingFunction):

edges = {"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"};

First, we create the graph in a readable style:

g = Graph[edges, GraphStyle -> "DiagramGold", VertexSize -> Large]

Then we colour it:

vcols = Thread[
  VertexList[g] -> ColorData[97] /@ Range@VertexCount[g]
 ]

ecols = MapAt[# \[DirectedEdge] _ &, vcols, {All, 1}]


Graph[g,
 VertexStyle -> vcols, EdgeStyle -> ecols,
 ImageSize -> Large, VertexLabelStyle -> White
]