# How can I remove B -> A from a list if A -> B is in the list?

I have a list of transformations like this:

list = {"A" -> "B", "B" -> "A", "C" -> "D"}


As this is used to plot an undirected graph with GraphPlot, I don't want to have an Edge between the vertices A-B and B-A. I just want one of them.

How do I remove either A -> B or B -> A from this list? In the end, I want the list to look like this:

{"A" -> "B", "C" -> "D"}


I've tried using DeleteDuplicates, but I don't think I understand the testing part of that function (I should add that I'm a Mathematica beginner ... )

I made a function that can compare two transformations:

CmpTrans[x_,y_] := (x[]/.x) == y[]


It returns True for CmpTrans[A->B, B->A], but I can't seem to use this is the testing part of DeleteDuplicates.

• Perhaps you could consider MultiedgeStyle-> None? For example: GraphPlot[list, VertexLabeling -> True, MultiedgeStyle -> None] – user1066 Feb 4 '12 at 23:01

This seems to do what you want:

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

Rule @@@ Union[Composition[Sort, List] @@@ rules]
(* {"A" -> "B", "C" -> "D"} *)

• Wow! Thanks a lot! That works perfectly. I'm not sure I really understand how it works, but figuring that out is good practice for me. – Erik Tjernlund Feb 4 '12 at 14:04
• It's not too hard; I temporarily turn all your Rule[]s to List[]s with Apply[] (that is, @@@), sort those List[]s, delete duplicates with Union[], and then change the List[]s back to Rule[]s. – J. M. will be back soon Feb 4 '12 at 14:07
• It's seem Union[Sort /@ rules] work,too. – yode Dec 26 '16 at 3:22

If you do not mind changing your edge directions and order, as J.M.'s answer does, this can be done much more simply since Sort works on arbitrary expressions:

Union[Sort /@ rules]


If you do not want to change the directions or order, you can use this:

First /@ GatherBy[rules, Sort]


Mathematica 10 introduced DeleteDuplicatesBy which may also be used:

DeleteDuplicatesBy[list, Sort]

{"A" -> "B", "C" -> "D"}

• "...do not mind changing your edge directions..." - as he wants to draw an undirected graph, he certainly doesn't. – J. M. will be back soon Feb 4 '12 at 23:25
• @J.M. I actually did notice that, but I thought it best to include that anyway. Questions do change themselves sometimes. ;-) – Mr.Wizard Feb 4 '12 at 23:29

Using Mathematica 7

Needs["GraphUtilities"];
Rule @@@ DeleteDuplicates[Sort /@ EdgeList[list]]


giving

{"A" -> "B", "C" -> "D"}

Note that CmpTrans that you wrote isn't the correct test. Here's an example where it gives the wrong result:

CmpTrans["A" -> "B", "B" -> "C"]

(*
==> True
*)


Once we fix that, maybe with something like:

CmpTrans[x_, y_] := x === Reverse[y]

CmpTrans["A" -> "B", "B" -> "C"]

(*
==> False
*)

CmpTrans["A" -> "B", "B" -> "A"]

(*
==> True
*)


then we can simply use CmpTrans as the second argument to DeleteDuplicates:

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

DeleteDuplicates[list, CmpTrans]

(*
==> {"A" -> "B", "B" -> "C", "C" -> "D"}
*)

• One possibly problematic thing about this method is that DeleteDuplicates with explicit comparison function will switch to the quadratic-time pairwise-comparison-based algorithm, making this impractical even for moderately sized graphs. For example: DeleteDuplicates[Flatten@Outer[Rule, Range, Range], CmpTrans]  takes about 5 seconds on my machine. – Leonid Shifrin Feb 4 '12 at 17:01
• Thank you for the corrected function. Embarrassingly I didn't test my version with a False case. – Erik Tjernlund Feb 5 '12 at 17:05

You can use UndirectedGraph directly for your graph problem

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

Graph[list, VertexLabels -> "Name"] g = UndirectedGraph[Graph[list], VertexLabels -> "Name"] EdgeList[g] Update: For versions 10+ there is DeleteDuplicatesBy:

DeleteDuplicatesBy[Sort] @ list


{"A" -> "B", "B" -> "C", "C" -> "D"}

Original post:

You can also use an Orderless function foo.

In matching patterns with Orderless functions, all possible orders of arguments are tried.

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

SetAttributes[foo, Orderless];

Rule @@@ DeleteDuplicates[foo @@@ list]
(* or  DeleteDuplicates[bar @@@ list] /. bar-> Rule *)
(* or DeleteDuplicates[list /. Rule -> bar] /. bar -> Rule *)


{"A" -> "B","C" -> "D"}

• I don't think TransitiveReductionGraph does what the OP has asked (unless I misunderstood something). – Szabolcs Feb 19 '18 at 19:48
• @Szabolcs, deleted that part. – kglr Feb 21 '18 at 23:27

Another approach is using pure pattern matching

{"A" -> "B", "B" -> "A", "C" -> "D"}
/. {before___, a_ -> b_, between___, b_ -> a_, after___}
:> {before, a -> b, between, after}


which leaves the list in its original order.

If there are multiple duplicate entries one can use ReplaceRepeated (//.) instead of ReplaceAll(/.) to sweep the list until all duplicates are cleared

{"A" -> "B", "B" -> "A", "C" -> "D", "B" -> "A"}
//. {before___, a_ -> b_, between___, b_ -> a_, after___}
:> {before, a -> b, between, after}


Yet another proposal. Short but probably not very efficient.

list = {"A" -> "B", "B" -> "A", "C" -> "D"}
DeleteDuplicates[list,  Function[{x, y} , x == Reverse[y]]]
`