EdgeRenderingFunction For 2 Vertices in a Loop

Question

Assume there is a set of rules:

set = {"A" -> "B", "B" -> "A", "B" -> "C", "C" -> "D", "D" -> "A", "C" -> "C"};

which we want to graph using LayeredGraphPLot, and we want to impose the rule that any pair of vertices that have 2 edges going between them, in different directions ("A" -> "B" and "B" -> "A"), that those edges be a different color, style, etc.

Here is my code:

LayeredGraphPlot[set, DirectedEdges -> True, EdgeRenderingFunction -> (If[MemberQ[Reverse /@ set, #] &,
 {Black, Thickness[0.01], Arrow[#1, 0.05]}, {Blue, 
  Thickness[0.01], Arrow[#1, 0.05]}] &)]

which does not produce the desired result (vertices with 2 edges in different directions be black, the rest blue). In fact, the code draws no edges at all, just the vertices. My thinking was to apply the Reverse function to the original set and then see if the current rule in the slot was a member of the reversed set, which should be the case for A->B and B->A.

However I get the error: "If is not a Graphics primitive or directive."

What am I missing?

Answer 1

LayeredGraphPlot[set, 
 EdgeRenderingFunction -> ({If[MemberQ[set /. Rule -> List, Reverse@#2] && ! SameQ @@ #2, 
                              Black, Blue], Arrow[#1, 0.1]} &)]

Remove the SameQ check if you want self-loops to be considered a hit. If you expect lager graphs, probably wise to pre-compute some stuff...

Per OP comment, the reason the slot used is 2 (from the documentation page):

So, the first slot refers to the points used to generate the graphic of the graph, the second is the vertices. You can sow/reap the values and take a look to get an intuitive feel for what's passed.

Answer 2

multipleedges = Alternatives @@ List @@@ Select[set, Count[set, # | Reverse[#]] > 1 &];
erf = {#2 /. {multipleedges :> Black, _ :> Blue}, Thickness[0.01], Arrow[#1, 0.05]} &;

LayeredGraphPlot[set, DirectedEdges -> True, EdgeRenderingFunction -> erf]

Answer 3

Using Graph:

Graph[Flatten[
Values[GroupBy[set,Sort]]/.{{x_, y_} :> {Style[x, Black],Style[y, Black]},
{x_} :> Style[x, Blue]}],
GraphLayout ->"LayeredDigraphEmbedding"]