# 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[[1]]/.x) == y[[1]]


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] Commented Feb 4, 2012 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. Commented Feb 4, 2012 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. Commented Feb 4, 2012 at 14:07
• It's seem Union[Sort /@ rules] work,too.
– yode
Commented Dec 26, 2016 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. Commented Feb 4, 2012 at 23:25
• @J.M. I actually did notice that, but I thought it best to include that anyway. Questions do change themselves sometimes. ;-) Commented Feb 4, 2012 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[50], Range[50]], CmpTrans]  takes about 5 seconds on my machine. Commented Feb 4, 2012 at 17:01
• Thank you for the corrected function. Embarrassingly I didn't test my version with a False case. Commented Feb 5, 2012 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]


Yet another proposal. Short but probably not very efficient.

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


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). Commented Feb 19, 2018 at 19:48
• @Szabolcs, deleted that part.
– kglr
Commented Feb 21, 2018 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}

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


Updated to reflect cvgmt's comment

Using SequenceSplit (new in 11.3)

Sort @ Map[First] @
SequenceSplit[Sort[list, #1[[1]] == #2[[2]] &],
x : {a_ -> b_, b_ -> a_} :> x]


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

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

Sort @ Map[First] @
SequenceSplit[Sort[list, #1[[1]] == #2[[2]] &],
x : {a_ -> b_, b_ -> a_} :> x]


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

• Seems does not work for list = {"A" -> "B", "D" -> "C", "B" -> "A", "C" -> "D"};` Commented Apr 30 at 8:33
• Thanks, cvgmt, I will try to delete my answer
– eldo
Commented Apr 30 at 8:46